yesod 0.4.0.1 → 0.4.0.2

raw patch · 2 files changed

+46/−1 lines, 2 files

Files

• CodeGenQ.hs +44/−0
• yesod.cabal +2/−1

@@ -0,0 +1,44 @@+{-# LANGUAGE TemplateHaskell #-}+-- | A code generation quasi-quoter. Everything is taken as literal text, with ~var~ variable interpolation, and ~~ is completely ignored.+module CodeGenQ (codegen) where++import Language.Haskell.TH.Quote+import Language.Haskell.TH.Syntax+import Text.ParserCombinators.Parsec++codegen :: QuasiQuoter+codegen = QuasiQuoter codegen' $ error "codegen cannot be a pattern"++data Token = VarToken String | LitToken String | EmptyToken++codegen' :: String -> Q Exp+codegen' s' = do+    let s = killFirstBlank 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'+  where+    killFirstBlank ('\n':x) = x+    killFirstBlank ('\r':'\n':x) = x+    killFirstBlank x = x++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

@@ -1,5 +1,5 @@ name:            yesod-version:         0.4.0.1+version:         0.4.0.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -67,6 +67,7 @@     build-depends:     parsec >= 2.1 && < 4     ghc-options:       -Wall     main-is:           scaffold.hs+    other-modules:     CodeGenQ  executable             runtests     if flag(buildtests)