Converting simple markup to HTML

Question

This is going to be rather long and generic, so apologies in advance.

I've been reading a lot about Haskell lately, but I've never really programmed anything with it beyond simple experiments in ghci. So, I wanted to finally try and do some coding exercise that was easy but non-trivial and ended up choosing the "Recluse" problem from a book called Eloquent JavaScript.

The aim is to make a program that takes a text document with simple, custom markup and formats it into HTML according to the following rules:

1. Paragraphs are separated by blank lines.
2. A paragraph that starts with a '%' symbol is a header. The more '%' symbols, the smaller the header.
3. Inside paragraphs, pieces of text can be emphasised by putting them between asterisks.
4. Footnotes are written between braces.

So for example, the text document

% Heading

%% Sub-heading

Text with *emphasis*.

Another {an example footnote} paragraph.

would be formatted as

<h1>Heading</h1>
<h2>Sub-heading</h2>
<p>Text with <i>emphasis</i>.</p>
<p>Another<a href="#footnote1"><sup>1</sup></a> paragraph.</p>
<p><small><a name="footnote1">1. an example footnote</a></small></p>

The main program should read the text document from stdin and output the HTML to stdout.

This seemed like a simple enough task at first (I'd estimate that using Python, a language I have a lot of experience with, I could've finished it in about 15-30 minutes), but as I got deeper into the implementation, I realized I have no clue how to do something like this in Haskell. The footnotes seemed particularily challenging, as you kind of have to accumulate them on the side while building the rest of the document, and I didn't have any idea how to express that in functional terms (at least not without dragging an extra footnotes argument in every single function call).

I hacked at the problem for a few evenings, re-reading Haskell tutorials and perusing the standard library reference, and finally ended up with a solution that works correctly, with some assumptions (for example, nested markup is not supported). However, my solution feels like it's over-complicated for such a simple problem and it consumes relatively high amounts of memory.

So, my question is: how could I simplify the program and turn it into more idiomatic Haskell? The formatText function especially is something that turned out really ugly in my opinion. I'm not expecting anyone to rewrite the whole program, but small fixes here and there would be greatly appreciated.

Secondly, how would I make the program more memory efficient? The current implementation allocates about 400KB of heap for every 1KB of input text, which isn't really a problem for this program, but I think it indicates that I'm doing something stupid. I've read articles about reducing memory consumption by forcing strictness, but it's not readily apparent to me where strictness should be applied in my program for the best effect.

Thanks!

import Char
import Data.List
import Control.Monad.State

data Footnote   = Footnote  Int String
data Footnotes  = Footnotes Int [Footnote]
type TrackNotes = State Footnotes
type HTML       = String

-- |Enclose content in the given HTML element
--  e.g. html "span" "foo" -> "<span>foo</span>"
html :: String -> String -> HTML
html tag content = foldl1' (++) ["<", tag, ">", content, "</", tag, ">"]

-- |Generate a HTML link element
ahref :: String -> String -> HTML
ahref link txt = foldl1' (++) ["<a href=\"", link, "\">", txt, "</a>"]

-- |Replace <, > and & with HTML entities
htmlEscape :: String -> HTML
htmlEscape ""     = ""
htmlEscape (x:xs) = prefix $! htmlEscape xs
    where prefix = case x of
            '&' -> showString "&amp;"
            '<' -> showString "&lt;"
            '>' -> showString "&gt;"
            _   -> (x:)

-- |Add a new footnote
addFootnote :: String -> TrackNotes Int
addFootnote s = State $ \(Footnotes i ns) ->(i, Footnotes (i+1) $ ns ++ [Footnote i s])

-- |Format a text section into HTML
formatSection :: String -> TrackNotes HTML
formatSection s = case s of
    ('%'):xs -> formatHeading s
    _        -> formatParagraph s

-- |Format a text heading into HTML heading
formatHeading :: String -> TrackNotes HTML
formatHeading s = liftM headingTag content
    where headingTag = html ("h" ++ show level)
          level      = length prefix
          content    = formatText $ htmlEscape $ dropWhile isSpace postfix
          (prefix,postfix) = span (=='%') s

-- |Format a text paragraph into HTML paragraph
formatParagraph :: String -> TrackNotes HTML
formatParagraph = liftM (html "p") . formatText . htmlEscape

-- |Format inline markup in text contents, e.g. "*foo* bar" -> "<i>foo</i> bar"
formatText :: String -> TrackNotes HTML
formatText "" = return ""
formatText s  = do
    (content,rest) <- processTag $ postfix
    rest' <- formatText $ rest
    return $ prefix ++ (content ++ rest')

    where (prefix,postfix) = break (`elem` "*{") s

          processTag         "" = return ("", "")
          processTag (tag:rest) = do
            html' <- format $ between
            return (html', tail')
            where (format, endChar) = case tag of
                    '*' -> (formatEmph, '*')
                    '{' -> (formatNote, '}')
                  (between, _:tail') = break (==endChar) rest

          formatEmph = return . html "i"
          formatNote s = do
            idx <- liftM show $ addFootnote s
            let link = "#footnote" ++ idx
            let text = html "sup" idx
            return $ ahref link text

-- |Split a string into sections.
--  Two consecutive line breaks form a section break.
splitSections :: String -> [String]
splitSections = sections . lines
    where sections (x:[]:xs) = x : sections xs
          sections  (x:y:xs) = sections $ (x ++ ('\n' : y)) : xs
          sections         x = x

-- | Format a footnote at the end of the document
formatFootnote :: Footnote -> HTML
formatFootnote (Footnote i s) = html "p" $ html "small" $ anchor
    where anchor = "<a name=\"footnote" ++ show i ++ "\">" ++ text ++ "</a>"
          text   = show i ++ ". " ++ s

-- |Format a text document into HTML document
formatDocument :: String -> String
formatDocument txt   = unlines $ sections ++ footnotes
    where (sections, state) = runState stateMonad (Footnotes 1 [])
          stateMonad        = mapM formatSection $ splitSections txt
          Footnotes _ notes = state
          footnotes         = map formatFootnote notes

main = interact formatDocument

UPDATE: I rewrote the program so that parsing and output are separate as per sepp2k's suggestion, and while that does make the program a bit longer, it keeps the individual functions a lot simpler.

import Char
import Data.List
import Data.Maybe
import Control.Monad.State

type HTML = String
type HeadingLevel = Int

{----------------------------------------------------------------
 Data types and functions for parsing the markup to a parse tree
-----------------------------------------------------------------}
data Section = Heading HeadingLevel [DocNode] | Paragraph [DocNode]
data DocNode = PlainText String | Emphasis [DocNode] | Footnote [DocNode]

parseMarkup :: String -> [Section]
parseMarkup = mapMaybe parseSection . splitSections

parseSection :: String -> Maybe Section
parseSection "" = Nothing
parseSection s  = case s of
    ('%':_) -> Just $ parseHeading s
    _       -> Just $ Paragraph $ parseNodes s

parseHeading :: String -> Section
parseHeading s = Heading lvl nodes
    where lvl   = length prefix
          nodes = parseNodes $ dropWhile isSpace postfix
          (prefix,postfix) = span (=='%') s

parseNodes :: String -> [DocNode]
parseNodes "" = []
parseNodes s  = fst $ parseNodes' Nothing $ zipper s
    where parseNodes' g ((i,(c:t)):_) | (g == Just c) = ([PlainText i], t)
          parseNodes' _  [(i,"")]  = ([PlainText i], "")
          parseNodes' g ((i,t):xs) = case t of
            ('*':_) -> continue Emphasis '*' i t
            ('{':_) -> continue Footnote '}' i t
            _       -> parseNodes' g xs

          continue f end "" t = parseNonText f end $ tail t
          continue f end i t  = (PlainText i : moreNodes, rest)
            where (moreNodes, rest) = parseNonText f end $ tail t

          parseNonText f end t = ((f nodes) : moreNodes, rest')
            where (nodes, rest)      = parseNodes' (Just end) $ zipper t
                  (moreNodes, rest') = parseNodes' Nothing $ zipper rest


{------------------------------------------------
 Data types and functions for tracking footnotes
-------------------------------------------------}
data Footnotes  = Footnotes Int [String]
type TrackNotes = State Footnotes

addFootnote :: String -> TrackNotes Int
addFootnote s = State $ \(Footnotes i ns) ->(i, Footnotes (i+1) $ ns ++ [s])

{---------------------------------------
 Functions for converting nodes to HTML
----------------------------------------}
docToHTML :: [Section] -> HTML
docToHTML ss = unlines $ sections ++ footnotes
    where (sections, state)   = runState stateMonad $ Footnotes 1 []
          stateMonad          = mapM sectionToHTML ss
          (Footnotes _ notes) = state
          footnotes           = map formatFootnote $ zip notes [1..]

sectionToHTML :: Section -> TrackNotes HTML
sectionToHTML (Heading lvl nodes) = liftM htag $ nodesToHTML nodes
    where htag = html $ "h" ++ show lvl
sectionToHTML (Paragraph nodes) = liftM ptag $ nodesToHTML nodes
    where ptag = html "p"

nodesToHTML :: [DocNode] -> TrackNotes HTML
nodesToHTML = liftM (foldl' (++) "") . mapM nodeToHTML

-- | Convert a single DocNode to HTML
nodeToHTML :: DocNode -> TrackNotes HTML
nodeToHTML (PlainText s)    = return s
nodeToHTML (Emphasis nodes) = liftM (html "i") $ nodesToHTML nodes
nodeToHTML (Footnote nodes) = do
    content <- nodesToHTML nodes 
    idx  <- liftM show $ addFootnote content
    let link = "#footnote" ++ idx
    let text = html "sup" idx
    return $ ahref link text

-- | Format a footnote at the end of the document
formatFootnote :: (String, Int) -> HTML
formatFootnote (s,i) = html "p" $ html "small" $ anchor
    where anchor = "<a name=\"footnote" ++ show i ++ "\">" ++ text ++ "</a>"
          text   = show i ++ ". " ++ s

-- |Enclose content in the given HTML element
--  e.g. html "span" "foo" -> "<span>foo</span>"
html :: String -> String -> HTML
html tag content = foldl1' (++) ["<", tag, ">", content, "</", tag, ">"]

-- |Generate a HTML link element
ahref :: String -> String -> HTML
ahref link txt = foldl1' (++) ["<a href=\"", link, "\">", txt, "</a>"]

-- |Replace <, > and & with HTML entities
htmlEscape :: String -> HTML
htmlEscape ""     = ""
htmlEscape (x:xs) = prefix $! htmlEscape xs
    where prefix = case x of
            '&' -> showString "&amp;"
            '<' -> showString "&lt;"
            '>' -> showString "&gt;"
            _   -> (x:)

{------------------------------
 Miscellanous string utilities
-------------------------------}

-- |Split a string into sections.
--  Two consecutive line breaks form a section break.
splitSections :: String -> [String]
splitSections = sections . lines
    where sections (x:[]:xs) = x : sections xs
          sections  (x:y:xs) = sections $ (x ++ ('\n' : y)) : xs
          sections         x = x

-- | A "zipper" for navigating a string
--   Generates a list of (init,tail) pairs that traverse the list
--   E.g. zipper "foo" -> [("","foo"), ("f","oo"), ("fo","o"), ("foo","")]
zipper :: String -> [(String,String)]
zipper s = zip (inits s) (tails s)

{-----
 Main
------}
formatDoc :: String -> HTML
formatDoc = docToHTML . parseMarkup

main = interact formatDoc

Answer 1

One of Haskell's advantages is that there's a good number of high-quality parser libraries for it. Using one for this case might be a bit overkill, but since this is a learning exercise anyway it might be a good chance to pick up a parser library (e.g. parsec) as well. This could certainly come in handy later. Also using such a library, you could support nested markup without any trouble.

---

About memory: Haskell strings, being (lazy) linked lists of characters, just aren't very memory efficient. For this reason it is often recommended to use bytestrings or Data.Text in favor of plain strings if you need memory-efficient string handling.

---

The footnotes seemed particularily challenging, as you kind of have to accumulate them on the side while building the rest of the document, and I didn't have any idea how to express that in functional terms (at least not without dragging an extra footnotes argument in every single function call).

As you already found out one solution to track state through the program without adding extra arguments is the State monad. However in this case I feel that it made the program more complicated than it needed to be.

I think an extra footnotes argument (and a second one to count them) would actually have been the simplest solution here.

---

As a general design note, I think a two-step approach would make the code more manageable and extensible: First parse the string into an internal representation (I would call it a tree, except that until you support nested markup, it won't actually be a tree), and then write a function which turns that representation into HTML.

This way you separate the code that does the parsing from the code that produces the HTML, which is good style. It also allows you to add another output format later without having to duplicate any parsing code. It should also be easier to support nested markup using this approach and it also makes it easier to replace your manual parsing code with a parsing library should you decide to do so.