An example iolist

iolist.hs

import Data.Map hiding (map)

newtype IOListBuilder a = IOListBuilder { makeLB :: (a, IOList) }

data IOList             = StringEntry String | Sublist [IOList] | EmptyEntry | DictEntry String String

iolistToString :: Map String String -> IOList -> String
iolistToString dict (StringEntry s)         = s
iolistToString dict (Sublist [])            = ""
iolistToString dict (EmptyEntry)            = ""
iolistToString dict (DictEntry k d)         = findWithDefault d k dict
iolistToString dict (Sublist xs)            = concat $ map (iolistToString dict) xs

appendS :: String -> IOListBuilder()
appendS s          = IOListBuilder ((), entry)
    where
      entry = parseString s

appendN :: (Show n) => n -> IOListBuilder()
appendN n            = IOListBuilder ((), StringEntry s)
    where
      s   = i2s `seq` i2s
      i2s = show n

appendD :: String -> String -> IOListBuilder()
appendD def key     = IOListBuilder((), DictEntry def key)

newline        = appendS "\n"

parseString :: String -> IOList
parseString str = parse str []
    where
      parse  [] acc            = StringEntry acc
      parse  ('%':cs) acc      = Sublist [StringEntry acc, parsed cs [] []]
      parse  (c:cs) acc        = parse cs (acc++[c])
      parsed ('%':cs) a1 a2    = parse cs "%"
      parsed ('(':cs) a1 a2    = parsed cs a1 a2
      parsed (')':cs) a1 a2    = parsef cs a1 a2
      parsed ('|':cs) a1 a2    = parseg cs a1 a2
      parsed (c:cs)   a1 a2    = parsed cs (a1++[c]) a2
      parseg (')':cs) a1 a2    = parsef cs a1 a2
      parseg (c:cs)   a1 a2    = parseg cs a1 (a2++[c])
      parsef ('s':cs) a1 a2    = Sublist [DictEntry a1 a2, parse cs []]

execIOListBuilder :: Map String String -> IOListBuilder a -> String
execIOListBuilder dict (IOListBuilder (_, iolist)) = iolistToString dict iolist

evalIOListBuilder :: IOListBuilder a -> a
evalIOListBuilder (IOListBuilder (a, _)) = a

debugIOListBuilder :: IOListBuilder a -> String
debugIOListBuilder (IOListBuilder (_, iolist)) = show iolist

instance Monad IOListBuilder where
  return a                          = IOListBuilder (a, EmptyEntry)
  IOListBuilder (res, iolist) >>= f =
    IOListBuilder (newres, Sublist [iolist, newlist])
      where IOListBuilder (newres, newlist) = f res

instance Show IOList where
    show (StringEntry s)      = "StringEntry " ++ show s
    show EmptyEntry           = "EmptyEntry"
    show (Sublist l)          = "Sublist " ++ show l
    show (DictEntry k d)      = "DictEntry " ++ show k ++ " " ++ show d

main = do
  let dict = fromList [("name", "hc"), ("foo", "bar")]
  putStrLn $ execIOListBuilder dict greeting
  putStrLn "\n\n -- where --"
  putStrLn $ debugIOListBuilder greeting
    where greeting = do
            appendS "Hello World, %(name|unknown being)s!"
            newline
            appendS "Wie geht's?"
            newline
            appendS "Es geht "
            appendN 100
            appendS "%% gut"
            newline
            appendD "name" "[def]hc"
            newline
            foo <- return "12"
            appendS foo
            return "Hi"