Parse text tags

ParseTags.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import qualified Data.Map     as M
import qualified Data.Text    as T
import qualified Data.Text.IO as TIO

{- A document part is like a piece of syntax. -}
data DocPart =
  Tag T.Text [T.Text] | Run T.Text
  deriving Show

type Env = M.Map T.Text ([T.Text] -> T.Text)

{- Takes a text (string) to a list of document parts. Each part is
either a tag or a run (just plain text). -}
parseText :: T.Text -> [DocPart]
parseText t =
  {- Iterate over the input text by folding over it, one character at a
  time. The accumulated value is a tuple of (the current list of parts,
  the current word that may become either the next tag or the next run
  in the list. -}
  reverse $ if remainder == T.empty then parts else lastPart:parts
  where
    (parts, remainder) = T.foldl processChar ([], "") t
    lastPart = if (startsTag remainder && endsTag remainder)
      then wordToTag remainder
      else Run remainder

    {- The folding function takes each character from the input text and
    decides what to do with it. -}
    processChar :: ([DocPart], T.Text) -> Char -> ([DocPart], T.Text)
    processChar (parts, curWord) c
      | startsTag curWord && endsTag curWord =
        ((wordToTag curWord):parts, T.singleton c)
      | curWord /= "{{" && "{{" `T.isSuffixOf` curWord =
        ((Run $ runPortion curWord):parts, T.snoc "{{" c)
      | curWord /= "{%" && "{%" `T.isSuffixOf` curWord = 
        ((Run $ runPortion curWord):parts, T.snoc "{%" c)
      | otherwise = (parts, T.snoc curWord c)

    startsTag word =
      "{{" `T.isPrefixOf` word || "{%" `T.isPrefixOf` word
    endsTag word =
      ("{{" `T.isPrefixOf` word && "}}" `T.isSuffixOf` word)
        || ("{%" `T.isPrefixOf` word && "%}" `T.isSuffixOf` word)

    {- The portion of the current word that would become a Run if the
    word ends with a 'start tag' marker. -}
    runPortion word = T.take ((T.length word) - 2) word

    {- Create a tag using the current word, taking into account the tag
    type (with or without args). -}
    wordToTag word
      | "{{" `T.isPrefixOf` word = Tag (head tagParts) []
      | "{%" `T.isPrefixOf` word = Tag (head tagParts) (tail tagParts)
      | otherwise = undefined
      where
        tagParts = T.words $ T.dropAround isMarkup word
        isMarkup c = any (== c) ['{', '%', '}', ' ']

renderDocPart :: DocPart -> Env -> T.Text
renderDocPart t@(Tag n args) e =
  case M.lookup n e of
    Just v -> v args
    Nothing -> error "Unrecognised tag."
renderDocPart (Run t) _ = t
  
renderText :: T.Text -> Env -> T.Text
renderText t e =
  T.concat . (map renderWithEnv) $ parseText t
  where renderWithEnv = \d -> renderDocPart d e

renderFile :: FilePath -> Env -> IO T.Text
renderFile f e =
  TIO.readFile f >>= \fileContents -> return $ renderText fileContents e

{- A little wrapper around the parseText function to give it the ability
to parse a text file. -}
parseFile :: FilePath -> IO [DocPart]
parseFile f =
  TIO.readFile f >>= \fileContents -> return $ parseText fileContents

main :: IO ()
main =
  putStrLn $ show $ renderText txt env
  where
    txt = "Hello, {{name}}. Toggle value is {%if 1 a b%}."
    env =
      M.fromList
        [ ("name", \_ -> "Yawar")
        , ( "if"
          , \[cond, trueBranch, falseBranch] -> 
              if cond == "1" then trueBranch else falseBranch ) ]

parseText is error-resistant. If it gets malformed template input, it just ignores it and moves on, possibly ending up returning an empty list.

That is not error resistant, that is error implicit which defeats the purpose of using Haskell. If a parser encounters an error it should return an explicit error value, ideally a sum type in an Either or Validation.

@bitemyapp it depends on your case analysis. For example, I've revised my function to break up the text into a list of either tags or plain runs. In my logic, anything that's not a tag is a plain run of text. That means a malformed tag will end up being a run as well.