hamlet 0.2.0 → 0.2.1
raw patch · 3 files changed
+76/−36 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Text/Hamlet/Parse.hs +66/−35
- hamlet.cabal +1/−1
- runtests.hs +9/−0
Text/Hamlet/Parse.hs view
@@ -58,7 +58,7 @@ | LineMaybe Deref Ident | LineTag { _lineTagName :: String- , _lineAttr :: [(String, [Content])]+ , _lineAttr :: [(Maybe Deref, String, [Content])] , _lineContent :: [Content] , _lineClasses :: [[Content]] }@@ -117,14 +117,14 @@ parseLine' "$elseif foo.bar" @?= Ok (LineElseIf fooBar) parseLine' "$else" @?= Ok LineElse parseLine' "%img!src=@foo.bar@"- @?= Ok (LineTag "img" [("src", [ContentUrl False fooBar])] [] [])+ @?= Ok (LineTag "img" [(Nothing, "src", [ContentUrl False fooBar])] [] []) parseLine' "%img!src=@?foo.bar@"- @?= Ok (LineTag "img" [("src", [ContentUrl True fooBar])] [] [])+ @?= Ok (LineTag "img" [(Nothing, "src", [ContentUrl True fooBar])] [] []) parseLine' ".$foo.bar$" @?= Ok (LineTag "div" [] [] [[ContentVar fooBar]]) parseLine' "%span#foo.bar.bar2!baz=bin"- @?= Ok (LineTag "span" [ ("id", [ContentRaw "foo"])- , ("baz", [ContentRaw "bin"])+ @?= Ok (LineTag "span" [ (Nothing, "id", [ContentRaw "foo"])+ , (Nothing, "baz", [ContentRaw "bin"]) ] [] [ [ContentRaw "bar"] , [ContentRaw "bar2"]@@ -133,6 +133,11 @@ @?= Ok (LineContent [ContentRaw "#this is raw"]) parseLine' "\\" @?= Ok (LineContent [ContentRaw "\n"])+ parseLine' "%img!:baz:src=@foo.bar@"+ @?= Ok (LineTag "img"+ [(Just $ Deref [(False, Ident "baz")],+ "src",+ [ContentUrl False fooBar])] [] []) #endif parseContent :: String -> Result [Content]@@ -228,34 +233,46 @@ parseIdent "*foo" @?= Ok (True, Ident "foo") #endif -parseTag :: String -> Result (String, [(String, [Content])], [[Content]])+parseTag :: String -> Result+ (String,+ [(Maybe Deref, String, [Content])],+ [[Content]]) parseTag s = do pieces <- takePieces s (a, b, c) <- foldM go ("div", id, id) pieces return (a, b [], c []) where- go (_, attrs, classes) ('%':tn) = Ok (tn, attrs, classes)- go (tn, attrs, classes) ('.':cl) = do+ go (_, attrs, classes) (_, '%':tn) = Ok (tn, attrs, classes)+ go (tn, attrs, classes) (_, '.':cl) = do con <- parseContent cl Ok (tn, attrs, classes . (:) con)- go (tn, attrs, classes) ('#':cl) = do+ go (tn, attrs, classes) (_, '#':cl) = do con <- parseContent cl- Ok (tn, attrs . (:) ("id", con), classes)- go (tn, attrs, classes) ('!':rest) = do+ Ok (tn, attrs . (:) (Nothing, "id", con), classes)+ go (tn, attrs, classes) (cond, '!':rest) = do let (name, val) = break (== '=') rest- val' <-- case val of- ('=':rest') -> parseContent rest'- _ -> Ok []- Ok (tn, attrs . (:) (name, val'), classes)+ val' <- case val of+ '=':x -> parseContent x+ _ -> Ok []+ cond' <- case cond of+ Nothing -> return Nothing+ Just x -> Just <$> parseDeref x+ Ok (tn, attrs . (:) (cond', name, val'), classes) go _ _ = error "Invalid branch in Text.Hamlet.Parse.parseTag" -takePieces :: String -> Result [String]+takePieces :: String -> Result [(Maybe String, String)] takePieces "" = Ok [] takePieces (a:s) = do- (x, y) <- takePiece ((:) a) False False False s+ let (cond, s') =+ case (a, s) of+ ('!', ':':rest) ->+ case break (== ':') rest of+ (x, ':':y) -> (Just x, y)+ _ -> (Nothing, s)+ _ -> (Nothing, s)+ (x, y) <- takePiece ((:) a) False False False s' y' <- takePieces y- return $ x : y'+ return $ (cond, x) : y' where takePiece front False False False "" = Ok (front "", "") takePiece _ _ _ _ "" = Error $ "Unterminated URL, var or embed: " ++ s@@ -297,26 +314,33 @@ rest' <- nestToDoc set rest Ok $ DocMaybe d i inside' : rest' nestToDoc set (Nest (LineTag tn attrs content classes) inside:rest) = do- let attrs' = case classes of- [] -> attrs- _ -> ("class", intercalate [ContentRaw " "] classes)+ let attrs' =+ case classes of+ [] -> attrs+ _ -> (Nothing, "class", intercalate [ContentRaw " "] classes) : attrs let closeStyle = if not (null content) || not (null inside) then CloseSeparate else closeTag set tn let end = case closeStyle of- CloseSeparate -> [DocContent [ContentRaw $ "</" ++ tn ++ ">"]]- _ -> []+ CloseSeparate ->+ DocContent [ContentRaw $ "</" ++ tn ++ ">"]+ _ -> DocContent [] seal = case closeStyle of- CloseInside -> ContentRaw "/>"- _ -> ContentRaw ">"- start = ContentRaw $ "<" ++ tn- attrs'' = concatMap attrToContent attrs'+ CloseInside -> DocContent [ContentRaw "/>"]+ _ -> DocContent [ContentRaw ">"]+ start = DocContent [ContentRaw $ "<" ++ tn]+ attrs'' = map attrToContent attrs' inside' <- nestToDoc set inside rest' <- nestToDoc set rest- Ok $ DocContent (start : attrs'' ++ seal : content)- : inside' ++ end ++ rest'+ Ok $ start+ : attrs''+ ++ seal+ : DocContent content+ : inside'+ ++ end+ : rest' nestToDoc set (Nest (LineContent content) inside:rest) = do inside' <- nestToDoc set inside rest' <- nestToDoc set rest@@ -330,6 +354,8 @@ DocForall d i (compressDoc doc) : compressDoc rest compressDoc (DocMaybe d i doc:rest) = DocMaybe d i (compressDoc doc) : compressDoc rest+compressDoc (DocCond [(a, x)] Nothing:DocCond [(b, y)] Nothing:rest)+ | a == b = compressDoc $ DocCond [(a, x ++ y)] Nothing : rest compressDoc (DocCond x y:rest) = DocCond (map (second compressDoc) x) (compressDoc `fmap` y) : compressDoc rest@@ -339,10 +365,11 @@ DocContent (compressContent x) : compressDoc rest compressContent :: [Content] -> [Content]+compressContent [] = [] compressContent (ContentRaw "":rest) = compressContent rest-compressContent (ContentRaw x:ContentRaw y:rest) = compressContent $ ContentRaw (x ++ y) : rest+compressContent (ContentRaw x:ContentRaw y:rest) =+ compressContent $ ContentRaw (x ++ y) : rest compressContent (x:rest) = x : compressContent rest-compressContent [] = [] parseDoc :: HamletSettings -> String -> Result [Doc] parseDoc set s = do@@ -351,9 +378,13 @@ ds <- nestToDoc set ns return $ compressDoc ds -attrToContent :: (String, [Content]) -> [Content]-attrToContent (k, []) = [ContentRaw $ ' ' : k]-attrToContent (k, v) = (ContentRaw $ ' ' : k ++ "=\"") : v ++ [ContentRaw "\""]+attrToContent :: (Maybe Deref, String, [Content]) -> Doc+attrToContent (Just cond, k, v) =+ DocCond [(cond, [attrToContent (Nothing, k, v)])] Nothing+attrToContent (Nothing, k, []) = DocContent [ContentRaw $ ' ' : k]+attrToContent (Nothing, k, v) = DocContent $+ ContentRaw (' ' : k ++ "=\"")+ : v ++ [ContentRaw "\""] -- | Settings for parsing of a hamlet document. data HamletSettings = HamletSettings
hamlet.cabal view
@@ -1,5 +1,5 @@ name: hamlet-version: 0.2.0+version: 0.2.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>
runtests.hs view
@@ -58,6 +58,7 @@ , testCase "url + params monad" caseUrlParamsMonad , testCase "escape" caseEscape , testCase "empty statement list" caseEmptyStatementList+ , testCase "attribute conditionals" caseAttribCond ] data Url = Home | Sub SubUrl@@ -356,3 +357,11 @@ helper "" [$hamlet|$maybe Nothing x|] let emptyList = [] helper "" [$hamlet|$forall emptyList x|]++caseAttribCond :: Assertion+caseAttribCond = do+ helper "<select></select>" [$hamlet|%select!:False:selected|]+ helper "<select selected></select>" [$hamlet|%select!:True:selected|]+ helper "<meta var=\"foo:bar\">" [$hamlet|%meta!var=foo:bar|]+ helper "<select selected></select>"+ [$hamlet|%select!:true.theArg:selected|]