packages feed

hamlet 0.3.1.1 → 0.4.0

raw patch · 5 files changed

+579/−545 lines, 5 filesdep +parsecdep ~blaze-htmlPVP ok

version bump matches the API change (PVP)

Dependencies added: parsec

Dependency ranges changed: blaze-html

API changes (from Hackage documentation)

+ Text.Hamlet: hamletFile :: FilePath -> Q Exp
+ Text.Hamlet: hamletFileWithSettings :: HamletSettings -> FilePath -> Q Exp
+ Text.Hamlet: xhamletFile :: FilePath -> Q Exp

Files

Text/Hamlet.hs view
@@ -2,8 +2,12 @@     ( -- * Basic quasiquoters       hamlet     , xhamlet-      -- * Build customized quasiquoters+      -- * Load from external file+    , hamletFile+    , xhamletFile+      -- * Customized settings     , hamletWithSettings+    , hamletFileWithSettings     , HamletSettings (..)     , defaultHamletSettings       -- * Datatypes
Text/Hamlet/Parse.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Text.Hamlet.Parse     ( Result (..)@@ -9,23 +8,15 @@     , parseDoc     , HamletSettings (..)     , defaultHamletSettings-#if TEST-    , testSuite-#endif     )     where -import Control.Applicative+import Control.Applicative ((<$>), Applicative (..)) import Control.Monad import Control.Arrow import Data.Data import Data.List (intercalate)--#if TEST-import Test.Framework (testGroup, Test)-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)-#endif+import Text.ParserCombinators.Parsec hiding (Line)  data Result v = Error String | Ok v     deriving (Show, Eq, Read, Data, Typeable)@@ -67,227 +58,156 @@     deriving (Eq, Show, Read)  parseLines :: HamletSettings -> String -> Result [(Int, Line)]-parseLines set = mapM (go . killCarriage) . lines where-    go s = do-        let (spaces, s') = countSpaces 0 s-        l <- parseLine set $ killTrailingDollar s'-        Ok (spaces, l)-    countSpaces i (' ':rest) = countSpaces (i + 1) rest-    countSpaces i ('\t':rest) = countSpaces (i + 4) rest-    countSpaces i x = (i, x)-    killCarriage s-        | null s = s-        | last s == '\r' = init s-        | otherwise = s-    killTrailingDollar "" = ""-    killTrailingDollar x-        | last x == '$' && odd (length $ filter (== '$') x) = init x-        | otherwise = x--parseLine :: HamletSettings -> String -> Result Line-parseLine set "!!!" =-    Ok $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"]-parseLine _ "\\" = Ok $ LineContent [ContentRaw "\n"]-parseLine _ ('\\':s) = LineContent <$> parseContent s-parseLine _ ('$':'f':'o':'r':'a':'l':'l':' ':rest) =-    case words rest of-        [x, y] -> do-            x' <- parseDeref x-            y' <- parseIdent y-            return $ LineForall x' y'-        _ -> Error $ "Invalid forall: " ++ rest-parseLine _ ('$':'i':'f':' ':rest) = LineIf <$> parseDeref rest-parseLine _ ('$':'e':'l':'s':'e':'i':'f':' ':rest) =-    LineElseIf <$> parseDeref rest-parseLine _ "$else" = Ok LineElse-parseLine _ ('$':'m':'a':'y':'b':'e':' ':rest) =-    case words rest of-        [x, y] -> do-            x' <- parseDeref x-            y' <- parseIdent y-            return $ LineMaybe x' y'-        _ -> Error $ "Invalid maybe: " ++ rest-parseLine _ "$nothing" = Ok LineNothing-parseLine _ x@(c:_) | c `elem` "%#." = do-    let (begin, rest) = break (== ' ') x-        rest' = dropWhile (== ' ') rest-    (tn, attr, classes) <- parseTag begin-    con <- parseContent rest'-    return $ LineTag tn attr con classes-parseLine _ s = LineContent <$> parseContent s--#if TEST-fooBar :: Deref-fooBar = Deref [Ident "bar", Ident "foo"]--caseParseLine :: Assertion-caseParseLine = do-    let parseLine' = parseLine defaultHamletSettings-    parseLine' "$if foo.bar" @?= Ok (LineIf fooBar)-    parseLine' "$elseif foo.bar" @?= Ok (LineElseIf fooBar)-    parseLine' "$else" @?= Ok LineElse-    parseLine' "%img!src=@foo.bar@"-        @?= Ok (LineTag "img" [(Nothing, "src", [ContentUrl False fooBar])] [] [])-    parseLine' "%img!src=@?foo.bar@"-        @?= 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" [ (Nothing, "id", [ContentRaw "foo"])-                               , (Nothing, "baz", [ContentRaw "bin"])-                               ] []-                               [ [ContentRaw "bar"]-                               , [ContentRaw "bar2"]-                               ])-    parseLine' "\\#this is raw"-        @?= Ok (LineContent [ContentRaw "#this is raw"])-    parseLine' "\\"-        @?= Ok (LineContent [ContentRaw "\n"])-    parseLine' "%img!:baz:src=@foo.bar@"-        @?= Ok (LineTag "img"-                [(Just $ Deref [Ident "baz"],-                  "src",-                  [ContentUrl False fooBar])] [] [])-#endif--parseContent :: String -> Result [Content]-parseContent "" = Ok []-parseContent s =-    case break (flip elem "@$^") s of-        (_, "") -> Ok [ContentRaw s]-        (a, delim:a') -> do-            b <--                case break (== delim) a' of-                    ("", _:rest) -> do-                        rest' <- parseContent rest-                        return $ ContentRaw [delim] : rest'-                    (deref, _:rest) -> do-                        let (x, deref') = case delim of-                                    '$' -> (ContentVar, deref)-                                    '@' ->-                                        case deref of-                                            '?':y -> (ContentUrl True, y)-                                            _ -> (ContentUrl False, deref)-                                    '^' -> (ContentEmbed, deref)-                                    _ -> error $ "Invalid delim in parseContent: " ++ [delim]-                        deref'' <- parseDeref deref'-                        rest' <- parseContent rest-                        return $ x deref'' : rest'-                    (_, "") -> error $ "Missing ending delimiter in " ++ s-            case a of-                "" -> return b-                _ -> return $ ContentRaw a : b--#if TEST-caseParseContent :: Assertion-caseParseContent = do-    parseContent "" @?= Ok []-    parseContent "foo" @?= Ok [ContentRaw "foo"]-    parseContent "foo $bar$ baz" @?= Ok [ ContentRaw "foo "-                                        , ContentVar $ Deref [Ident "bar"]-                                        , ContentRaw " baz"-                                        ]-    parseContent "foo @bar@ baz" @?=-        Ok [ ContentRaw "foo "-           , ContentUrl False (Deref [Ident "bar"])-           , ContentRaw " baz"-           ]-    parseContent "foo @?bar@ baz" @?=-        Ok [ ContentRaw "foo "-           , ContentUrl True (Deref [Ident "bar"])-           , ContentRaw " baz"-           ]-    parseContent "foo ^bar^ baz" @?= Ok [ ContentRaw "foo "-                                        , ContentEmbed $ Deref [Ident "bar"]-                                        , ContentRaw " baz"-                                        ]-    parseContent "@@" @?= Ok [ContentRaw "@"]-    parseContent "^^" @?= Ok [ContentRaw "^"]-#endif--parseDeref :: String -> Result Deref-parseDeref "" = Error "Invalid empty deref"-parseDeref s = Deref . reverse <$> go s where-    go a = case break (== '.') a of-                (x, '.':y) -> do-                    x' <- parseIdent x-                    y' <- go y-                    return $ x' : y'-                (x, "") -> return <$> parseIdent x-                _ -> Error "Invalid branch in Text.Hamlet.Parse.parseDef"--#if TEST-caseParseDeref :: Assertion-caseParseDeref = do-    parseDeref "baz.bar.foo" @?=-        Ok (Deref [ Ident "foo"-                  , Ident "bar"-                  , Ident "baz"])-#endif--parseIdent :: String -> Result Ident-parseIdent "" = Error "Invalid empty ident"-parseIdent s-    | all (flip elem (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'")) s-        = Ok $ Ident s-    | otherwise = Error $ "Invalid identifier: " ++ s--#if TEST-caseParseIdent :: Assertion-caseParseIdent = parseIdent "foo" @?= Ok (Ident "foo")-#endif+parseLines set s =+    case parse (many $ parseLine set) s s of+        Left e -> Error $ show e+        Right x -> Ok x -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 [])+parseLine :: HamletSettings -> Parser (Int, Line)+parseLine set = do+    ss <- fmap sum $ many ((char ' ' >> return 1) <|>+                           (char '\t' >> return 4))+    x <- doctype <|>+         backslash <|>+         try controlIf <|>+         try controlElseIf <|>+         try (string "$else" >> eol >> return LineElse) <|>+         try controlMaybe <|>+         try (string "$nothing" >> eol >> return LineNothing) <|>+         try controlForall <|>+         tag <|>+         (do+            cs <- content InContent+            isEof <- (eof >> return True) <|> return False+            if null cs && ss == 0 && isEof+                then fail "End of Hamlet template"+                else return $ LineContent cs)+    return (ss, x)   where-    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-        con <- parseContent cl-        Ok (tn, attrs . (:) (Nothing, "id", con), classes)-    go (tn, attrs, classes) (cond, '!':rest) = do-        let (name, val) = break (== '=') rest-        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"+    eol' = (char '\n' >> return ()) <|> (string "\r\n" >> return ())+    eol = eof <|> eol'+    doctype = do+        string "!!!" >> eol+        return $ LineContent [ContentRaw $ hamletDoctype set ++ "\n"]+    backslash = do+        _ <- char '\\'+        (eol >> return (LineContent [ContentRaw "\n"]))+            <|> (LineContent <$> content InContent)+    controlIf = do+        _ <- string "$if"+        spaces+        x <- deref False+        eol+        return $ LineIf x+    controlElseIf = do+        _ <- string "$elseif"+        spaces+        x <- deref False+        eol+        return $ LineElseIf x+    controlMaybe = do+        _ <- string "$maybe"+        spaces+        x <- deref False+        spaces+        y <- ident+        eol+        return $ LineMaybe x y+    controlForall = do+        _ <- string "$forall"+        spaces+        x <- deref False+        spaces+        y <- ident+        eol+        return $ LineForall x y+    tag = do+        x <- tagName <|> tagIdent <|> tagClass+        xs <- many $ tagIdent <|> tagClass <|> tagAttrib+        c <- (eol >> return []) <|> (do+            _ <- many1 $ oneOf " \t"+            content InContent)+        let (tn, attr, classes) = tag' $ x : xs+        return $ LineTag tn attr c classes+    content cr = do+        x <- many $ content' cr+        case cr of+            InQuotes -> char '"' >> return ()+            NotInQuotes -> return ()+            InContent -> (char '$' >> eol) <|> eol+        return x+    content' cr = try contentDollar <|> contentAt <|> contentCarrot+                                <|> contentReg cr+    contentDollar = do+        _ <- char '$'+        (char '$' >> return (ContentRaw "$")) <|> (do+            s <- deref True+            _ <- char '$'+            return $ ContentVar s)+    contentAt = do+        _ <- char '@'+        (char '@' >> return (ContentRaw "@")) <|> (do+            x <- (char '?' >> return True) <|> return False+            s <- deref True+            _ <- char '@'+            return $ ContentUrl x s)+    contentCarrot = do+        _ <- char '^'+        (char '^' >> return (ContentRaw "^")) <|> (do+            s <- deref True+            _ <- char '^'+            return $ ContentEmbed s)+    contentReg InContent = ContentRaw <$> many1 (noneOf "$@^\r\n")+    contentReg NotInQuotes = ContentRaw <$> many1 (noneOf "$@^#.! \t\n\r")+    contentReg InQuotes =+        (do+            _ <- char '\\'+            ContentRaw . return <$> anyChar+        ) <|> (ContentRaw <$> many1 (noneOf "$@^\\\"\n\r"))+    tagName = do+        _ <- char '%'+        s <- many1 $ noneOf " \t.#!\r\n"+        return $ TagName s+    tagAttribValue = do+        cr <- (char '"' >> return InQuotes) <|> return NotInQuotes+        content cr+    tagIdent = char '#' >> TagIdent <$> tagAttribValue+    tagClass = char '.' >> TagClass <$> tagAttribValue+    tagAttrib = do+        _ <- char '!'+        cond <- (Just <$> tagAttribCond) <|> return Nothing+        s <- many1 $ noneOf " \t.!=\r\n"+        v <- (do+            _ <- char '='+            s' <- tagAttribValue+            return s') <|> return []+        return $ TagAttrib (cond, s, v)+    tagAttribCond = do+        _ <- char ':'+        d <- deref True+        _ <- char ':'+        return d+    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)+    deref spaceAllowed = do+        let delim = if spaceAllowed+                        then (char '.' <|> (many1 (char ' ') >> return ' '))+                        else char '.'+        x <- ident+        xs <- many $ delim >> ident+        return $ Deref $ x : xs+    ident = Ident <$> many1 (alphaNum <|> char '_' <|> char '\'') -takePieces :: String -> Result [(Maybe String, String)]-takePieces "" = Ok []-takePieces (a:s) = do-    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 $ (cond, x) : y'-  where-    takePiece front False False False "" = Ok (front "", "")-    takePiece _ _ _ _ "" = Error $ "Unterminated URL, var or embed: " ++ s-    takePiece front False False False (c:rest)-        | c `elem` "#.%!" = Ok (front "", c:rest)-    takePiece front x y z (c:rest)-        | c == '$' = takePiece (front . (:) c) (not x) y z rest-        | c == '@' = takePiece (front . (:) c) x (not y) z rest-        | c == '^' = takePiece (front . (:) c) x y (not z) rest-        | otherwise = takePiece (front . (:) c) x y z rest+data TagPiece = TagName String+              | TagIdent [Content]+              | TagClass [Content]+              | TagAttrib (Maybe Deref, String, [Content]) +data ContentRule = InQuotes | NotInQuotes | InContent+ data Nest = Nest Line [Nest]  nestLines :: [(Int, Line)] -> [Nest]@@ -436,14 +356,3 @@     inside' <- nestToDoc set inside     parseConds set (front . (:) (d, inside')) rest parseConds _ front rest = Ok (front [], Nothing, rest)--#if TEST----- Testing-testSuite :: Test-testSuite = testGroup "Text.Hamlet.Parse"-    [ testCase "parseLine" caseParseLine-    , testCase "parseContent" caseParseContent-    , testCase "parseDeref" caseParseDeref-    , testCase "parseIdent" caseParseIdent-    ]-#endif
Text/Hamlet/Quasi.hs view
@@ -1,8 +1,13 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} module Text.Hamlet.Quasi     ( hamlet     , xhamlet     , hamletWithSettings+    , hamletFile+    , xhamletFile+    , hamletFileWithSettings     ) where  import Text.Hamlet.Parse@@ -15,6 +20,13 @@ import Text.Blaze (unsafeByteString, Html, string) import Data.List (intercalate) +class ToHtml a where+    toHtml :: a -> Html ()+instance ToHtml String where+    toHtml = string+instance ToHtml (Html a) where+    toHtml x = x >> return ()+ type Scope = [(Ident, Exp)]  docsToExp :: Exp -> Scope -> [Doc] -> Q Exp@@ -78,7 +90,9 @@     os <- [|unsafeByteString . S8.pack|]     let s' = LitE $ StringL $ S8.unpack $ BSU.fromString s     return $ os `AppE` s'-contentToExp _ scope (ContentVar d) = return $ deref scope d+contentToExp _ scope (ContentVar d) = do+    str <- [|toHtml|]+    return $ str `AppE` deref scope d contentToExp render scope (ContentUrl hasParams d) = do     ou <- if hasParams then [|outputUrlParams|] else [|outputUrl|]     let d' = deref scope d@@ -105,24 +119,46 @@ -- Please see accompanying documentation for a description of Hamlet syntax. hamletWithSettings :: HamletSettings -> QuasiQuoter hamletWithSettings set =-    QuasiQuoter go $ error "Cannot quasi-quote Hamlet to patterns"+    QuasiQuoter (hamletFromString set)+      $ error "Cannot quasi-quote Hamlet to patterns"++hamletFromString :: HamletSettings -> String -> Q Exp+hamletFromString set s = do+  case parseDoc set s of+    Error s' -> error s'+    Ok d -> do+        render <- newName "_render"+        func <- docsToExp (VarE render) [] d+        return $ LamE [VarP render] func++hamletFileWithSettings :: HamletSettings -> FilePath -> Q Exp+hamletFileWithSettings set fp = do+    contents <- fmap BSU.toString $ qRunIO $ S8.readFile fp+    hamletFromString set contents++-- | Calls 'hamletFileWithSettings' with 'defaultHamletSettings'.+hamletFile :: FilePath -> Q Exp+hamletFile = hamletFileWithSettings defaultHamletSettings++-- | Calls 'hamletFileWithSettings' using XHTML 1.0 Strict settings.+xhamletFile :: FilePath -> Q Exp+xhamletFile =+    hamletFileWithSettings $ HamletSettings doctype True   where-    go s = do-      case parseDoc set s of-        Error s' -> error s'-        Ok d -> do-            render <- newName "_render"-            func <- docsToExp (VarE render) [] d-            return $ LamE [VarP render] func+    doctype =+      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" " +++      "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"  deref :: Scope -> Deref -> Exp deref _ (Deref []) = error "Invalid empty deref"-deref scope (Deref (z@(Ident zName):y)) =+deref scope (Deref d) =     let z' = case lookup z scope of                 Nothing -> varName zName                 Just zExp -> zExp-     in foldr go z' $ reverse y+     in foldr go z' y   where+    z@(Ident zName) = last d+    y = init d     varName "" = error "Illegal empty varName"     varName v@(s:_) =         case lookup (Ident v) scope of
hamlet.cabal view
@@ -1,5 +1,5 @@ name:            hamlet-version:         0.3.1.1+version:         0.4.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -43,7 +43,8 @@                      bytestring >= 0.9 && < 0.10,                      utf8-string >= 0.3.4 && < 0.4,                      template-haskell,-                     blaze-html >= 0.1 && < 0.2+                     blaze-html >= 0.1.1 && < 0.2,+                     parsec >= 2 && < 4     exposed-modules: Text.Hamlet     other-modules:   Text.Hamlet.Parse                      Text.Hamlet.Quasi
runtests.hs view
@@ -1,292 +1,376 @@-{-# LANGUAGE QuasiQuotes #-}-import Test.Framework (defaultMain, testGroup, Test)-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)--import qualified Text.Hamlet.Parse-import Text.Hamlet-import Data.ByteString.UTF8 (fromString)-import Data.ByteString.Lazy.UTF8 (toString)--main :: IO ()-main = defaultMain-    [ Text.Hamlet.Parse.testSuite-    , testSuite-    ]--testSuite :: Test-testSuite = testGroup "Text.Hamlet"-    [ testCase "empty" caseEmpty-    , testCase "static" caseStatic-    , testCase "tag" caseTag-    , testCase "var" caseVar-    , testCase "var chain " caseVarChain-    , testCase "url" caseUrl-    , testCase "url chain " caseUrlChain-    , testCase "embed" caseEmbed-    , testCase "embed chain " caseEmbedChain-    , testCase "if" caseIf-    , testCase "if chain " caseIfChain-    , testCase "else" caseElse-    , testCase "else chain " caseElseChain-    , testCase "elseif" caseElseIf-    , testCase "elseif chain " caseElseIfChain-    , testCase "list" caseList-    , testCase "list chain" caseListChain-    , testCase "script not empty" caseScriptNotEmpty-    , testCase "meta empty" caseMetaEmpty-    , testCase "input empty" caseInputEmpty-    , testCase "multiple classes" caseMultiClass-    , testCase "attrib order" caseAttribOrder-    , testCase "nothing" caseNothing-    , testCase "nothing chain " caseNothingChain-    , testCase "just" caseJust-    , testCase "just chain " caseJustChain-    , testCase "constructor" caseConstructor-    , testCase "url + params" caseUrlParams-    , testCase "escape" caseEscape-    , testCase "empty statement list" caseEmptyStatementList-    , testCase "attribute conditionals" caseAttribCond-    , testCase "non-ascii" caseNonAscii-    , testCase "maybe function" caseMaybeFunction-    , testCase "trailing dollar sign" caseTrailingDollarSign-    ]--data Url = Home | Sub SubUrl-data SubUrl = SubUrl-render :: Url -> String-render Home = "url"-render (Sub SubUrl) = "suburl"--data Arg url = Arg-    { getArg :: Arg url-    , var :: Html ()-    , url :: Url-    , embed :: Hamlet url-    , true :: Bool-    , false :: Bool-    , list :: [Arg url]-    , nothing :: Maybe (Html ())-    , just :: Maybe (Html ())-    , urlParams :: (Url, [(String, String)])-    }--theArg :: Arg url-theArg = Arg-    { getArg = theArg-    , var = string "<var>"-    , url = Home-    , embed = [$hamlet|embed|]-    , true = True-    , false = False-    , list = [theArg, theArg, theArg]-    , nothing = Nothing-    , just = Just $ string "just"-    , urlParams = (Home, [("foo", "bar"), ("foo1", "bar1")])-    }--helper :: String -> Hamlet Url -> Assertion-helper res h = do-    let x = renderHamlet render h-    res @=? toString x--caseEmpty :: Assertion-caseEmpty = helper "" [$hamlet||]--caseStatic :: Assertion-caseStatic = helper "some static content" [$hamlet|some static content|]--caseTag :: Assertion-caseTag = helper "<p class=\"foo\"><div id=\"bar\">baz</div></p>" [$hamlet|-%p.foo- #bar baz|]--caseVar :: Assertion-caseVar = do-    helper "&lt;var&gt;" [$hamlet|$var.theArg$|]--caseVarChain :: Assertion-caseVarChain = do-    helper "&lt;var&gt;" [$hamlet|$var.getArg.getArg.getArg.theArg$|]--caseUrl :: Assertion-caseUrl = do-    helper (render Home) [$hamlet|@url.theArg@|]--caseUrlChain :: Assertion-caseUrlChain = do-    helper (render Home) [$hamlet|@url.getArg.getArg.getArg.theArg@|]--caseEmbed :: Assertion-caseEmbed = do-    helper "embed" [$hamlet|^embed.theArg^|]--caseEmbedChain :: Assertion-caseEmbedChain = do-    helper "embed" [$hamlet|^embed.getArg.getArg.getArg.theArg^|]--caseIf :: Assertion-caseIf = do-    helper "if" [$hamlet|-$if true.theArg-    if-|]--caseIfChain :: Assertion-caseIfChain = do-    helper "if" [$hamlet|-$if true.getArg.getArg.getArg.theArg-    if-|]--caseElse :: Assertion-caseElse = helper "else" [$hamlet|-$if false.theArg-    if-$else-    else-|]--caseElseChain :: Assertion-caseElseChain = helper "else" [$hamlet|-$if false.getArg.getArg.getArg.theArg-    if-$else-    else-|]--caseElseIf :: Assertion-caseElseIf = helper "elseif" [$hamlet|-$if false.theArg-    if-$elseif true.theArg-    elseif-$else-    else-|]--caseElseIfChain :: Assertion-caseElseIfChain = helper "elseif" [$hamlet|-$if false.getArg.getArg.getArg.theArg-    if-$elseif true.getArg.getArg.getArg.theArg-    elseif-$else-    else-|]--caseList :: Assertion-caseList = do-    helper "xxx" [$hamlet|-$forall list.theArg x-    x-|]--caseListChain :: Assertion-caseListChain = do-    helper "urlurlurl" [$hamlet|-$forall list.getArg.getArg.getArg.getArg.getArg.theArg x-    @url.x@-|]--caseScriptNotEmpty :: Assertion-caseScriptNotEmpty = helper "<script></script>" [$hamlet|%script|]--caseMetaEmpty :: Assertion-caseMetaEmpty = do-    helper "<meta>" [$hamlet|%meta|]-    helper "<meta/>" [$xhamlet|%meta|]--caseInputEmpty :: Assertion-caseInputEmpty = do-    helper "<input>" [$hamlet|%input|]-    helper "<input/>" [$xhamlet|%input|]--caseMultiClass :: Assertion-caseMultiClass = do-    helper "<div class=\"foo bar\"></div>" [$hamlet|.foo.bar|]--caseAttribOrder :: Assertion-caseAttribOrder = helper "<meta 1 2 3>" [$hamlet|%meta!1!2!3|]--caseNothing :: Assertion-caseNothing = do-    helper "" [$hamlet|-$maybe nothing.theArg n-    nothing-|]-    helper "nothing" [$hamlet|-$maybe nothing.theArg n-    something-$nothing-    nothing-|]--caseNothingChain :: Assertion-caseNothingChain = helper "" [$hamlet|-$maybe nothing.getArg.getArg.getArg.theArg n-    nothing $n$-|]--caseJust :: Assertion-caseJust = helper "it's just" [$hamlet|-$maybe just.theArg n-    it's $n$-|]--caseJustChain :: Assertion-caseJustChain = helper "it's just" [$hamlet|-$maybe just.getArg.getArg.getArg.theArg n-    it's $n$-|]--caseConstructor :: Assertion-caseConstructor = do-    helper "url" [$hamlet|@Home@|]-    helper "suburl" [$hamlet|@Sub.SubUrl@|]-    let text = "<raw text>"-    helper "<raw text>" [$hamlet|$preEscapedString.text$|]--caseUrlParams :: Assertion-caseUrlParams = do-    helper "url?foo=bar&amp;foo1=bar1" [$hamlet|@?urlParams.theArg@|]--caseEscape :: Assertion-caseEscape = do-    helper "#this is raw\n " [$hamlet|-\#this is raw-\-\ -|]--caseEmptyStatementList :: Assertion-caseEmptyStatementList = do-    helper "" [$hamlet|$if True|]-    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|]--caseNonAscii :: Assertion-caseNonAscii = do-    helper "עִבְרִי" [$hamlet|עִבְרִי|]--caseMaybeFunction :: Assertion-caseMaybeFunction = do-    helper "url?foo=bar&amp;foo1=bar1" [$hamlet|-$maybe Just.urlParams x-    @?x.theArg@-|]--caseTrailingDollarSign :: Assertion-caseTrailingDollarSign =-    helper "trailing space \ndollar sign $" [$hamlet|trailing space $-\-dollar sign $$|]+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+import Test.Framework (defaultMain, testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Test.HUnit hiding (Test)
+
+import Text.Hamlet
+import Data.ByteString.Lazy.UTF8 (toString)
+
+main :: IO ()
+main = defaultMain [testSuite]
+
+testSuite :: Test
+testSuite = testGroup "Text.Hamlet"
+    [ testCase "empty" caseEmpty
+    , testCase "static" caseStatic
+    , testCase "tag" caseTag
+    , testCase "var" caseVar
+    , testCase "var chain " caseVarChain
+    , testCase "url" caseUrl
+    , testCase "url chain " caseUrlChain
+    , testCase "embed" caseEmbed
+    , testCase "embed chain " caseEmbedChain
+    , testCase "if" caseIf
+    , testCase "if chain " caseIfChain
+    , testCase "else" caseElse
+    , testCase "else chain " caseElseChain
+    , testCase "elseif" caseElseIf
+    , testCase "elseif chain " caseElseIfChain
+    , testCase "list" caseList
+    , testCase "list chain" caseListChain
+    , testCase "script not empty" caseScriptNotEmpty
+    , testCase "meta empty" caseMetaEmpty
+    , testCase "input empty" caseInputEmpty
+    , testCase "multiple classes" caseMultiClass
+    , testCase "attrib order" caseAttribOrder
+    , testCase "nothing" caseNothing
+    , testCase "nothing chain " caseNothingChain
+    , testCase "just" caseJust
+    , testCase "just chain " caseJustChain
+    , testCase "constructor" caseConstructor
+    , testCase "url + params" caseUrlParams
+    , testCase "escape" caseEscape
+    , testCase "empty statement list" caseEmptyStatementList
+    , testCase "attribute conditionals" caseAttribCond
+    , testCase "non-ascii" caseNonAscii
+    , testCase "maybe function" caseMaybeFunction
+    , testCase "trailing dollar sign" caseTrailingDollarSign
+    , testCase "non leading percent sign" caseNonLeadingPercent
+    , testCase "quoted attributes" caseQuotedAttribs
+    , testCase "spaced derefs" caseSpacedDerefs
+    , testCase "attrib vars" caseAttribVars
+    , testCase "strings and html" caseStringsAndHtml
+    , testCase "nesting" caseNesting
+    , testCase "trailing space" caseTrailingSpace
+    , testCase "currency symbols" caseCurrency
+    , testCase "external" caseExternal
+    ]
+
+data Url = Home | Sub SubUrl
+data SubUrl = SubUrl
+render :: Url -> String
+render Home = "url"
+render (Sub SubUrl) = "suburl"
+
+data Arg url = Arg
+    { getArg :: Arg url
+    , var :: Html ()
+    , url :: Url
+    , embed :: Hamlet url
+    , true :: Bool
+    , false :: Bool
+    , list :: [Arg url]
+    , nothing :: Maybe String
+    , just :: Maybe String
+    , urlParams :: (Url, [(String, String)])
+    }
+
+theArg :: Arg url
+theArg = Arg
+    { getArg = theArg
+    , var = string "<var>"
+    , url = Home
+    , embed = [$hamlet|embed|]
+    , true = True
+    , false = False
+    , list = [theArg, theArg, theArg]
+    , nothing = Nothing
+    , just = Just "just"
+    , urlParams = (Home, [("foo", "bar"), ("foo1", "bar1")])
+    }
+
+helper :: String -> Hamlet Url -> Assertion
+helper res h = do
+    let x = renderHamlet render h
+    res @=? toString x
+
+caseEmpty :: Assertion
+caseEmpty = helper "" [$hamlet||]
+
+caseStatic :: Assertion
+caseStatic = helper "some static content" [$hamlet|some static content|]
+
+caseTag :: Assertion
+caseTag = helper "<p class=\"foo\"><div id=\"bar\">baz</div></p>" [$hamlet|
+%p.foo
+ #bar baz|]
+
+caseVar :: Assertion
+caseVar = do
+    helper "&lt;var&gt;" [$hamlet|$var.theArg$|]
+
+caseVarChain :: Assertion
+caseVarChain = do
+    helper "&lt;var&gt;" [$hamlet|$var.getArg.getArg.getArg.theArg$|]
+
+caseUrl :: Assertion
+caseUrl = do
+    helper (render Home) [$hamlet|@url.theArg@|]
+
+caseUrlChain :: Assertion
+caseUrlChain = do
+    helper (render Home) [$hamlet|@url.getArg.getArg.getArg.theArg@|]
+
+caseEmbed :: Assertion
+caseEmbed = do
+    helper "embed" [$hamlet|^embed.theArg^|]
+
+caseEmbedChain :: Assertion
+caseEmbedChain = do
+    helper "embed" [$hamlet|^embed.getArg.getArg.getArg.theArg^|]
+
+caseIf :: Assertion
+caseIf = do
+    helper "if" [$hamlet|
+$if true.theArg
+    if
+|]
+
+caseIfChain :: Assertion
+caseIfChain = do
+    helper "if" [$hamlet|
+$if true.getArg.getArg.getArg.theArg
+    if
+|]
+
+caseElse :: Assertion
+caseElse = helper "else" [$hamlet|
+$if false.theArg
+    if
+$else
+    else
+|]
+
+caseElseChain :: Assertion
+caseElseChain = helper "else" [$hamlet|
+$if false.getArg.getArg.getArg.theArg
+    if
+$else
+    else
+|]
+
+caseElseIf :: Assertion
+caseElseIf = helper "elseif" [$hamlet|
+$if false.theArg
+    if
+$elseif true.theArg
+    elseif
+$else
+    else
+|]
+
+caseElseIfChain :: Assertion
+caseElseIfChain = helper "elseif" [$hamlet|
+$if false.getArg.getArg.getArg.theArg
+    if
+$elseif true.getArg.getArg.getArg.theArg
+    elseif
+$else
+    else
+|]
+
+caseList :: Assertion
+caseList = do
+    helper "xxx" [$hamlet|
+$forall list.theArg _x
+    x
+|]
+
+caseListChain :: Assertion
+caseListChain = do
+    helper "urlurlurl" [$hamlet|
+$forall list.getArg.getArg.getArg.getArg.getArg.theArg x
+    @url.x@
+|]
+
+caseScriptNotEmpty :: Assertion
+caseScriptNotEmpty = helper "<script></script>" [$hamlet|%script|]
+
+caseMetaEmpty :: Assertion
+caseMetaEmpty = do
+    helper "<meta>" [$hamlet|%meta|]
+    helper "<meta/>" [$xhamlet|%meta|]
+
+caseInputEmpty :: Assertion
+caseInputEmpty = do
+    helper "<input>" [$hamlet|%input|]
+    helper "<input/>" [$xhamlet|%input|]
+
+caseMultiClass :: Assertion
+caseMultiClass = do
+    helper "<div class=\"foo bar\"></div>" [$hamlet|.foo.bar|]
+
+caseAttribOrder :: Assertion
+caseAttribOrder = helper "<meta 1 2 3>" [$hamlet|%meta!1!2!3|]
+
+caseNothing :: Assertion
+caseNothing = do
+    helper "" [$hamlet|
+$maybe nothing.theArg _n
+    nothing
+|]
+    helper "nothing" [$hamlet|
+$maybe nothing.theArg _n
+    something
+$nothing
+    nothing
+|]
+
+caseNothingChain :: Assertion
+caseNothingChain = helper "" [$hamlet|
+$maybe nothing.getArg.getArg.getArg.theArg n
+    nothing $n$
+|]
+
+caseJust :: Assertion
+caseJust = helper "it's just" [$hamlet|
+$maybe just.theArg n
+    it's $n$
+|]
+
+caseJustChain :: Assertion
+caseJustChain = helper "it's just" [$hamlet|
+$maybe just.getArg.getArg.getArg.theArg n
+    it's $n$
+|]
+
+caseConstructor :: Assertion
+caseConstructor = do
+    helper "url" [$hamlet|@Home@|]
+    helper "suburl" [$hamlet|@Sub.SubUrl@|]
+    let text = "<raw text>"
+    helper "<raw text>" [$hamlet|$preEscapedString.text$|]
+
+caseUrlParams :: Assertion
+caseUrlParams = do
+    helper "url?foo=bar&amp;foo1=bar1" [$hamlet|@?urlParams.theArg@|]
+
+caseEscape :: Assertion
+caseEscape = do
+    helper "#this is raw\n " [$hamlet|
+\#this is raw
+\
+\ 
+|]
+    helper "$@^" [$hamlet|$$@@^^|]
+
+caseEmptyStatementList :: Assertion
+caseEmptyStatementList = do
+    helper "" [$hamlet|$if True|]
+    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|]
+
+caseNonAscii :: Assertion
+caseNonAscii = do
+    helper "עִבְרִי" [$hamlet|עִבְרִי|]
+
+caseMaybeFunction :: Assertion
+caseMaybeFunction = do
+    helper "url?foo=bar&amp;foo1=bar1" [$hamlet|
+$maybe Just.urlParams x
+    @?x.theArg@
+|]
+
+caseTrailingDollarSign :: Assertion
+caseTrailingDollarSign =
+    helper "trailing space \ndollar sign $" [$hamlet|trailing space $
+\
+dollar sign $$|]
+
+caseNonLeadingPercent :: Assertion
+caseNonLeadingPercent =
+    helper "<span style=\"height:100%\">foo</span>" [$hamlet|
+%span!style=height:100% foo
+|]
+
+caseQuotedAttribs :: Assertion
+caseQuotedAttribs =
+    helper "<input type=\"submit\" value=\"Submit response\">" [$hamlet|
+%input!type=submit!value="Submit response"
+|]
+
+caseSpacedDerefs :: Assertion
+caseSpacedDerefs = do
+    helper "&lt;var&gt;" [$hamlet|$var theArg$|]
+    helper "<div class=\"&lt;var&gt;\"></div>" [$hamlet|.$var theArg$|]
+
+caseAttribVars :: Assertion
+caseAttribVars = do
+    helper "<div id=\"&lt;var&gt;\"></div>" [$hamlet|#$var.theArg$|]
+    helper "<div class=\"&lt;var&gt;\"></div>" [$hamlet|.$var.theArg$|]
+    helper "<div f=\"&lt;var&gt;\"></div>" [$hamlet|%div!f=$var.theArg$|]
+
+caseStringsAndHtml :: Assertion
+caseStringsAndHtml = do
+    let str = "<string>"
+    let html = preEscapedString "<html>"
+    helper "&lt;string&gt; <html>" [$hamlet|$str$ $html$|]
+
+caseNesting :: Assertion
+caseNesting = do
+    helper
+      "<table><tbody><tr><td>1</td></tr><tr><td>2</td></tr></tbody></table>"
+      [$hamlet|
+%table
+  %tbody
+    $forall users user
+        %tr
+         %td $user$
+|]
+    helper
+        (concat
+          [ "<select id=\"foo\" name=\"foo\"><option selected></option>"
+          , "<option value=\"true\">Yes</option>"
+          , "<option value=\"false\">No</option>"
+          , "</select>"
+          ])
+        [$hamlet|
+%select#$name$!name=$name$
+    %option!:isBoolBlank.val:selected
+    %option!value=true!:isBoolTrue.val:selected Yes
+    %option!value=false!:isBoolFalse.val:selected No
+|]
+  where
+    users = ["1", "2"]
+    name = "foo"
+    val = 5
+    isBoolBlank _ = True
+    isBoolTrue _ = False
+    isBoolFalse _ = False
+
+caseTrailingSpace :: Assertion
+caseTrailingSpace =
+    helper "" [$hamlet|        |]
+
+caseCurrency :: Assertion
+caseCurrency =
+    helper foo [$hamlet|$foo$|]
+  where
+    foo = "eg: 5, $6, €7.01, £75"
+
+caseExternal :: Assertion
+caseExternal = do
+    helper "foo<br>" $ $(hamletFile "external.hamlet")
+    helper "foo<br/>" $ $(xhamletFile "external.hamlet")
+  where
+    foo = "foo"