diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs --- a/Text/Hamlet/Parse.hs +++ b/Text/Hamlet/Parse.hs @@ -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 $ ""]] - _ -> [] + CloseSeparate -> + DocContent [ContentRaw $ ""] + _ -> 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 diff --git a/hamlet.cabal b/hamlet.cabal --- a/hamlet.cabal +++ b/hamlet.cabal @@ -1,5 +1,5 @@ name: hamlet -version: 0.2.0 +version: 0.2.1 license: BSD3 license-file: LICENSE author: Michael Snoyman diff --git a/runtests.hs b/runtests.hs --- a/runtests.hs +++ b/runtests.hs @@ -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 "" [$hamlet|%select!:False:selected|] + helper "" [$hamlet|%select!:True:selected|] + helper "" [$hamlet|%meta!var=foo:bar|] + helper "" + [$hamlet|%select!:true.theArg:selected|]