40 lines
1.1 KiB
Haskell
40 lines
1.1 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
-- | A code generation template haskell. Everything is taken as literal text,
|
|
-- with ~var~ variable interpolation.
|
|
module CodeGen (codegen) where
|
|
|
|
import Language.Haskell.TH.Syntax
|
|
import Text.ParserCombinators.Parsec
|
|
import qualified System.IO.UTF8 as U
|
|
|
|
data Token = VarToken String | LitToken String | EmptyToken
|
|
|
|
codegen :: FilePath -> Q Exp
|
|
codegen fp = do
|
|
s' <- qRunIO $ U.readFile $ "scaffold/" ++ fp ++ ".cg"
|
|
let s = init s'
|
|
case parse (many parseToken) s s of
|
|
Left e -> error $ show e
|
|
Right tokens' -> do
|
|
let tokens'' = map toExp tokens'
|
|
concat' <- [|concat|]
|
|
return $ concat' `AppE` ListE tokens''
|
|
|
|
toExp :: Token -> Exp
|
|
toExp (LitToken s) = LitE $ StringL s
|
|
toExp (VarToken s) = VarE $ mkName s
|
|
toExp EmptyToken = LitE $ StringL ""
|
|
|
|
parseToken :: Parser Token
|
|
parseToken =
|
|
parseVar <|> parseLit
|
|
where
|
|
parseVar = do
|
|
_ <- char '~'
|
|
s <- many alphaNum
|
|
_ <- char '~'
|
|
return $ if null s then EmptyToken else VarToken s
|
|
parseLit = do
|
|
s <- many1 $ noneOf "~"
|
|
return $ LitToken s
|