hamlet 0.10.3 → 0.10.4
raw patch · 5 files changed
+88/−44 lines, 5 filesdep ~shakespearePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: shakespeare
API changes (from Hackage documentation)
Files
- Text/Hamlet.hs +27/−19
- Text/Hamlet/Parse.hs +21/−20
- Text/Hamlet/RT.hs +4/−2
- hamlet.cabal +3/−3
- test/main.hs +33/−0
Text/Hamlet.hs view
@@ -43,6 +43,7 @@ import qualified Data.Text.Lazy as TL import Text.Blaze (Html, preEscapedText, toHtml) import qualified Data.Foldable as F+import Control.Monad (mplus) type Render url = url -> [(Text, Text)] -> Text type Translate msg = msg -> Html@@ -61,31 +62,43 @@ [x] -> return x _ -> return $ DoE $ map NoBindS exps +unIdent :: Ident -> String+unIdent (Ident s) = s+ docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp-docToExp env hr scope (DocForall list ident@(Ident name) inside) = do+docToExp env hr scope (DocForall list idents inside) = do let list' = derefToExp scope list- name' <- newName name- let scope' = (ident, VarE name') : scope+ names <- mapM (newName . unIdent) idents+ let pairs = zip idents (map VarE names)+ let scope' = pairs ++ scope mh <- [|F.mapM_|] inside' <- docsToExp env hr scope' inside- let lam = LamE [VarP name'] inside'+ let lam = flip LamE inside' $ case names of+ [x] -> [VarP x]+ _ -> [TupP $ map VarP names] return $ mh `AppE` lam `AppE` list' docToExp env hr scope (DocWith [] inside) = do inside' <- docsToExp env hr scope inside return $ inside'-docToExp env hr scope (DocWith ((deref,ident@(Ident name)):dis) inside) = do+docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do let deref' = derefToExp scope deref- name' <- newName name- let scope' = (ident, VarE name') : scope+ names <- mapM (newName . unIdent) idents+ let pairs = zip idents (map VarE names)+ let scope' = pairs ++ scope inside' <- docToExp env hr scope' (DocWith dis inside)- let lam = LamE [VarP name'] inside'+ let lam = flip LamE inside' $ case names of+ [x] -> [VarP x]+ _ -> [TupP $ map VarP names] return $ lam `AppE` deref'-docToExp env hr scope (DocMaybe val ident@(Ident name) inside mno) = do+docToExp env hr scope (DocMaybe val idents inside mno) = do let val' = derefToExp scope val- name' <- newName name- let scope' = (ident, VarE name') : scope+ names <- mapM (newName . unIdent) idents+ let pairs = zip idents (map VarE names)+ let scope' = pairs ++ scope inside' <- docsToExp env hr scope' inside- let inside'' = LamE [VarP name'] inside'+ let inside'' = flip LamE inside' $ case names of+ [x] -> [VarP x]+ _ -> [TupP $ map VarP names] ninside' <- case mno of Nothing -> [|Nothing|] Just no -> do@@ -253,14 +266,9 @@ -- first is performed. In there are no true values, then the second argument is -- performed, if supplied. condH :: Monad m => [(Bool, m ())] -> Maybe (m ()) -> m ()-condH [] Nothing = return ()-condH [] (Just x) = x-condH ((True, y):_) _ = y-condH ((False, _):rest) z = condH rest z+condH bms mm = fromMaybe (return ()) $ lookup True bms `mplus` mm -- | Runs the second argument with the value in the first, if available. -- Otherwise, runs the third argument, if available. maybeH :: Monad m => Maybe v -> (v -> m ()) -> Maybe (m ()) -> m ()-maybeH Nothing _ Nothing = return ()-maybeH Nothing _ (Just x) = x-maybeH (Just v) f _ = f v+maybeH mv f mm = fromMaybe (return ()) $ fmap f mv `mplus` mm
Text/Hamlet/Parse.hs view
@@ -43,12 +43,12 @@ | ContentMsg Deref deriving (Show, Eq, Read, Data, Typeable) -data Line = LineForall Deref Ident+data Line = LineForall Deref [Ident] | LineIf Deref | LineElseIf Deref | LineElse- | LineWith [(Deref, Ident)]- | LineMaybe Deref Ident+ | LineWith [(Deref, [Ident])]+ | LineMaybe Deref [Ident] | LineNothing | LineTag { _lineTagName :: String@@ -132,7 +132,7 @@ eol return $ LineElseIf x binding = do- y <- ident+ y <- identPattern spaces _ <- string "<-" spaces@@ -201,24 +201,28 @@ content cr tagIdent = char '#' >> TagIdent <$> tagAttribValue NotInQuotes tagCond = do- _ <- char ':'- d <- parseDeref- _ <- char ':'+ d <- between (char ':') (char ':') parseDeref tagClass (Just d) <|> tagAttrib (Just d) tagClass x = char '.' >> (TagClass . (,) x) <$> tagAttribValue NotInQuotes tagAttrib cond = do s <- many1 $ noneOf " \t=\r\n>"- v <- (do- _ <- char '='- s' <- tagAttribValue NotInQuotesAttr- return s') <|> return []+ v <- (char '=' >> tagAttribValue NotInQuotesAttr) <|> return [] return $ TagAttrib (cond, s, v) tag' = foldr tag'' ("div", [], []) tag'' (TagName s) (_, y, z) = (s, y, z) tag'' (TagIdent s) (x, y, z) = (x, (Nothing, "id", s) : y, z) tag'' (TagClass s) (x, y, z) = (x, y, s : z) tag'' (TagAttrib s) (x, y, z) = (x, s : y, z)++ ident :: Parser Ident ident = Ident <$> many1 (alphaNum <|> char '_' <|> char '\'')++ identPattern :: Parser [Ident]+ identPattern = (between+ (char '(' >> spaces)+ (spaces >> char ')' >> spaces)+ (sepBy1 ident (spaces >> char ',' >> spaces))+ ) <|> (return <$> ident) angle = do _ <- char '<' name' <- many $ noneOf " \t.#\r\n!>"@@ -226,10 +230,7 @@ xs <- many $ try ((many $ oneOf " \t") >> (tagIdent <|> tagCond <|> tagClass Nothing <|> tagAttrib Nothing)) _ <- many $ oneOf " \t"- c <- (eol >> return []) <|> (do- _ <- char '>'- c <- content InContent- return c)+ c <- (eol >> return []) <|> (char '>' >> content InContent) let (tn, attr, classes) = tag' $ TagName name : xs return $ LineTag tn attr c classes @@ -249,10 +250,10 @@ let (deeper, rest') = span (\(i', _) -> i' > i) rest in Nest l (nestLines deeper) : nestLines rest' -data Doc = DocForall Deref Ident [Doc]- | DocWith [(Deref,Ident)] [Doc]+data Doc = DocForall Deref [Ident] [Doc]+ | DocWith [(Deref, [Ident])] [Doc] | DocCond [(Deref, [Doc])] (Maybe [Doc])- | DocMaybe Deref Ident [Doc] (Maybe [Doc])+ | DocMaybe Deref [Ident] [Doc] (Maybe [Doc]) | DocContent Content deriving (Show, Eq, Read, Data, Typeable) @@ -367,7 +368,7 @@ ++ [DocContent $ ContentRaw "\""] attrToContent (Nothing, k, v) = -- only for class DocContent (ContentRaw (' ' : k ++ "=\""))- : concat (map go $ init v)+ : concatMap go (init v) ++ go' (last v) ++ [DocContent $ ContentRaw "\""] where@@ -450,7 +451,7 @@ -> Result ([(Deref, [Doc])], Maybe [Doc], [Nest]) parseConds set front (Nest LineElse inside:rest) = do inside' <- nestToDoc set inside- Ok $ (front [], Just inside', rest)+ Ok (front [], Just inside', rest) parseConds set front (Nest (LineElseIf d) inside:rest) = do inside' <- nestToDoc set inside parseConds set (front . (:) (d, inside')) rest
Text/Hamlet/RT.hs view
@@ -60,15 +60,17 @@ Error s' -> failure $ HamletParseException s' Ok x -> liftM HamletRT $ mapM convert x where- convert x@(DocForall deref (Ident ident) docs) = do+ convert x@(DocForall deref [Ident ident] docs) = do deref' <- flattenDeref' x deref docs' <- mapM convert docs return $ SDForall deref' ident docs'- convert x@(DocMaybe deref (Ident ident) jdocs ndocs) = do+ convert DocForall{} = error "Runtime Hamlet does not currently support tuple patterns"+ convert x@(DocMaybe deref [Ident ident] jdocs ndocs) = do deref' <- flattenDeref' x deref jdocs' <- mapM convert jdocs ndocs' <- maybe (return []) (mapM convert) ndocs return $ SDMaybe deref' ident jdocs' ndocs'+ convert DocMaybe{} = error "Runtime Hamlet does not currently support tuple patterns" convert (DocContent (ContentRaw s')) = return $ SDRaw s' convert x@(DocContent (ContentVar deref)) = do y <- flattenDeref' x deref
hamlet.cabal view
@@ -1,5 +1,5 @@ name: hamlet-version: 0.10.3+version: 0.10.4 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -8,7 +8,7 @@ description: Hamlet gives you a type-safe tool for generating HTML code. It works via Quasi-Quoting, and generating extremely efficient output code. The syntax is white-space sensitive, and it helps you avoid cross-site scripting issues and 404 errors. Please see the documentation at <http://docs.yesodweb.com/book/hamlet/> for more details. .- Here is a quick overview of hamlet html. Due to haddock escaping issues, we can't properly show variable insertion, but we are still going to show some conditionals. Please see http://www.yesodweb.com/book/templates for a thorough description+ Here is a quick overview of hamlet html. Due to haddock escaping issues, we can't properly show variable insertion, but we are still going to show some conditionals. Please see <http://www.yesodweb.com/book/templates> for a thorough description . > !!! > <html>@@ -40,7 +40,7 @@ library build-depends: base >= 4 && < 5- , shakespeare >= 0.10 && < 0.11+ , shakespeare >= 0.10.2 && < 0.11 , bytestring >= 0.9 && < 0.10 , template-haskell , blaze-html >= 0.4 && < 0.5
test/main.hs view
@@ -226,6 +226,39 @@ ^{embed} |] ihelper "<h1>Hola</h1>" $(ihamletFile "test/nonpolyihamlet.hamlet") + + , it "pattern-match tuples: forall" $ do + let people = [("Michael", 26), ("Miriam", 25)] + helper "<dl><dt>Michael</dt><dd>26</dd><dt>Miriam</dt><dd>25</dd></dl>" [hamlet| +<dl> + $forall (name, age) <- people + <dt>#{name} + <dd>#{show age} +|] + , it "pattern-match tuples: maybe" $ do + let people = Just ("Michael", 26) + helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet| +<dl> + $maybe (name, age) <- people + <dt>#{name} + <dd>#{show age} +|] + , it "pattern-match tuples: with" $ do + let people = ("Michael", 26) + helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet| +<dl> + $with (name, age) <- people + <dt>#{name} + <dd>#{show age} +|] + , it "list syntax for interpolation" $ do + helper "<ul><li>1</li><li>2</li><li>3</li></ul>" [hamlet| +<ul> + $forall num <- [1, 2, 3] + <li>#{show num} +|] + , it "infix operators" $ + helper "5" [hamlet|#{show $ (4 + 5) - (2 + 2)}|] ] data Url = Home | Sub SubUrl