module Text.Twine.Parser (loadTemplateFromFile, loadTemplateFromString) where
import Data.ByteString.Char8 (ByteString, pack)
import Debug.Trace
import System.FilePath
import Text.Parsec hiding (token)
import Text.Parsec.ByteString
import Text.Twine.Parser.Types
import Control.Monad
token t = do
x <- string t
spaces
return t
template = templateEntities <|> textBlock
templateEntities = try slot <|> try conditional <|> try loop <|> try assign <|> include <?> "Template entity"
startOfEntities = try (string "{{")
<|> try (string "{@")
<|> try (string "{|")
<|> try (string "{+")
<|> try (string "{?")
<?> "start of entity"
endOfEntities = try (string "}}")
<|> try (string "@}")
<|> try (string "|}")
<|> try (string "+}")
<|> try (string "?}")
<?> "end of entity"
textBlock = do
text <- manyTill anyChar ((lookAhead startOfEntities >> return ()) <|> (lookAhead endOfEntities >> return ()) <|> eof)
return (Text $ pack text)
slot = do
token "{{" <?> "Start of slot"
spaces
expr <- expression
spaces
string "}}" <?> "End of slot"
return (Slot expr)
loop = do
token "{@"
token "|" <?> "start of loop expression"
ident <- name
spaces
token "<-"
from <- expression
spaces
char '|' <?> "end of loop expression"
blocks <- manyTill template (string "@}")
return (Loop (from) ident blocks)
conditional = do
token "{?"
token "|" <?> "start of conditional expression"
expr <- expression
spaces
char '|' <?> "end of conditional expression"
blocks <- manyTill template (string "?}")
return (Cond expr blocks)
assign = do
token "{|"
key <- name
spaces
token "="
expr <- expression
spaces
string "|}"
return (Assign key expr)
include = do
token "{+"
path <- try string' <|> many1 (noneOf " +") <?> "Filepath"
spaces
string "+}"
return (Incl path)
accessor = do
a <- try method <|> try atom <?> "property or method"
char '.'
b <- expression
return $ Accessor a b
method = do
a <- name
token "("
expr <- sepBy expression (token ",")
token ")"
return $ Func a expr
sexpr = do
token "("
n <- name
spaces
expr <- sepBy expression' (space)
token ")"
return $ Func n expr
openExpr = do
n <- name
spaces
expr <- sepBy1 expression' (space)
return $ Func n expr
string' = do
char '"'
manyTill (noneOf "\"") (char '"')
stringLiteral = do
st <- string'
return (StringLiteral (pack st))
numberLiteral = do
num <- many1 (digit)
return (NumberLiteral (read num))
valid = (letter <|> (oneOf "#+-*$/?_") <|> digit)
name = do
first <- try letter <|> oneOf "#+-*$/?_"
at <- many valid
return (pack $ first : at)
atom = do
n <- name
return (Var n)
expression = try sexpr <|> try accessor <|> try method <|> try openExpr <|> try atom <|> try stringLiteral <|> numberLiteral <?> "expression"
expression' = try sexpr <|> try atom <|> try stringLiteral <|> numberLiteral <?> "expression"
templateParser = manyTill template eof
parseTemplate name src = case parse templateParser name src of
Right res -> res
Left err -> error (show err)
parseFile fp = do
parsed <- parseFromFile templateParser fp
case parsed of
Right res -> return res
Left err -> error (show err)
doInclude base ps = foldM ax [] ps
where ax a (Incl fs) = do pf <- parseFile (base </> fs)
wi <- doInclude (takeDirectory (base </> fs)) pf
return (a ++ wi)
ax a x = return (a ++ [x])
loadTemplateFromFile :: FilePath -> IO Template
loadTemplateFromFile fp = parseFile fp >>= doInclude (takeDirectory fp)
loadTemplateFromString :: String -> Template
loadTemplateFromString = parseTemplate "theTemplate"