hamlet 1.0.1.4 → 1.1.0
raw patch · 6 files changed
+228/−121 lines, 6 filesdep ~blaze-htmldep ~hspecdep ~shakespearePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: blaze-html, hspec, shakespeare
API changes (from Hackage documentation)
+ Text.Hamlet: AlwaysNewlines :: NewlineStyle
+ Text.Hamlet: DefaultNewlineStyle :: NewlineStyle
+ Text.Hamlet: NewlinesText :: NewlineStyle
+ Text.Hamlet: NoNewlines :: NewlineStyle
+ Text.Hamlet: data NewlineStyle
+ Text.Hamlet: hamletDoctypeNames :: HamletSettings -> [(String, String)]
- Text.Hamlet: HamletSettings :: String -> Bool -> (String -> CloseStyle) -> HamletSettings
+ Text.Hamlet: HamletSettings :: String -> NewlineStyle -> (String -> CloseStyle) -> [(String, String)] -> HamletSettings
- Text.Hamlet: hamletNewlines :: HamletSettings -> Bool
+ Text.Hamlet: hamletNewlines :: HamletSettings -> NewlineStyle
Files
- Text/Hamlet.hs +6/−10
- Text/Hamlet/Parse.hs +83/−43
- Text/Hamlet/RT.hs +1/−1
- hamlet.cabal +4/−14
- test.hs +2/−2
- test/HamletTest.hs +132/−51
Text/Hamlet.hs view
@@ -28,6 +28,7 @@ , ToAttributes (..) -- * Internal, for making more , HamletSettings (..)+ , NewlineStyle (..) , hamletWithSettings , hamletFileWithSettings , defaultHamletSettings@@ -46,12 +47,8 @@ import Data.Maybe (fromMaybe) import Data.Text (Text, pack) import qualified Data.Text.Lazy as TL-#if MIN_VERSION_blaze_html(0,5,0) import Text.Blaze.Html (Html, toHtml) import Text.Blaze.Internal (preEscapedText)-#else-import Text.Blaze (Html, preEscapedText, toHtml)-#endif import qualified Data.Foldable as F import Control.Monad (mplus) import Data.Monoid (mempty, mappend)@@ -218,11 +215,6 @@ hamlet :: QuasiQuoter hamlet = hamletWithSettings hamletRules defaultHamletSettings --- | A variant which adds newlines to the output. Useful for debugging--- but may alter browser page layout.-hamlet' :: QuasiQuoter-hamlet' = hamletWithSettings hamletRules defaultHamletSettings{hamletNewlines=True}- xhamlet :: QuasiQuoter xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings @@ -286,7 +278,11 @@ hr <- qhr case parseDoc set s of Error s' -> error s'- Ok d -> hrWithEnv hr $ \env -> docsToExp env hr [] d+ Ok (mnl, d) -> do+ case (mnl, hamletNewlines set) of+ (Nothing, DefaultNewlineStyle) -> qReport False "Warning: default newline style has changed, using an explicit $newline is recommended"+ _ -> return ()+ hrWithEnv hr $ \env -> docsToExp env hr [] d hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp hamletFileWithSettings qhr set fp = do
Text/Hamlet/Parse.hs view
@@ -8,9 +8,9 @@ , HamletSettings (..) , defaultHamletSettings , xhtmlHamletSettings- , debugHamletSettings , CloseStyle (..) , Binding (..)+ , NewlineStyle (..) ) where @@ -60,16 +60,39 @@ , _lineContent :: [Content] , _lineClasses :: [(Maybe Deref, [Content])] , _lineAttrs :: [Deref]+ , _lineNoNewline :: Bool }- | LineContent [Content]+ | LineContent [Content] Bool -- ^ True == avoid newlines deriving (Eq, Show, Read) -parseLines :: HamletSettings -> String -> Result [(Int, Line)]+parseLines :: HamletSettings -> String -> Result (Maybe NewlineStyle, HamletSettings, [(Int, Line)]) parseLines set s =- case parse (many $ parseLine set) s s of+ case parse parser s s of Left e -> Error $ show e Right x -> Ok x+ where+ parser = do+ mnewline <- parseNewline+ let set' =+ case mnewline of+ Nothing ->+ case hamletNewlines set of+ DefaultNewlineStyle -> set { hamletNewlines = AlwaysNewlines }+ _ -> set+ Just n -> set { hamletNewlines = n }+ res <- many (parseLine set')+ return (mnewline, set', res) + parseNewline =+ (try (many eol' >> string "$newline ") >> parseNewline' >>= \nl -> eol' >> return nl) <|>+ return Nothing+ parseNewline' =+ (try (string "always") >> return (Just AlwaysNewlines)) <|>+ (try (string "never") >> return (Just NoNewlines)) <|>+ (try (string "text") >> return (Just NewlinesText))++ eol' = (char '\n' >> return ()) <|> (string "\r\n" >> return ())+ parseLine :: HamletSettings -> Parser (Int, Line) parseLine set = do ss <- fmap sum $ many ((char ' ' >> return 1) <|>@@ -78,6 +101,7 @@ doctypeDollar <|> comment <|> htmlComment <|>+ doctypeRaw <|> backslash <|> controlIf <|> controlElseIf <|>@@ -90,13 +114,13 @@ controlOf <|> angle <|> invalidDollar <|>- (eol' >> return (LineContent [])) <|>+ (eol' >> return (LineContent [] True)) <|> (do- cs <- content InContent+ (cs, avoidNewLines) <- content InContent isEof <- (eof >> return True) <|> return False if null cs && ss == 0 && isEof then fail "End of Hamlet template"- else return $ LineContent cs)+ else return $ LineContent cs avoidNewLines) return (ss, x) where eol' = (char '\n' >> return ()) <|> (string "\r\n" >> return ())@@ -104,15 +128,21 @@ spaceTabs = many $ oneOf " \t" doctype = do try $ string "!!!" >> eol- return $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"]+ return $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"] True doctypeDollar = do _ <- try $ string "$doctype " name <- many $ noneOf "\r\n" eol- case lookup name doctypeNames of+ case lookup name $ hamletDoctypeNames set of Nothing -> fail $ "Unknown doctype name: " ++ name- Just val -> return $ LineContent [ContentRaw $ val ++ "\n"]+ Just val -> return $ LineContent [ContentRaw $ val ++ "\n"] True + doctypeRaw = do+ x <- try $ string "<!"+ y <- many $ noneOf "\r\n"+ eol+ return $ LineContent [ContentRaw $ concat [x, y, "\n"]] True+ invalidDollar = do _ <- char '$' fail "Received a command I did not understand. If you wanted a literal $, start the line with a backslash."@@ -120,13 +150,13 @@ _ <- try $ string "$#" _ <- many $ noneOf "\r\n" eol- return $ LineContent []+ return $ LineContent [] True htmlComment = do _ <- try $ string "<!--" _ <- manyTill anyChar $ try $ string "-->" x <- many nonComments eol- return $ LineContent [ContentRaw $ concat x] -- FIXME handle variables?+ return $ LineContent [ContentRaw $ concat x] False {- FIXME -} -- FIXME handle variables? nonComments = (many1 $ noneOf "\r\n<") <|> (do _ <- char '<' (do@@ -135,8 +165,8 @@ return "") <|> return "<") backslash = do _ <- char '\\'- (eol >> return (LineContent [ContentRaw "\n"]))- <|> (LineContent <$> content InContent)+ (eol >> return (LineContent [ContentRaw "\n"] True))+ <|> (uncurry LineContent <$> content InContent) controlIf = do _ <- try $ string "$if" spaces@@ -197,41 +227,42 @@ NotInQuotes -> return () NotInQuotesAttr -> return () InContent -> eol- return $ cc x+ return (cc $ map fst x, or $ map snd x) where cc [] = [] cc (ContentRaw a:ContentRaw b:c) = cc $ ContentRaw (a ++ b) : c cc (a:b) = a : cc b content' cr = contentHash <|> contentAt <|> contentCaret <|> contentUnder- <|> contentReg cr+ <|> contentReg' cr contentHash = do x <- parseHash case x of- Left str -> return $ ContentRaw str- Right deref -> return $ ContentVar deref+ Left str -> return (ContentRaw str, null str)+ Right deref -> return (ContentVar deref, False) contentAt = do x <- parseAt return $ case x of- Left str -> ContentRaw str- Right (s, y) -> ContentUrl y s+ Left str -> (ContentRaw str, null str)+ Right (s, y) -> (ContentUrl y s, False) contentCaret = do x <- parseCaret case x of- Left str -> return $ ContentRaw str- Right deref -> return $ ContentEmbed deref+ Left str -> return (ContentRaw str, null str)+ Right deref -> return (ContentEmbed deref, False) contentUnder = do x <- parseUnder case x of- Left str -> return $ ContentRaw str- Right deref -> return $ ContentMsg deref+ Left str -> return (ContentRaw str, null str)+ Right deref -> return (ContentMsg deref, False)+ contentReg' x = (flip (,) False) <$> contentReg x 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" tagAttribValue notInQuotes = do cr <- (char '"' >> return InQuotes) <|> return notInQuotes- content cr+ fst <$> content cr tagIdent = char '#' >> TagIdent <$> tagAttribValue NotInQuotes tagCond = do d <- between (char ':') (char ':') parseDeref@@ -277,11 +308,11 @@ (tagIdent <|> tagCond <|> tagClass Nothing <|> tagAttrs <|> tagAttrib Nothing)) _ <- many $ oneOf " \t\r\n" _ <- char '>'- c <- content InContent+ (c, avoidNewLines) <- content InContent let (tn, attr, classes, attrsd) = tag' $ TagName name : xs if '/' `elem` tn then fail "A tag name may not contain a slash. Perhaps you have a closing tag in your HTML."- else return $ LineTag tn attr c classes attrsd+ else return $ LineTag tn attr c classes attrsd avoidNewLines data TagPiece = TagName String | TagIdent [Content]@@ -341,7 +372,7 @@ cases <- mapM getOf inside rest' <- nestToDoc set rest Ok $ DocCase d cases : rest'-nestToDoc set (Nest (LineTag tn attrs content classes attrsD) inside:rest) = do+nestToDoc set (Nest (LineTag tn attrs content classes attrsD avoidNewLine) inside:rest) = do let attrFix (x, y, z) = (x, y, [(Nothing, z)]) let takeClass (a, "class", b) = Just (a, fromMaybe [] b) takeClass _ = Nothing@@ -367,24 +398,28 @@ start = DocContent $ ContentRaw $ "<" ++ tn attrs'' = concatMap attrToContent attrs' newline' = DocContent $ ContentRaw- $ if hamletNewlines set then "\n" else ""+ $ case hamletNewlines set of { AlwaysNewlines | not avoidNewLine -> "\n"; _ -> "" } inside' <- nestToDoc set inside rest' <- nestToDoc set rest Ok $ start : attrs'' ++ map (DocContent . ContentAttrs) attrsD ++ seal- : newline' : map DocContent content ++ inside' ++ end : newline' : rest'-nestToDoc set (Nest (LineContent content) inside:rest) = do+nestToDoc set (Nest (LineContent content avoidNewLine) inside:rest) = do inside' <- nestToDoc set inside rest' <- nestToDoc set rest let newline' = DocContent $ ContentRaw- $ if hamletNewlines set then "\n" else ""+ $ case hamletNewlines set of { NoNewlines -> ""; _ -> if nextIsContent && not avoidNewLine then "\n" else "" }+ nextIsContent =+ case (inside, rest) of+ ([], Nest LineContent{} _:_) -> True+ ([], Nest LineTag{} _:_) -> True+ _ -> False Ok $ map DocContent content ++ newline':inside' ++ rest' nestToDoc _set (Nest (LineElseIf _) _:_) = Error "Unexpected elseif" nestToDoc _set (Nest LineElse _:_) = Error "Unexpected else"@@ -414,14 +449,14 @@ ) = compressDoc $ (DocContent $ ContentRaw $ x ++ y) : rest compressDoc (DocContent x:rest) = DocContent x : compressDoc rest -parseDoc :: HamletSettings -> String -> Result [Doc]+parseDoc :: HamletSettings -> String -> Result (Maybe NewlineStyle, [Doc]) parseDoc set s = do- ls <- parseLines set s- let notEmpty (_, LineContent []) = False+ (mnl, set', ls) <- parseLines set s+ let notEmpty (_, LineContent [] _) = False notEmpty _ = True let ns = nestLines $ filter notEmpty ls- ds <- nestToDoc set ns- return $ compressDoc ds+ ds <- nestToDoc set' ns+ return (mnl, compressDoc ds) attrToContent :: (Maybe Deref, String, [(Maybe Deref, Maybe [Content])]) -> [Doc] attrToContent (Just cond, k, v) =@@ -459,12 +494,20 @@ hamletDoctype :: String -- | Should we add newlines to the output, making it more human-readable? -- Useful for client-side debugging but may alter browser page layout.- , hamletNewlines :: Bool+ , hamletNewlines :: NewlineStyle -- | How a tag should be closed. Use this to switch between HTML, XHTML -- or even XML output. , hamletCloseStyle :: String -> CloseStyle+ -- | Mapping from short names in \"$doctype\" statements to full doctype.+ , hamletDoctypeNames :: [(String, String)] } +data NewlineStyle = NoNewlines -- ^ never add newlines+ | NewlinesText -- ^ add newlines between consecutive text lines+ | AlwaysNewlines -- ^ add newlines everywhere+ | DefaultNewlineStyle+ deriving Show+ htmlEmptyTags :: Set String htmlEmptyTags = Set.fromAscList [ "area"@@ -484,18 +527,15 @@ -- | Defaults settings: HTML5 doctype and HTML-style empty tags. defaultHamletSettings :: HamletSettings-defaultHamletSettings = HamletSettings "<!DOCTYPE html>" False htmlCloseStyle+defaultHamletSettings = HamletSettings "<!DOCTYPE html>" DefaultNewlineStyle htmlCloseStyle doctypeNames xhtmlHamletSettings :: HamletSettings xhtmlHamletSettings =- HamletSettings doctype False xhtmlCloseStyle+ HamletSettings doctype DefaultNewlineStyle xhtmlCloseStyle doctypeNames where doctype = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" " ++ "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"--debugHamletSettings :: HamletSettings-debugHamletSettings = HamletSettings "<!DOCTYPE html>" True htmlCloseStyle htmlCloseStyle :: String -> CloseStyle htmlCloseStyle s =
Text/Hamlet/RT.hs view
@@ -64,7 +64,7 @@ parseHamletRT set s = case parseDoc set s of Error s' -> failure $ HamletParseException s'- Ok x -> liftM HamletRT $ mapM convert x+ Ok (_, x) -> liftM HamletRT $ mapM convert x where convert x@(DocForall deref (BindVar (Ident ident)) docs) = do deref' <- flattenDeref' x deref
hamlet.cabal view
@@ -1,5 +1,5 @@ name: hamlet-version: 1.0.1.4+version: 1.1.0 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -39,13 +39,9 @@ test/tmp.hs test.hs -flag blaze_html_0_5- description: Use blaze-html 0.5 and blaze-markup 0.5- default: True- library build-depends: base >= 4 && < 5- , shakespeare >= 1.0 && < 1.1+ , shakespeare >= 1.0.1 && < 1.1 , bytestring >= 0.9 , template-haskell , parsec >= 2 && < 4@@ -54,14 +50,8 @@ , containers >= 0.2 , blaze-builder >= 0.2 && < 0.4 , process >= 1.0 && < 1.2-- if flag(blaze_html_0_5)- build-depends:- blaze-html >= 0.5 && < 0.6+ , blaze-html >= 0.5 && < 0.6 , blaze-markup >= 0.5.1 && < 0.6- else- build-depends:- blaze-html >= 0.4 && < 0.5 exposed-modules: Text.Hamlet Text.Hamlet.RT@@ -82,7 +72,7 @@ , containers >= 0.2 && < 0.5 , text >= 0.7 && < 1 , HUnit- , hspec >= 1.0 && < 1.2+ , hspec >= 1.2 && < 1.3 , blaze-html >= 0.5 && < 0.6 , blaze-markup >= 0.5.1 && < 0.6
test.hs view
@@ -1,5 +1,5 @@ import HamletTest (specs)-import Test.Hspec+import Test.Hspec.Core main :: IO ()-main = hspecX [specs]+main = hspec [specs]
test/HamletTest.hs view
@@ -3,7 +3,7 @@ module HamletTest (specs) where import Test.HUnit hiding (Test) -import Test.Hspec +import Test.Hspec.Core import Test.Hspec.HUnit import Prelude hiding (reverse) @@ -14,11 +14,12 @@ import qualified Data.List as L import qualified Data.Map as Map import Data.Text (Text, pack, unpack) -import Data.Monoid (mappend) +import Data.Monoid (mappend,mconcat) import qualified Data.Set as Set import qualified Text.Blaze.Html.Renderer.Text import Text.Blaze.Html (toHtml) import Text.Blaze.Internal (preEscapedString) +import Text.Blaze specs = describe "hamlet" [ it "empty" caseEmpty @@ -72,6 +73,7 @@ , it "parens" caseParens , it "hamlet literals" caseHamletLiterals , it "hamlet' and xhamlet'" caseHamlet' + , it "hamlet tuple" caseTuple @@ -83,7 +85,7 @@ , it "ignores a blank line" $ do - helper "<p>foo</p>" [hamlet| + helper "<p>foo</p>\n" [hamlet| <p> foo @@ -94,9 +96,10 @@ - , it "hamlet angle bracket syntax" $ + , it "angle bracket syntax" $ helper "<p class=\"foo\" height=\"100\"><span id=\"bar\" width=\"50\">HELLO</span></p>" [hamlet| +$newline never <p.foo height="100"> <span #bar width=50>HELLO |] @@ -106,7 +109,9 @@ , it "hamlet module names" $ let foo = "foo" in helper "oof oof 3.14 -5" - [hamlet|#{Data.List.reverse foo} # + [hamlet| +$newline never +#{Data.List.reverse foo} # #{L.reverse foo} # #{show 3.14} #{show -5}|] @@ -157,6 +162,7 @@ , it "HTML comments" $ do helper "<p>1</p><p>2 not ignored</p>" [hamlet| +$newline never <p>1 <!-- ignored comment --> <p> @@ -192,13 +198,13 @@ , it "conditional class" $ do - helper "<p class=\"current\"></p>" + helper "<p class=\"current\"></p>\n" [hamlet|<p :False:.ignored :True:.current>|] - helper "<p class=\"1 3 2 4\"></p>" + helper "<p class=\"1 3 2 4\"></p>\n" [hamlet|<p :True:.1 :True:class=2 :False:.a :False:class=b .3 class=4>|] - helper "<p class=\"foo bar baz\"></p>" + helper "<p class=\"foo bar baz\"></p>\n" [hamlet|<p class=foo class=bar class=baz>|] @@ -214,31 +220,32 @@ , it "non-poly HTML" $ do - helperHtml "<h1>HELLO WORLD</h1>" [shamlet| + helperHtml "<h1>HELLO WORLD</h1>\n" [shamlet| <h1>HELLO WORLD |] - helperHtml "<h1>HELLO WORLD</h1>" $(shamletFile "test/hamlets/nonpolyhtml.hamlet") + helperHtml "<h1>HELLO WORLD</h1>\n" $(shamletFile "test/hamlets/nonpolyhtml.hamlet") , it "non-poly Hamlet" $ do let embed = [hamlet|<p>EMBEDDED|] - helper "<h1>url</h1><p>EMBEDDED</p>" [hamlet| + helper "<h1>url</h1>\n<p>EMBEDDED</p>\n" [hamlet| <h1>@{Home} ^{embed} |] - helper "<h1>url</h1>" $(hamletFile "test/hamlets/nonpolyhamlet.hamlet") + helper "<h1>url</h1>\n" $(hamletFile "test/hamlets/nonpolyhamlet.hamlet") , it "non-poly IHamlet" $ do let embed = [ihamlet|<p>EMBEDDED|] - ihelper "<h1>Adios</h1><p>EMBEDDED</p>" [ihamlet| + ihelper "<h1>Adios</h1>\n<p>EMBEDDED</p>\n" [ihamlet| <h1>_{Goodbye} ^{embed} |] - ihelper "<h1>Hola</h1>" $(ihamletFile "test/hamlets/nonpolyihamlet.hamlet") + ihelper "<h1>Hola</h1>\n" $(ihamletFile "test/hamlets/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| +$newline never <dl> $forall (name, age) <- people <dt>#{name} @@ -247,6 +254,7 @@ , it "pattern-match tuples: maybe" $ do let people = Just ("Michael", 26) helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet| +$newline never <dl> $maybe (name, age) <- people <dt>#{name} @@ -255,6 +263,7 @@ , it "pattern-match tuples: with" $ do let people = ("Michael", 26) helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet| +$newline never <dl> $with (name, age) <- people <dt>#{name} @@ -262,17 +271,17 @@ |] , it "list syntax for interpolation" $ do helper "<ul><li>1</li><li>2</li><li>3</li></ul>" [hamlet| +$newline never <ul> $forall num <- [1, 2, 3] <li>#{show num} |] -{- , it "infix operators" $ helper "5" [hamlet|#{show $ (4 + 5) - (2 + 2)}|] , it "infix operators with parens" $ - helper "5" [hamlet|#{show (2 + 3)}|] - -} + helper "5" [hamlet|#{show ((+) 1 1 + 3)}|] , it "doctypes" $ helper "<!DOCTYPE html>\n<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n" [hamlet| +$newline never $doctype 5 $doctype strict |] @@ -281,6 +290,7 @@ let nothing = Nothing justTrue = Just True in helper "<br><br><br><br>" [hamlet| +$newline never $case nothing $of Just val $of Nothing @@ -304,7 +314,8 @@ , it "case on Url" $ let url1 = Home url2 = Sub SubUrl - in helper "<br><br>" [hamlet| + in helper "<br>\n<br>\n" [hamlet| +$newline always $case url1 $of Home <br> @@ -320,6 +331,7 @@ , it "pattern-match constructors: forall" $ do let people = [Pair "Michael" 26, Pair "Miriam" 25] helper "<dl><dt>Michael</dt><dd>26</dd><dt>Miriam</dt><dd>25</dd></dl>" [hamlet| +$newline text <dl> $forall Pair name age <- people <dt>#{name} @@ -328,6 +340,7 @@ , it "pattern-match constructors: maybe" $ do let people = Just $ Pair "Michael" 26 helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet| +$newline text <dl> $maybe Pair name age <- people <dt>#{name} @@ -336,6 +349,7 @@ , it "pattern-match constructors: with" $ do let people = Pair "Michael" 26 helper "<dl><dt>Michael</dt><dd>26</dd></dl>" [hamlet| +$newline text <dl> $with Pair name age <- people <dt>#{name} @@ -343,21 +357,56 @@ |] , it "multiline tags" $ helper - "<foo bar=\"baz\" bin=\"bin\">content</foo>" [hamlet| + "<foo bar=\"baz\" bin=\"bin\">content</foo>\n" [hamlet| <foo bar=baz bin=bin>content |] , let attrs = [("bar", "baz"), ("bin", "<>\"&")] in it "*{...} attributes" $ helper - "<foo bar=\"baz\" bin=\"<>"&\">content</foo>" [hamlet| + "<foo bar=\"baz\" bin=\"<>"&\">content</foo>\n" [hamlet| <foo *{attrs}>content |] , it "blank attr values" $ helper - "<foo bar=\"\" baz bin=\"\"></foo>" + "<foo bar=\"\" baz bin=\"\"></foo>\n" [hamlet|<foo bar="" baz bin=>|] , it "greater than in attr" $ helper - "<button data-bind=\"enable: someFunction() > 5\">hello</button>" + "<button data-bind=\"enable: someFunction() > 5\">hello</button>\n" [hamlet|<button data-bind="enable: someFunction() > 5">hello|] + , it "normal doctype" $ helper + "<!DOCTYPE html>\n" + [hamlet|<!DOCTYPE html>|] + , it "newline style" $ helper + "<p>foo</p>\n<pre>bar\nbaz\nbin</pre>\n" + [hamlet| +$newline always +<p>foo +<pre> + bar + baz + bin +|] + , it "avoid newlines" $ helper + "<p>foo</p><pre>barbazbin</pre>" + [hamlet| +$newline always +<p>foo# +<pre># + bar# + baz# + bin# +|] + , it "manual linebreaks" $ helper + "<p>foo</p><pre>bar\nbaz\nbin</pre>" + [hamlet| +$newline never +<p>foo +<pre> + bar + \ + baz + \ + bin +|] ] data Pair = Pair String Int @@ -445,10 +494,12 @@ caseTag :: Assertion caseTag = do helper "<p class=\"foo\"><div id=\"bar\">baz</div></p>" [hamlet| +$newline text <p .foo> <#bar>baz |] helper "<p class=\"foo.bar\"><div id=\"bar\">baz</div></p>" [hamlet| +$newline text <p class=foo.bar> <#bar>baz |] @@ -580,24 +631,24 @@ |] caseScriptNotEmpty :: Assertion -caseScriptNotEmpty = helper "<script></script>" [hamlet|<script>|] +caseScriptNotEmpty = helper "<script></script>\n" [hamlet|<script>|] caseMetaEmpty :: Assertion caseMetaEmpty = do - helper "<meta>" [hamlet|<meta>|] - helper "<meta/>" [xhamlet|<meta>|] + helper "<meta>\n" [hamlet|<meta>|] + helper "<meta/>\n" [xhamlet|<meta>|] caseInputEmpty :: Assertion caseInputEmpty = do - helper "<input>" [hamlet|<input>|] - helper "<input/>" [xhamlet|<input>|] + helper "<input>\n" [hamlet|<input>|] + helper "<input/>\n" [xhamlet|<input>|] caseMultiClass :: Assertion -caseMultiClass = helper "<div class=\"foo bar\"></div>" [hamlet|<.foo.bar>|] +caseMultiClass = helper "<div class=\"foo bar\"></div>\n" [hamlet|<.foo.bar>|] caseAttribOrder :: Assertion caseAttribOrder = - helper "<meta 1 2 3>" [hamlet|<meta 1 2 3>|] + helper "<meta 1 2 3>\n" [hamlet|<meta 1 2 3>|] caseNothing :: Assertion caseNothing = do @@ -644,6 +695,7 @@ caseEscape :: Assertion caseEscape = do helper "#this is raw\n " [hamlet| +$newline never \#this is raw \ \ @@ -659,16 +711,16 @@ 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>" + helper "<select></select>\n" [hamlet|<select :False:selected>|] + helper "<select selected></select>\n" [hamlet|<select :True:selected>|] + helper "<meta var=\"foo:bar\">\n" [hamlet|<meta var=foo:bar>|] + helper "<select selected></select>\n" [hamlet|<select :true theArg:selected>|] - 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>" + helper "<select></select>\n" [hamlet|<select :False:selected>|] + helper "<select selected></select>\n" [hamlet|<select :True:selected>|] + helper "<meta var=\"foo:bar\">\n" [hamlet|<meta var=foo:bar>|] + helper "<select selected></select>\n" [hamlet|<select :true theArg:selected>|] caseNonAscii :: Assertion @@ -684,7 +736,9 @@ caseTrailingDollarSign :: Assertion caseTrailingDollarSign = - helper "trailing space \ndollar sign #" [hamlet|trailing space # + helper "trailing space \ndollar sign #" [hamlet| +$newline never +trailing space # \ dollar sign #\ |] @@ -692,29 +746,31 @@ caseNonLeadingPercent :: Assertion caseNonLeadingPercent = helper "<span style=\"height:100%\">foo</span>" [hamlet| +$newline never <span style=height:100%>foo |] caseQuotedAttribs :: Assertion caseQuotedAttribs = helper "<input type=\"submit\" value=\"Submit response\">" [hamlet| +$newline never <input type=submit value="Submit response"> |] caseSpacedDerefs :: Assertion caseSpacedDerefs = do helper "<var>" [hamlet|#{var theArg}|] - helper "<div class=\"<var>\"></div>" [hamlet|<.#{var theArg}>|] + helper "<div class=\"<var>\"></div>\n" [hamlet|<.#{var theArg}>|] caseAttribVars :: Assertion caseAttribVars = do - helper "<div id=\"<var>\"></div>" [hamlet|<##{var theArg}>|] - helper "<div class=\"<var>\"></div>" [hamlet|<.#{var theArg}>|] - helper "<div f=\"<var>\"></div>" [hamlet|< f=#{var theArg}>|] + helper "<div id=\"<var>\"></div>\n" [hamlet|<##{var theArg}>|] + helper "<div class=\"<var>\"></div>\n" [hamlet|<.#{var theArg}>|] + helper "<div f=\"<var>\"></div>\n" [hamlet|< f=#{var theArg}>|] - helper "<div id=\"<var>\"></div>" [hamlet|<##{var theArg}>|] - helper "<div class=\"<var>\"></div>" [hamlet|<.#{var theArg}>|] - helper "<div f=\"<var>\"></div>" [hamlet|< f=#{var theArg}>|] + helper "<div id=\"<var>\"></div>\n" [hamlet|<##{var theArg}>|] + helper "<div class=\"<var>\"></div>\n" [hamlet|<.#{var theArg}>|] + helper "<div f=\"<var>\"></div>\n" [hamlet|< f=#{var theArg}>|] caseStringsAndHtml :: Assertion caseStringsAndHtml = do @@ -727,6 +783,7 @@ helper "<table><tbody><tr><td>1</td></tr><tr><td>2</td></tr></tbody></table>" [hamlet| +$newline never <table> <tbody> $forall user <- users @@ -741,6 +798,7 @@ , "</select>" ]) [hamlet| +$newline never <select #"#{name}" name=#{name}> <option :isBoolBlank val:selected> <option value=true :isBoolTrue val:selected>Yes @@ -766,8 +824,8 @@ caseExternal :: Assertion caseExternal = do - helper "foo<br>" $(hamletFile "test/hamlets/external.hamlet") - helper "foo<br/>" $(xhamletFile "test/hamlets/external.hamlet") + helper "foo\n<br>\n" $(hamletFile "test/hamlets/external.hamlet") + helper "foo\n<br/>\n" $(xhamletFile "test/hamlets/external.hamlet") where foo = "foo" @@ -798,14 +856,14 @@ caseHamlet' = do helper' "foo" [shamlet|foo|] helper' "foo" [xshamlet|foo|] - helper "<br>" $ const $ [shamlet|<br>|] - helper "<br/>" $ const $ [xshamlet|<br>|] + helper "<br>\n" $ const $ [shamlet|<br>|] + helper "<br/>\n" $ const $ [xshamlet|<br>|] -- new with generalized stuff helper' "foo" [shamlet|foo|] helper' "foo" [xshamlet|foo|] - helper "<br>" $ const $ [shamlet|<br>|] - helper "<br/>" $ const $ [xshamlet|<br>|] + helper "<br>\n" $ const $ [shamlet|<br>|] + helper "<br/>\n" $ const $ [xshamlet|<br>|] instance Show Url where @@ -832,6 +890,21 @@ +caseTuple :: Assertion +caseTuple = do + helper "(1,1)" [hamlet| #{("1","1")}|] + helper "foo" [hamlet| + $with (a,b) <- ("foo","bar") + #{a} + |] + helper "url" [hamlet| + $with (a,b) <- (Home,Home) + @{a} + |] + helper "url" [hamlet| + $with p <- (Home,[]) + @?{p} + |] data Msg = Hello | Goodbye @@ -842,3 +915,11 @@ where showMsg Hello = preEscapedString "Hola" showMsg Goodbye = preEscapedString "Adios" + +instance (ToMarkup a, ToMarkup b) => ToMarkup (a,b) where + toMarkup (a,b) = do + toMarkup "(" + toMarkup a + toMarkup "," + toMarkup b + toMarkup ")"