{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module HamletTest (specs) where import Test.HUnit hiding (Test) import Test.Hspec import Test.Hspec.HUnit import Prelude hiding (reverse) import Text.Hamlet import Data.List (intercalate) import qualified Data.Text.Lazy as T import qualified Data.List import qualified Data.List as L import qualified Data.Map as Map import Data.Text (Text, pack, unpack) import Data.Monoid (mappend) import qualified Data.Set as Set import qualified Text.Blaze.Renderer.Text import Text.Blaze (toHtml, preEscapedString) specs = describe "hamlet" [ it "empty" caseEmpty , it "static" caseStatic , it "tag" caseTag , it "var" caseVar , it "var chain " caseVarChain , it "url" caseUrl , it "url chain " caseUrlChain , it "embed" caseEmbed , it "embed chain " caseEmbedChain , it "if" caseIf , it "if chain " caseIfChain , it "else" caseElse , it "else chain " caseElseChain , it "elseif" caseElseIf , it "elseif chain " caseElseIfChain , it "list" caseList , it "list chain" caseListChain , it "with" caseWith , it "with multi" caseWithMulti , it "with chain" caseWithChain , it "with comma string" caseWithCommaString , it "with multi scope" caseWithMultiBindingScope , it "script not empty" caseScriptNotEmpty , it "meta empty" caseMetaEmpty , it "input empty" caseInputEmpty , it "multiple classes" caseMultiClass , it "attrib order" caseAttribOrder , it "nothing" caseNothing , it "nothing chain " caseNothingChain , it "just" caseJust , it "just chain " caseJustChain , it "constructor" caseConstructor , it "url + params" caseUrlParams , it "escape" caseEscape , it "empty statement list" caseEmptyStatementList , it "attribute conditionals" caseAttribCond , it "non-ascii" caseNonAscii , it "maybe function" caseMaybeFunction , it "trailing dollar sign" caseTrailingDollarSign , it "non leading percent sign" caseNonLeadingPercent , it "quoted attributes" caseQuotedAttribs , it "spaced derefs" caseSpacedDerefs , it "attrib vars" caseAttribVars , it "strings and html" caseStringsAndHtml , it "nesting" caseNesting , it "trailing space" caseTrailingSpace , it "currency symbols" caseCurrency , it "external" caseExternal , it "parens" caseParens , it "hamlet literals" caseHamletLiterals , it "hamlet' and xhamlet'" caseHamlet' , it "comments" $ do -- FIXME reconsider Hamlet comment syntax? helper "" [hamlet|$# this is a comment $# another comment $#a third one|] , it "ignores a blank line" $ do helper "

foo

" [hamlet|

HELLO

" [hamlet| HELLO |] , it "hamlet module names" $ let foo = "foo" in helper "oof oof 3.14 -5" [hamlet|#{Data.List.reverse foo} # #{L.reverse foo} # #{show 3.14} #{show -5}|] , it "single dollar at and caret" $ do helper "$@^" [hamlet|\$@^|] helper "#{@{^{" [hamlet|#\{@\{^\{|] , it "dollar operator" $ do let val = (1, (2, 3)) helper "2" [hamlet|#{ show $ fst $ snd val }|] helper "2" [hamlet|#{ show $ fst $ snd $ val}|] , it "in a row" $ do helper "1" [hamlet|#{ show $ const 1 2 }|] , it "embedded slash" $ do helper "///" [hamlet|///|] {- compile-time error , it "tag with slash" $ do helper "" [hamlet|

Text

|] -} , it "string literals" $ do helper "string" [hamlet|#{"string"}|] helper "string" [hamlet|#{id "string"}|] helper "gnirts" [hamlet|#{L.reverse $ id "string"}|] helper "str"ing" [hamlet|#{"str\"ing"}|] helper "str<ing" [hamlet|#{"str1

2 not ignored

" [hamlet|

1

not ignored |] , it "nested maybes" $ do let muser = Just "User" :: Maybe String mprof = Nothing :: Maybe Int m3 = Nothing :: Maybe String helper "justnothing" [hamlet| $maybe user <- muser $maybe profile <- mprof First two are Just $maybe desc <- m3 \ and left us a description:

#{desc} $nothing and has left us no description. $nothing justnothing $nothing

No such Person exists. |] , it "conditional class" $ do helper "

" [hamlet|

" [hamlet|

" [hamlet|

HELLO WORLD

" [shamlet|

HELLO WORLD |] helperHtml "

HELLO WORLD

" $(shamletFile "test/hamlets/nonpolyhtml.hamlet") , it "non-poly Hamlet" $ do let embed = [hamlet|

EMBEDDED|] helper "

url

EMBEDDED

" [hamlet|

@{Home} ^{embed} |] helper "

url

" $(hamletFile "test/hamlets/nonpolyhamlet.hamlet") , it "non-poly IHamlet" $ do let embed = [ihamlet|

EMBEDDED|] ihelper "

Adios

EMBEDDED

" [ihamlet|

_{Goodbye} ^{embed} |] ihelper "

Hola

" $(ihamletFile "test/hamlets/nonpolyihamlet.hamlet") , it "pattern-match tuples: forall" $ do let people = [("Michael", 26), ("Miriam", 25)] helper "
Michael
26
Miriam
25
" [hamlet|
$forall (name, age) <- people
#{name}
#{show age} |] , it "pattern-match tuples: maybe" $ do let people = Just ("Michael", 26) helper "
Michael
26
" [hamlet|
$maybe (name, age) <- people
#{name}
#{show age} |] , it "pattern-match tuples: with" $ do let people = ("Michael", 26) helper "
Michael
26
" [hamlet|
$with (name, age) <- people
#{name}
#{show age} |] , it "list syntax for interpolation" $ do helper "
  • 1
  • 2
  • 3
" [hamlet|
    $forall num <- [1, 2, 3]
  • #{show num} |] , it "infix operators" $ helper "5" [hamlet|#{show $ (4 + 5) - (2 + 2)}|] , it "infix operators with parens" $ helper "5" [hamlet|#{show (2 + 3)}|] , it "doctypes" $ helper "\n\n" [hamlet| $doctype 5 $doctype strict |] , it "case on Maybe" $ let nothing = Nothing justTrue = Just True in helper "



    " [hamlet| $case nothing $of Just val $of Nothing
    $case justTrue $of Just val $if val
    $of Nothing $case (Just $ not False) $of Nothing $of Just val $if val
    $case Nothing $of Just val $of _
    |] , it "case on Url" $ let url1 = Home url2 = Sub SubUrl in helper "

    " [hamlet| $case url1 $of Home
    $of _ $case url2 $of Sub sub $case sub $of SubUrl
    $of Home |] , it "pattern-match constructors: forall" $ do let people = [Pair "Michael" 26, Pair "Miriam" 25] helper "
    Michael
    26
    Miriam
    25
    " [hamlet|
    $forall Pair name age <- people
    #{name}
    #{show age} |] , it "pattern-match constructors: maybe" $ do let people = Just $ Pair "Michael" 26 helper "
    Michael
    26
    " [hamlet|
    $maybe Pair name age <- people
    #{name}
    #{show age} |] , it "pattern-match constructors: with" $ do let people = Pair "Michael" 26 helper "
    Michael
    26
    " [hamlet|
    $with Pair name age <- people
    #{name}
    #{show age} |] ] data Pair = Pair String Int data Url = Home | Sub SubUrl data SubUrl = SubUrl render :: Url -> [(Text, Text)] -> Text render Home qs = pack "url" `mappend` showParams qs render (Sub SubUrl) qs = pack "suburl" `mappend` showParams qs showParams :: [(Text, Text)] -> Text showParams [] = pack "" showParams z = pack $ '?' : intercalate "&" (map go z) where go (x, y) = go' x ++ '=' : go' y go' = concatMap encodeUrlChar . unpack -- | Taken straight from web-encodings; reimplemented here to avoid extra -- dependencies. encodeUrlChar :: Char -> String encodeUrlChar c -- List of unreserved characters per RFC 3986 -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding | 'A' <= c && c <= 'Z' = [c] | 'a' <= c && c <= 'z' = [c] | '0' <= c && c <= '9' = [c] encodeUrlChar c@'-' = [c] encodeUrlChar c@'_' = [c] encodeUrlChar c@'.' = [c] encodeUrlChar c@'~' = [c] encodeUrlChar ' ' = "+" encodeUrlChar y = let (a, c) = fromEnum y `divMod` 16 b = a `mod` 16 showHex' x | x < 10 = toEnum $ x + (fromEnum '0') | x < 16 = toEnum $ x - 10 + (fromEnum 'A') | otherwise = error $ "Invalid argument to showHex: " ++ show x in ['%', showHex' b, showHex' c] data Arg url = Arg { getArg :: Arg url , var :: Html , url :: Url , embed :: HtmlUrl url , true :: Bool , false :: Bool , list :: [Arg url] , nothing :: Maybe String , just :: Maybe String , urlParams :: (Url, [(Text, Text)]) } theArg :: Arg url theArg = Arg { getArg = theArg , var = toHtml "" , url = Home , embed = [hamlet|embed|] , true = True , false = False , list = [theArg, theArg, theArg] , nothing = Nothing , just = Just "just" , urlParams = (Home, [(pack "foo", pack "bar"), (pack "foo1", pack "bar1")]) } helperHtml :: String -> Html -> Assertion helperHtml res h = do let x = Text.Blaze.Renderer.Text.renderHtml h T.pack res @=? x helper :: String -> HtmlUrl Url -> Assertion helper res h = do let x = Text.Blaze.Renderer.Text.renderHtml $ h render T.pack res @=? x caseEmpty :: Assertion caseEmpty = helper "" [hamlet||] caseStatic :: Assertion caseStatic = helper "some static content" [hamlet|some static content|] caseTag :: Assertion caseTag = do helper "

    baz

    " [hamlet|

    baz |] helper "

    baz

    " [hamlet|

    baz |] caseVar :: Assertion caseVar = do helper "<var>" [hamlet|#{var theArg}|] caseVarChain :: Assertion caseVarChain = do helper "<var>" [hamlet|#{var (getArg (getArg (getArg theArg)))}|] caseUrl :: Assertion caseUrl = do helper (unpack $ render Home []) [hamlet|@{url theArg}|] caseUrlChain :: Assertion caseUrlChain = do helper (unpack $ 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 _x <- (list theArg) x |] caseListChain :: Assertion caseListChain = do helper "urlurlurl" [hamlet| $forall x <- list(getArg(getArg(getArg(getArg(getArg (theArg)))))) @{url x} |] caseWith :: Assertion caseWith = do helper "it's embedded" [hamlet| $with n <- embed theArg it's ^{n}ded |] caseWithMulti :: Assertion caseWithMulti = do helper "it's embedded" [hamlet| $with n <- embed theArg, m <- true theArg $if m it's ^{n}ded |] caseWithChain :: Assertion caseWithChain = do helper "it's true" [hamlet| $with n <- true(getArg(getArg(getArg(getArg theArg)))) $if n it's true |] -- in multi-with binding, make sure that a comma in a string doesn't confuse the parser. caseWithCommaString :: Assertion caseWithCommaString = do helper "it's , something" [hamlet| $with n <- " , something" it's #{n} |] caseWithMultiBindingScope :: Assertion caseWithMultiBindingScope = do helper "it's , something" [hamlet| $with n <- " , something", y <- n it's #{y} |] caseScriptNotEmpty :: Assertion caseScriptNotEmpty = helper "" [hamlet|" [hamlet|" [xhamlet|" [hamlet||] helper "" [xhamlet||] caseInputEmpty :: Assertion caseInputEmpty = do helper "" [hamlet|" [xhamlet|" [hamlet||] helper "" [xhamlet||] caseMultiClass :: Assertion caseMultiClass = do helper "

    " [hamlet|<.foo.bar|] helper "
    " [hamlet|<.foo.bar>|] caseAttribOrder :: Assertion caseAttribOrder = do helper "" [hamlet|" [hamlet||] caseNothing :: Assertion caseNothing = do helper "" [hamlet| $maybe _n <- nothing theArg nothing |] helper "nothing" [hamlet| $maybe _n <- nothing theArg something $nothing nothing |] caseNothingChain :: Assertion caseNothingChain = helper "" [hamlet| $maybe n <- nothing(getArg(getArg(getArg theArg))) nothing #{n} |] caseJust :: Assertion caseJust = helper "it's just" [hamlet| $maybe n <- just theArg it's #{n} |] caseJustChain :: Assertion caseJustChain = helper "it's just" [hamlet| $maybe n <- just(getArg(getArg(getArg theArg))) it's #{n} |] caseConstructor :: Assertion caseConstructor = do helper "url" [hamlet|@{Home}|] helper "suburl" [hamlet|@{Sub SubUrl}|] let text = "" helper "" [hamlet|#{preEscapedString text}|] caseUrlParams :: Assertion caseUrlParams = do helper "url?foo=bar&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 _x <- Nothing|] let emptyList = [] helper "" [hamlet|$forall _x <- emptyList|] caseAttribCond :: Assertion caseAttribCond = do helper "" [hamlet|" [hamlet|" [hamlet|" [hamlet|" [hamlet|" [hamlet|" [hamlet| " [hamlet|<.#{var theArg}|] caseAttribVars :: Assertion caseAttribVars = do helper "
    " [hamlet|<##{var theArg}|] helper "
    " [hamlet|<.#{var theArg}|] helper "
    " [hamlet|< f=#{var theArg}|] helper "
    " [hamlet|<##{var theArg}>|] helper "
    " [hamlet|<.#{var theArg}>|] helper "
    " [hamlet|< f=#{var theArg}>|] caseStringsAndHtml :: Assertion caseStringsAndHtml = do let str = "" let html = preEscapedString "" helper "<string> " [hamlet|#{str} #{html}|] caseNesting :: Assertion caseNesting = do helper "
    1
    2
    " [hamlet| #{user} |] helper (concat [ "" ]) [hamlet|