hako 0.2.0 → 0.3.0

raw patch · 2 files changed

+41/−18 lines, 2 files

Files

• Text/Hako/Parsing.hs +40/−17
• hako.cabal +1/−1

@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell, FlexibleContexts, RankNTypes #-} module Text.Hako.Parsing ( parseTemplateFromString ) where@@ -9,6 +9,8 @@ import Text.Parsec.String import Text.Hako.Html +type HakoParser a = Stream s m Char => ParsecT s u m a+ -- | Hako's main parser, suitable as a quoteExpr. parseTemplateFromString :: String -> ExpQ parseTemplateFromString s = either (error . show) return $ parse template [] s@@ -28,28 +30,34 @@         then body         else LetE defs body -template :: Stream s m Char => ParsecT s u m Exp+template :: HakoParser Exp template = do     tfs <- many templateFragment     return $ tpack $ foldl1 tjoin tfs -templateFragment :: Stream s m Char => ParsecT s u m Template+templateFragment :: HakoParser Template templateFragment = try templateDefFragment+                 <|> try templateForFragment                  <|> templateExpFragment                  <|> templateLitFragment                  <?> "template fragment" -templateDefFragment :: Stream s m Char => ParsecT s u m Template+templateDefFragment :: HakoParser Template templateDefFragment = do     defs <- blockDef     return $ Template defs [] -templateExpFragment :: Stream s m Char => ParsecT s u m Template+templateExpFragment :: HakoParser Template templateExpFragment = do     exp <- haskellExpr     return $ Template [] [exp] -templateLitFragment :: Stream s m Char => ParsecT s u m Template+templateForFragment :: HakoParser Template+templateForFragment = do+    exp <- forExpr+    return $ Template [] [exp]++templateLitFragment :: HakoParser Template templateLitFragment = do     exp <- literalText     return $ Template [] [exp]@@ -63,7 +71,7 @@ expWrap :: Exp -> Exp expWrap a = AppE (VarE . mkName $ "toHtml") a -blockDef :: Stream s m Char => ParsecT s u m [Dec]+blockDef :: HakoParser [Dec] blockDef = do     string "{def"     space@@ -75,53 +83,68 @@         Right d -> return d         Left err -> error err -literalText :: Stream s m Char => ParsecT s u m Exp+forExpr :: HakoParser Exp+forExpr = do+    string "{for"+    space+    iteree <- manyTill (try anyChar) $ char '-'+    string ">"+    space+    iter <- manyTill (try anyChar) $ char ':'+    inner <- template+    string "}"+    let expr = parseExp $ "foldl (<++>) (Html \"\") (map (\\" ++ iter ++ " -> " ++ pprint inner ++ ") (" ++ iteree ++ "))"+    case expr of+        Right e -> return e+        Left err -> error err++literalText :: HakoParser Exp literalText = do     str <- many1 $ noneOf "{}"     return $ AppE (ConE . mkName $ "Html") $ LitE $ StringL str -haskellExpr :: Stream s m Char => ParsecT s u m Exp+haskellExpr :: HakoParser Exp haskellExpr = do     e <- haskellExpr'     return $ expWrap e -haskellExpr' :: Stream s m Char => ParsecT s u m Exp+haskellExpr' :: HakoParser Exp haskellExpr' = do     _ <- char '{'     src <- haskellText     _ <- char '}'     either fail return $ parseExp src -haskellText :: Stream s m Char => ParsecT s u m String+haskellText :: HakoParser String haskellText = do     parts <- many1 haskellPart     return $ concat parts -bracedText :: Stream s m Char => ParsecT s u m String+bracedText :: HakoParser String bracedText = do     char '{'     inner <- haskellText     char '}'     return $ "{" ++ inner ++ "}" -haskellPart :: Stream s m Char => ParsecT s u m String+haskellPart :: HakoParser String haskellPart = quotedChar             <|> quotedEscapedChar             <|> quotedString             <|> bracedText             <|> haskellOther -haskellOther :: Stream s m Char => ParsecT s u m String+haskellOther :: HakoParser String haskellOther = many1 $ noneOf "\"'{}" -quotedChar :: Stream s m Char => ParsecT s u m String+quotedChar :: HakoParser String quotedChar = do     char '\''     c <- noneOf "\\"     char '\''     return ['\'', c, '\''] -quotedEscapedChar :: Stream s m Char => ParsecT s u m String+quotedEscapedChar :: HakoParser String quotedEscapedChar = do     char '\''     char '\\'@@ -129,7 +152,7 @@     char '\''     return ['\'', '\\', c, '\''] -quotedString :: Stream s m Char => ParsecT s u m String+quotedString :: HakoParser String quotedString = do     char '"'     strs <- many quotedStringPart

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.2.0+Version:             0.3.0  -- A short (one-line) description of the package. Synopsis:            A mako-like quasi-quoter template library