xml-hamlet 0.4.0.12 → 0.4.1
raw patch · 6 files changed
+400/−75 lines, 6 filesdep ~xml-conduit
Dependency ranges changed: xml-conduit
Files
- ChangeLog.md +3/−0
- README.md +3/−0
- Text/Hamlet/XML.hs +163/−40
- Text/Hamlet/XMLParse.hs +197/−31
- test/main.hs +32/−2
- xml-hamlet.cabal +2/−2
+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.4.1++Add various hamlet features to xml-hamlet [#91](https://github.com/snoyberg/xml/pull/91)
+ README.md view
@@ -0,0 +1,3 @@+## xml-hamlet++Hamlet for XML
Text/Hamlet/XML.hs view
@@ -1,73 +1,169 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} module Text.Hamlet.XML ( xml , xmlFile+ , ToAttributes (..) ) where +#if MIN_VERSION_template_haskell(2,9,0)+import Language.Haskell.TH.Syntax hiding (Module)+#else import Language.Haskell.TH.Syntax+#endif import Language.Haskell.TH.Quote+import Data.Char (isDigit) import qualified Data.Text.Lazy as TL import Control.Monad ((<=<)) import Text.Hamlet.XMLParse import Text.Shakespeare.Base (readUtf8File, derefToExp, Scope, Deref, Ident (Ident))-import Data.Text (pack, unpack)+import Data.Text (Text, pack, unpack) import qualified Data.Text as T import qualified Text.XML as X import Data.String (fromString) import qualified Data.Foldable as F import Data.Maybe (fromMaybe) import qualified Data.Map as Map-import Control.Arrow (first)--xml :: QuasiQuoter-xml = QuasiQuoter { quoteExp = strToExp }--xmlFile :: FilePath -> Q Exp-xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File+import Control.Arrow (first, (***))+import Data.List (intercalate) -strToExp :: String -> Q Exp-strToExp s =- case parseDoc s of- Error e -> error e- Ok x -> docsToExp [] x+-- | Convert some value to a list of attribute pairs.+class ToAttributes a where+ toAttributes :: a -> Map.Map X.Name Text+instance ToAttributes (X.Name, Text) where+ toAttributes (k, v) = Map.singleton k v+instance ToAttributes (Text, Text) where+ toAttributes (k, v) = Map.singleton (fromString $ unpack k) v+instance ToAttributes (String, String) where+ toAttributes (k, v) = Map.singleton (fromString k) (pack v)+instance ToAttributes [(X.Name, Text)] where+ toAttributes = Map.fromList+instance ToAttributes [(Text, Text)] where+ toAttributes = Map.fromList . map (first (fromString . unpack))+instance ToAttributes [(String, String)] where+ toAttributes = Map.fromList . map (fromString *** pack)+instance ToAttributes (Map.Map X.Name Text) where+ toAttributes = id+instance ToAttributes (Map.Map Text Text) where+ toAttributes = Map.mapKeys (fromString . unpack)+instance ToAttributes (Map.Map String String) where+ toAttributes = Map.mapKeys fromString . Map.map pack docsToExp :: Scope -> [Doc] -> Q Exp docsToExp scope docs = [| concat $(fmap ListE $ mapM (docToExp scope) docs) |] +unIdent :: Ident -> String+unIdent (Ident s) = s++bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])+bindingPattern (BindAs i@(Ident s) b) = do+ name <- newName s+ (pattern, scope) <- bindingPattern b+ return (AsP name pattern, (i, VarE name):scope)+bindingPattern (BindVar i@(Ident s))+ | s == "_" = return (WildP, [])+ | all isDigit s = do+ return (LitP $ IntegerL $ read s, [])+ | otherwise = do+ name <- newName s+ return (VarP name, [(i, VarE name)])+bindingPattern (BindTuple is) = do+ (patterns, scopes) <- fmap unzip $ mapM bindingPattern is+ return (TupP patterns, concat scopes)+bindingPattern (BindList is) = do+ (patterns, scopes) <- fmap unzip $ mapM bindingPattern is+ return (ListP patterns, concat scopes)+bindingPattern (BindConstr con is) = do+ (patterns, scopes) <- fmap unzip $ mapM bindingPattern is+ return (ConP (mkConName con) patterns, concat scopes)+bindingPattern (BindRecord con fields wild) = do+ let f (Ident field,b) =+ do (p,s) <- bindingPattern b+ return ((mkName field,p),s)+ (patterns, scopes) <- fmap unzip $ mapM f fields+ (patterns1, scopes1) <- if wild+ then bindWildFields con $ map fst fields+ else return ([],[])+ return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1)++mkConName :: DataConstr -> Name+mkConName = mkName . conToStr++conToStr :: DataConstr -> String+conToStr (DCUnqualified (Ident x)) = x+conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]++-- Wildcards bind all of the unbound fields to variables whose name+-- matches the field name.+--+-- For example: data R = C { f1, f2 :: Int }+-- C {..} is equivalent to C {f1=f1, f2=f2}+-- C {f1 = a, ..} is equivalent to C {f1=a, f2=f2}+-- C {f2 = a, ..} is equivalent to C {f1=f1, f2=a}+bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])+bindWildFields conName fields = do+ fieldNames <- recordToFieldNames conName+ let available n = nameBase n `notElem` map unIdent fields+ let remainingFields = filter available fieldNames+ let mkPat n = do+ e <- newName (nameBase n)+ return ((n,VarP e), (Ident (nameBase n), VarE e))+ fmap unzip $ mapM mkPat remainingFields++-- Important note! reify will fail if the record type is defined in the+-- same module as the reify is used. This means quasi-quoted Hamlet+-- literals will not be able to use wildcards to match record types+-- defined in the same module.+recordToFieldNames :: DataConstr -> Q [Name]+recordToFieldNames conStr = do+ -- use 'lookupValueName' instead of just using 'mkName' so we reify the+ -- data constructor and not the type constructor if their names match.+ Just conName <- lookupValueName $ conToStr conStr+#if MIN_VERSION_template_haskell(2,11,0)+ DataConI _ _ typeName <- reify conName+ TyConI (DataD _ _ _ _ cons _) <- reify typeName+#else+ DataConI _ _ typeName _ <- reify conName+ TyConI (DataD _ _ _ cons _) <- reify typeName+#endif+ [fields] <- return [fields | RecC name fields <- cons, name == conName]+ return [fieldName | (fieldName, _, _) <- fields]+ docToExp :: Scope -> Doc -> Q Exp-docToExp scope (DocTag name attrs cs) =- [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs) $(docsToExp scope cs))+docToExp scope (DocTag name attrs attrsD cs) =+ [| [ X.NodeElement (X.Element ($(liftName name)) $(mkAttrs scope attrs attrsD) $(docsToExp scope cs)) ] |] docToExp _ (DocContent (ContentRaw s)) = [| [ X.NodeContent (pack $(lift s)) ] |] docToExp scope (DocContent (ContentVar d)) = [| [ X.NodeContent $(return $ derefToExp scope d) ] |] docToExp scope (DocContent (ContentEmbed d)) = return $ derefToExp scope d-docToExp scope (DocForall deref ident@(Ident ident') inside) = do- let list' = derefToExp scope deref- name <- newName ident'- let scope' = (ident, VarE name) : scope+docToExp scope (DocForall list idents inside) = do+ let list' = derefToExp scope list+ (pat, extraScope) <- bindingPattern idents+ let scope' = extraScope ++ scope+ mh <- [|F.concatMap|] inside' <- docsToExp scope' inside- let lam = LamE [VarP name] inside'- [| F.concatMap $(return lam) $(return list') |]+ let lam = LamE [pat] inside'+ return $ mh `AppE` lam `AppE` list' docToExp scope (DocWith [] inside) = docsToExp scope inside-docToExp scope (DocWith ((deref, ident@(Ident name)):dis) inside) = do+docToExp scope (DocWith ((deref, idents):dis) inside) = do let deref' = derefToExp scope deref- name' <- newName name- let scope' = (ident, VarE name') : scope+ (pat, extraScope) <- bindingPattern idents+ let scope' = extraScope ++ scope inside' <- docToExp scope' (DocWith dis inside)- let lam = LamE [VarP name'] inside'+ let lam = LamE [pat] inside' return $ lam `AppE` deref'-docToExp scope (DocMaybe deref ident@(Ident name) just nothing) = do- let deref' = derefToExp scope deref- name' <- newName name- let scope' = (ident, VarE name') : scope- inside' <- docsToExp scope' just- let inside'' = LamE [VarP name'] inside'- nothing' <-- case nothing of- Nothing -> [| [] |]- Just n -> docsToExp scope n- [| maybe $(return nothing') $(return inside'') $(return deref') |]+docToExp scope (DocMaybe val idents inside mno) = do+ let val' = derefToExp scope val+ (pat, extraScope) <- bindingPattern idents+ let scope' = extraScope ++ scope+ inside' <- docsToExp scope' inside+ let inside'' = LamE [pat] inside'+ ninside' <- case mno of+ Nothing -> [| [] |]+ Just no -> docsToExp scope no+ [| maybe $(return ninside') $(return inside'') $(return val') |] docToExp scope (DocCond conds final) = do unit <- [| () |] otherwise' <- [|otherwise|]@@ -77,11 +173,25 @@ go (deref, inside) = do inside' <- docsToExp scope inside return (NormalG deref, inside')+docToExp scope (DocCase deref cases) = do+ let exp_ = derefToExp scope deref+ matches <- mapM toMatch cases+ return $ CaseE exp_ matches+ where+ toMatch :: (Binding, [Doc]) -> Q Match+ toMatch (idents, inside) = do+ (pat, extraScope) <- bindingPattern idents+ let scope' = extraScope ++ scope+ insideExp <- docsToExp scope' inside+ return $ Match pat (NormalB insideExp) [] -mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> Q Exp-mkAttrs _ [] = [| Map.empty |]-mkAttrs scope ((mderef, name, value):rest) = do- rest' <- mkAttrs scope rest+mkAttrs :: Scope -> [(Maybe Deref, String, [Content])] -> [Deref] -> Q Exp+mkAttrs _ [] [] = [| Map.empty |]+mkAttrs scope [] (deref:rest) = do+ rest' <- mkAttrs scope [] rest+ [| Map.union (toAttributes $(return $ derefToExp scope deref)) $(return rest') |]+mkAttrs scope ((mderef, name, value):rest) attrs = do+ rest' <- mkAttrs scope rest attrs this <- [| Map.insert $(liftName name) (T.concat $(fmap ListE $ mapM go value)) |] let with = [| $(return this) $(return rest') |] case mderef of@@ -98,3 +208,16 @@ case mns of Nothing -> [| X.Name (pack $(lift $ unpack local)) Nothing Nothing |] Just ns -> [| X.Name (pack $(lift $ unpack local)) (Just $ pack $(lift $ unpack ns)) Nothing |]++xml :: QuasiQuoter+xml = QuasiQuoter { quoteExp = strToExp }++xmlFile :: FilePath -> Q Exp+xmlFile = strToExp . TL.unpack <=< qRunIO . readUtf8File++strToExp :: String -> Q Exp+strToExp s =+ case parseDoc s of+ Error e -> error e+ Ok x -> docsToExp [] x+
Text/Hamlet/XMLParse.hs view
@@ -6,12 +6,16 @@ , Content (..) , Doc (..) , parseDoc+ , Binding (..)+ , DataConstr (..)+ , Module (..) ) where import Text.Shakespeare.Base import Control.Applicative ((<$>), Applicative (..)) import Control.Monad+import Data.Char (isUpper) import Data.Data import Text.ParserCombinators.Parsec hiding (Line) @@ -33,17 +37,20 @@ | ContentEmbed Deref deriving (Show, Eq, Read, Data, Typeable) -data Line = LineForall Deref Ident+data Line = LineForall Deref Binding | LineIf Deref | LineElseIf Deref | LineElse- | LineWith [(Deref, Ident)]- | LineMaybe Deref Ident+ | LineWith [(Deref, Binding)]+ | LineMaybe Deref Binding | LineNothing+ | LineCase Deref+ | LineOf Binding | LineTag { _lineTagName :: String , _lineAttr :: [(Maybe Deref, String, [Content])] , _lineContent :: [Content]+ , _lineAttrs :: [Deref] } | LineContent [Content] deriving (Eq, Show, Read)@@ -57,7 +64,7 @@ parseLine :: Parser (Int, Line) parseLine = do ss <- fmap sum $ many ((char ' ' >> return 1) <|>- (char '\t' >> return 4))+ (char '\t' >> fail "Tabs are not allowed in Hamlet indentation")) x <- comment <|> htmlComment <|> backslash <|>@@ -68,7 +75,10 @@ (try (string "$nothing") >> spaceTabs >> eol >> return LineNothing) <|> controlForall <|> controlWith <|>+ controlCase <|>+ controlOf <|> angle <|>+ invalidDollar <|> (eol' >> return (LineContent [])) <|> (do cs <- content InContent@@ -80,7 +90,9 @@ where eol' = (char '\n' >> return ()) <|> (string "\r\n" >> return ()) eol = eof <|> eol'- spaceTabs = many $ oneOf " \t"+ invalidDollar = do+ _ <- char '$'+ fail "Received a command I did not understand. If you wanted a literal $, start the line with a backslash." comment = do _ <- try $ string "$#" _ <- many $ noneOf "\r\n"@@ -117,7 +129,7 @@ eol return $ LineElseIf x binding = do- y <- ident+ y <- identPattern spaces _ <- string "<-" spaces@@ -142,10 +154,24 @@ spaces bindings <- (binding `sepBy` bindingSep) `endBy` eol return $ LineWith $ concat bindings -- concat because endBy returns a [[(Deref,Ident)]]+ controlCase = do+ _ <- try $ string "$case"+ spaces+ x <- parseDeref+ _ <- spaceTabs+ eol+ return $ LineCase x+ controlOf = do+ _ <- try $ string "$of"+ spaces+ x <- identPattern+ _ <- spaceTabs+ eol+ return $ LineOf x content cr = do x <- many $ content' cr case cr of- InQuotes -> char '"' >> return ()+ InQuotes -> void $ char '"' NotInQuotes -> return () NotInQuotesAttr -> return () InContent -> eol@@ -154,10 +180,15 @@ cc [] = [] cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c cc (a:b) = a : cc b- content' cr = contentHash <|> contentCaret <|> contentReg cr- contentHash = do+ content' cr = contentHash cr+ <|> contentCaret+ <|> contentReg cr+ contentHash cr = do x <- parseHash case x of+ Left "#" -> case cr of+ NotInQuotes -> fail "Expected hash at end of line, got Id"+ _ -> return $ ContentRaw "#" Left str -> return $ ContentRaw str Right deref -> return $ ContentVar deref contentCaret = do@@ -168,40 +199,147 @@ contentReg InContent = (ContentRaw . return) <$> noneOf "#@^\r\n" contentReg NotInQuotes = (ContentRaw . return) <$> noneOf "@^#. \t\n\r>" contentReg NotInQuotesAttr = (ContentRaw . return) <$> noneOf "@^ \t\n\r>"- contentReg InQuotes = (ContentRaw . return) <$> noneOf "#@^\\\"\n\r>"+ contentReg InQuotes = (ContentRaw . return) <$> noneOf "#@^\"\n\r" tagAttribValue notInQuotes = do cr <- (char '"' >> return InQuotes) <|> return notInQuotes content cr tagCond = do- _ <- char ':'- d <- parseDeref- _ <- char ':'+ d <- between (char ':') (char ':') parseDeref tagAttrib (Just d) 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) = (s, y)- tag'' (TagAttrib s) (x, y) = (x, s : y)- ident = Ident <$> many1 (alphaNum <|> char '_' <|> char '\'')++ tagAttrs = do+ _ <- char '*'+ d <- between (char '{') (char '}') parseDeref+ return $ TagAttribs d++ tag' = foldr tag'' ("div", [], [])+ tag'' (TagName s) (_, y, as) = (s, y, as)+ tag'' (TagAttrib s) (x, y, as) = (x, s : y, as)+ tag'' (TagAttribs s) (x, y, as) = (x, y, s : as)++ ident :: Parser Ident+ ident = do+ i <- many1 (alphaNum <|> char '_' <|> char '\'')+ white+ return (Ident i)+ <?> "identifier"++ parens = between (char '(' >> white) (char ')' >> white)++ brackets = between (char '[' >> white) (char ']' >> white)++ braces = between (char '{' >> white) (char '}' >> white)++ comma = char ',' >> white++ atsign = char '@' >> white++ equals = char '=' >> white++ white = skipMany $ char ' '++ wildDots = string ".." >> white++ isVariable (Ident (x:_)) = not (isUpper x)+ isVariable (Ident []) = error "isVariable: bad identifier"++ isConstructor (Ident (x:_)) = isUpper x+ isConstructor (Ident []) = error "isConstructor: bad identifier"++ identPattern :: Parser Binding+ identPattern = gcon True <|> apat+ where+ apat = choice+ [ varpat+ , gcon False+ , parens tuplepat+ , brackets listpat+ ]++ varpat = do+ v <- try $ do v <- ident+ guard (isVariable v)+ return v+ option (BindVar v) $ do+ atsign+ b <- apat+ return (BindAs v b)+ <?> "variable"++ gcon :: Bool -> Parser Binding+ gcon allowArgs = do+ c <- try $ do c <- dataConstr+ return c+ choice+ [ record c+ , fmap (BindConstr c) (guard allowArgs >> many apat)+ , return (BindConstr c [])+ ]+ <?> "constructor"++ dataConstr = do+ p <- dcPiece+ ps <- many dcPieces+ return $ toDataConstr p ps++ dcPiece = do+ x@(Ident y) <- ident+ guard $ isConstructor x+ return y++ dcPieces = do+ _ <- char '.'+ dcPiece++ toDataConstr x [] = DCUnqualified $ Ident x+ toDataConstr x (y:ys) =+ go (x:) y ys+ where+ go front next [] = DCQualified (Module $ front []) (Ident next)+ go front next (rest:rests) = go (front . (next:)) rest rests++ record c = braces $ do+ (fields, wild) <- option ([], False) $ go+ return (BindRecord c fields wild)+ where+ go = (wildDots >> return ([], True))+ <|> (do x <- recordField+ (xs,wild) <- option ([],False) (comma >> go)+ return (x:xs,wild))++ recordField = do+ field <- ident+ p <- option (BindVar field) -- support punning+ (equals >> identPattern)+ return (field,p)++ tuplepat = do+ xs <- identPattern `sepBy` comma+ return $ case xs of+ [x] -> x+ _ -> BindTuple xs++ listpat = BindList <$> identPattern `sepBy` comma+ angle = do _ <- char '<' name' <- many $ noneOf " \t\r\n>" let name = if null name' then "div" else name' xs <- many $ try ((many $ oneOf " \t\r\n") >>- (tagCond <|> tagAttrib Nothing))- _ <- many $ oneOf " \t"+ (tagCond <|> tagAttrs <|> tagAttrib Nothing))+ _ <- many $ oneOf " \t\r\n" _ <- char '>' c <- content InContent- let (tn, attr) = tag' $ TagName name : xs- return $ LineTag tn attr c+ let (tn, attr, attrsd) = tag' $ TagName name : xs+ return $ LineTag tn attr c attrsd data TagPiece = TagName String | TagAttrib (Maybe Deref, String, [Content])+ | TagAttribs Deref deriving Show data ContentRule = InQuotes | NotInQuotes | NotInQuotesAttr | InContent@@ -214,11 +352,12 @@ 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 Binding [Doc]+ | DocWith [(Deref, Binding)] [Doc] | DocCond [(Deref, [Doc])] (Maybe [Doc])- | DocMaybe Deref Ident [Doc] (Maybe [Doc])- | DocTag String [(Maybe Deref, String, [Content])] [Doc]+ | DocMaybe Deref Binding [Doc] (Maybe [Doc])+ | DocCase Deref [(Binding, [Doc])]+ | DocTag String [(Maybe Deref, String, [Content])] [Deref] [Doc] | DocContent Content -- FIXME PIs deriving (Show, Eq, Read, Data, Typeable)@@ -248,10 +387,18 @@ _ -> return (Nothing, rest) rest'' <- nestToDoc rest' Ok $ DocMaybe d i inside' nothing : rest''-nestToDoc (Nest (LineTag tn attrs content) inside:rest) = do+nestToDoc (Nest (LineCase d) inside:rest) = do+ let getOf (Nest (LineOf x) insideC) = do+ insideC' <- nestToDoc insideC+ Ok (x, insideC')+ getOf _ = Error "Inside a $case there may only be $of. Use '$of _' for a wildcard."+ cases <- mapM getOf inside+ rest' <- nestToDoc rest+ Ok $ DocCase d cases : rest'+nestToDoc (Nest (LineTag tn attrs content attrsD) inside:rest) = do inside' <- nestToDoc inside rest' <- nestToDoc rest- Ok $ (DocTag tn attrs $ map DocContent content ++ inside') : rest'+ Ok $ (DocTag tn attrs attrsD $ map DocContent content ++ inside') : rest' nestToDoc (Nest (LineContent content) inside:rest) = do inside' <- nestToDoc inside rest' <- nestToDoc rest@@ -259,6 +406,7 @@ nestToDoc (Nest (LineElseIf _) _:_) = Error "Unexpected elseif" nestToDoc (Nest LineElse _:_) = Error "Unexpected else" nestToDoc (Nest LineNothing _:_) = Error "Unexpected nothing"+nestToDoc (Nest (LineOf _) _:_) = Error "Unexpected 'of' (did you forget a $case?)" parseDoc :: String -> Result [Doc] parseDoc s = do@@ -279,3 +427,21 @@ inside' <- nestToDoc inside parseConds (front . (:) (d, inside')) rest parseConds front rest = Ok (front [], Nothing, rest)++data Binding = BindVar Ident+ | BindAs Ident Binding+ | BindConstr DataConstr [Binding]+ | BindTuple [Binding]+ | BindList [Binding]+ | BindRecord DataConstr [(Ident, Binding)] Bool+ deriving (Eq, Show, Read, Data, Typeable)++data DataConstr = DCQualified Module Ident+ | DCUnqualified Ident+ deriving (Eq, Show, Read, Data, Typeable)++newtype Module = Module [String]+ deriving (Eq, Show, Read, Data, Typeable)++spaceTabs :: Parser String+spaceTabs = many $ oneOf " \t"
test/main.hs view
@@ -59,11 +59,11 @@ it "handles attributes" $ [xml| <foo> <bar here=there>- <baz :False:false=false :True:true=#{true}>+ <baz :False:false=false :True:true=#{true} *{attrs}> |] @?= [ X.NodeElement $ X.Element "foo" Map.empty [ X.NodeElement $ X.Element "bar" (Map.singleton "here" "there")- [ X.NodeElement $ X.Element "baz" (Map.singleton "true" "true") []+ [ X.NodeElement $ X.Element "baz" (Map.fromList (("true", "true") : attrs)) [] ] ] ]@@ -119,6 +119,34 @@ , X.NodeElement $ X.Element "four" Map.empty [] , X.NodeElement $ X.Element "seven" Map.empty [] ]+ it "case on Maybe" $+ let nothing = Nothing+ justTrue = Just True+ in [xml|+$case nothing+ $of Just val+ $of Nothing+ <one>+$case justTrue+ $of Just val+ $if val+ <two>+ $of Nothing+$case (Just $ not False)+ $of Nothing+ $of Just val+ $if val+ <three>+$case Nothing+ $of Just val+ $of _+ <four>+|] @?=+ [ X.NodeElement $ X.Element "one" Map.empty []+ , X.NodeElement $ X.Element "two" Map.empty []+ , X.NodeElement $ X.Element "three" Map.empty []+ , X.NodeElement $ X.Element "four" Map.empty []+ ] it "recognizes clark notation" $ [xml| <{foo}bar {baz}bin="x"> |] @?= [X.NodeElement $ X.Element "{foo}bar" (Map.singleton "{baz}bin" "x") []]@@ -131,10 +159,12 @@ bin=bin>content |] @?= [xml|<foo bar=baz bin=bin>content|] it "short circuiting of attributes" $ [xml|<foo :False:x=#{undefined}>|] @?= [xml|<foo>|]+ it "Hash in attribute value" $ [xml|<a href=#>|] @?= [xml|<a href="#">|] where bin = "bin" nodes = [X.NodeInstruction $ X.Instruction "ifoo" "ibar"] true = "true"+ attrs = [("one","a"), ("two","b")] xs = ["foo", "bar", "baz"] comment = [X.NodeComment "somecomment"]
xml-hamlet.cabal view
@@ -1,5 +1,5 @@ Name: xml-hamlet-Version: 0.4.0.12+Version: 0.4.1 Synopsis: Hamlet-style quasiquoter for XML content Homepage: http://www.yesodweb.com/ License: BSD3@@ -9,7 +9,7 @@ Category: Text Build-type: Simple Description: Hamlet-style quasiquoter for XML content-Extra-source-files: test/main.hs+Extra-source-files: test/main.hs ChangeLog.md README.md Cabal-version: >=1.8