2
\$\begingroup\$

For the last couple of months, I have started to learn Haskell and since I am following a course on functional programming soon, I thought I would test my current skills. So what I did was create an HTML parser that transforms this input:

 body
  div#container.classA
   span;attr=attr text1
   span.classB text2
  div#other
   span test
   div
    div.class

Into this formatted HTML file:

<!DOCTYPE HTML>
<HTML>
<body>
    <div id='container' class='classA'>
        <span attr='attr'>text1</span>
        <span class='classB'>text2</span>
    </div>
    <div id='other'>
        <span>test</span>
        <div>
            <div class='class'></div>
        </div>
    </div>
</body>
</html>

And I was wondering if the implementation could be more straightforward, if I am using the correct syntax or if I am generally doing an okay job using the concepts Haskell offers. Here is my code:

module HtmlParser (
     parse, toHtmlFile, HtmlObject
 ) where
 
 data HtmlObject = HtmlContent String | HtmlElement { tag :: String, attributes :: [(String, String)], children :: [HtmlObject] } deriving (Show)
 
 ----- Exported Functions -----
 
 parse :: String -> [HtmlObject]
 parse xs = recReverse $ foldl parse' [] (lines xs)
     where parse' ls s = let element = stringToElement s in insertElement element ls
 
 toHtmlFile :: String -> String
 toHtmlFile xs = "<!DOCTYPE html>\n<html>" ++ toString (parse xs) [] ++ "\n</html>"
 


 ----- Step 1: Parsing the input -----
 
 stringToElement :: String -> (HtmlObject, Int)
 stringToElement xs = (parseString s, i)
     where (s,i) = getIndentation xs
 
 getIndentation :: String -> (String, Int)
 getIndentation [] = ([], 0)
 getIndentation xs'@(x:xs)
     | x == ' '  = (a, b+1)
     | otherwise = (xs', 0)
         where (a,b) = getIndentation xs
 
 parseString :: String -> HtmlObject
 parseString = handleInput . splitInput
 
 
 
 ----- Step 2: Splitting the input line into separate parts -----
 
 splitInput :: String -> (String, String, String)
 splitInput s = splitInput (split ' '  s)
     where splitInput (temp,msg) = (tag, attrs, msg)
                                   where (tag, attrs) = split ';' temp
 
 handleInput :: (String, String, String) -> HtmlObject
 handleInput (tag, attrs, msg) = addMessage msg $ addAttributes attrs $ createElement tag
 
 
 
 ----- Step 3: Handling separate parts of the HtmlElement -----
 
 createElement :: String -> HtmlObject
 createElement s = HtmlElement tag (getAttr id "id" ++ getAttr classes "class") []
     where (tag, id, classes) = splitElement s
 
 splitElement :: String -> (String, String, String)
 splitElement xs = splitElement' $ split '.' xs
     where splitElement' (temp, classes) = (tag, id, classes)
              where (tag, id) = split '#' temp
 
 getAttr :: String -> String -> [(String, String)]
 getAttr [] _    = []
 getAttr xs name = [(name, replace '.' ' ' xs)]

getAttributes :: String -> [(String, String)]
 getAttributes [] = []
 getAttributes xs = split '=' attribute : getAttributes rest
     where (attribute, rest) = split ',' xs
 
 addMessage :: String -> HtmlObject ->  HtmlObject
 addMessage [] e = e
 addMessage msg (HtmlElement tag attrs children) = HtmlElement tag attrs (HtmlContent msg : children)
 
 
 
 ----- Step 4: Inserting the HtmlElement in the tree structure -----
 
 insertElement :: (HtmlObject, Int) -> [HtmlObject] -> [HtmlObject]
 insertElement (obj, 0) ls = obj : ls
 insertElement (obj, n) ((HtmlElement tag attr children) : ls) = HtmlElement tag attr (insertElement (obj, n-1) children) : ls
 insertElement _ _ = error "Wrong File Format"
 
 
 
 ----- Step 5: Turn objects in a valid HTML file -----
 
 toString :: [HtmlObject] -> String -> String
 toString []     _  = []
 toString ((HtmlContent msg):xs) ys = msg
 toString ((HtmlElement tag attrs children):xs) ys = "\n" ++ ys ++ "<" ++ tag ++ attributesToString attrs ++ ">" ++ toString children ('\t':ys) ++ newline ++ "</" ++ tag ++ ">" ++         toString xs ys
     where newline = if (isContent children) then "" else "\n" ++ ys
 
 attributesToString :: [(String, String)] -> String
 attributesToString [] = []
 attributesToString ((a,b):rest) = ' ' : a ++ "='" ++ b ++ "'" ++ attributesToString rest
 
 
 
 ----- Utility Functions -----
 
 split :: Eq a => a -> [a] -> ([a], [a])
 split _ [] = ([], [])
 split e (x:xs)
     | e == x    = ([], xs)
     | otherwise = (x : a, b)
         where (a,b) = split e xs
 
 replace :: Eq a => a -> a -> [a] -> [a]
 replace _ _ [] = []
 replace x y (z:zs)
     | x == z = y : replace x y zs
     | otherwise = z : replace x y zs
 
 recReverse :: [HtmlObject] -> [HtmlObject]
 recReverse [] = []
 recReverse xs = reverse $ map recReverse' xs
     where recReverse' (HtmlElement a b c) = HtmlElement a b (recReverse c)
           recReverse' a = a
 
 isContent :: [HtmlObject] -> Bool
 isContent [] = True
 isContent [(HtmlContent _)] = True
 isContent _ = False

I think the main concept that I am trying to improve upon is creating functions from other functions. Whereas a lot of functions get re-used in libraries, I can't seem to get a set of functions working which can work together to create new functions. How could I restructure this parser, such that I can reuse functions in multiple spots and not have lots of different functions?

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.