diff --git a/Text/Hamlet/Monad.hs b/Text/Hamlet/Monad.hs --- a/Text/Hamlet/Monad.hs +++ b/Text/Hamlet/Monad.hs @@ -12,6 +12,7 @@ , outputHtml , outputString , outputUrl + , outputUrlParams , outputEmbed -- * Utility functions , showUrl @@ -31,6 +32,7 @@ import Control.Monad import Web.Encodings import Data.Monoid +import Data.List -- | Something to be run for each val. Returns 'Left' when enumeration should -- terminate immediately, 'Right' when it can receive more input. @@ -133,6 +135,40 @@ -- then calls 'outputString'. outputUrl :: Monad m => url -> Hamlet url m () outputUrl u = showUrl u >>= outputString + +-- | Same as 'outputUrl', but appends a query-string with given keys and +-- values. +outputUrlParams :: Monad m => (url, [(String, String)]) -> Hamlet url m () +outputUrlParams (u, params) = do + outputUrl u + outputString $ showParams params + where + showParams x = '?' : intercalate "&" (map go x) + go (x, y) = go' x ++ '=' : go' y + go' = concatMap encodeUrlChar + +-- | 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 -- FIXME just use Numeric version? + | 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] -- | Only really used to ensure that the argument has the right type. outputEmbed :: Monad m => Hamlet url m () -> Hamlet url m () diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs --- a/Text/Hamlet/Parse.hs +++ b/Text/Hamlet/Parse.hs @@ -40,14 +40,14 @@ pure = return (<*>) = ap -newtype Deref = Deref [(Bool, Ident)] +newtype Deref = Deref [(Bool, Ident)] -- ^ is monadic, ident deriving (Show, Eq, Read, Data, Typeable) newtype Ident = Ident String deriving (Show, Eq, Read, Data, Typeable) data Content = ContentRaw String | ContentVar Deref - | ContentUrl Deref + | ContentUrl Bool Deref -- ^ bool: does it include params? | ContentEmbed Deref deriving (Show, Eq, Read, Data, Typeable) @@ -78,6 +78,8 @@ 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 @@ -106,7 +108,7 @@ #if TEST fooBar :: Deref -fooBar = Deref [(False, Ident "foo"), (False, Ident "bar")] +fooBar = Deref [(False, Ident "bar"), (False, Ident "foo")] caseParseLine :: Assertion caseParseLine = do @@ -115,7 +117,9 @@ parseLine' "$elseif foo.bar" @?= Ok (LineElseIf fooBar) parseLine' "$else" @?= Ok LineElse parseLine' "%img!src=@foo.bar@" - @?= Ok (LineTag "img" [("src", [ContentUrl fooBar])] [] []) + @?= Ok (LineTag "img" [("src", [ContentUrl False fooBar])] [] []) + parseLine' "%img!src=@?foo.bar@" + @?= Ok (LineTag "img" [("src", [ContentUrl True fooBar])] [] []) parseLine' ".$foo.bar$" @?= Ok (LineTag "div" [] [] [[ContentVar fooBar]]) parseLine' "%span#foo.bar.bar2!baz=bin" @@ -125,6 +129,10 @@ [ [ContentRaw "bar"] , [ContentRaw "bar2"] ]) + parseLine' "\\#this is raw" + @?= Ok (LineContent [ContentRaw "#this is raw"]) + parseLine' "\\" + @?= Ok (LineContent [ContentRaw "\n"]) #endif parseContent :: String -> Result [Content] @@ -139,14 +147,17 @@ rest' <- parseContent rest return $ ContentRaw [delim] : rest' (deref, _:rest) -> do - deref' <- parseDeref deref - let x = case delim of - '$' -> ContentVar - '@' -> ContentUrl - '^' -> ContentEmbed + 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' + return $ x deref'' : rest' (_, "") -> error $ "Missing ending delimiter in " ++ s case a of "" -> return b @@ -161,10 +172,16 @@ , ContentVar $ Deref [(False, Ident "bar")] , ContentRaw " baz" ] - parseContent "foo @bar@ baz" @?= Ok [ ContentRaw "foo " - , ContentUrl $ Deref [(False, Ident "bar")] - , ContentRaw " baz" - ] + parseContent "foo @bar@ baz" @?= + Ok [ ContentRaw "foo " + , ContentUrl False (Deref [(False, Ident "bar")]) + , ContentRaw " baz" + ] + parseContent "foo @?bar@ baz" @?= + Ok [ ContentRaw "foo " + , ContentUrl True (Deref [(False, Ident "bar")]) + , ContentRaw " baz" + ] parseContent "foo ^bar^ baz" @?= Ok [ ContentRaw "foo " , ContentEmbed $ Deref [(False, Ident "bar")] , ContentRaw " baz" @@ -175,20 +192,19 @@ parseDeref :: String -> Result Deref parseDeref "" = Error "Invalid empty deref" -parseDeref s = Deref <$> go s where - go "" = return [] +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" + _ -> Error "Invalid branch in Text.Hamlet.Parse.parseDef" #if TEST caseParseDeref :: Assertion caseParseDeref = do - parseDeref "foo.*bar.baz" @?= + parseDeref "baz.*bar.foo" @?= Ok (Deref [ (False, Ident "foo") , (True, Ident "bar") , (False, Ident "baz")]) @@ -199,6 +215,7 @@ parseIdent s = parseIdent' False s parseIdent' :: Bool -> String -> Result (Bool, Ident) +parseIdent' _ "" = Error "Invalid empty ident" parseIdent' b s | all (flip elem (['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'")) s = Ok (b, Ident s) diff --git a/Text/Hamlet/Quasi.hs b/Text/Hamlet/Quasi.hs --- a/Text/Hamlet/Quasi.hs +++ b/Text/Hamlet/Quasi.hs @@ -11,104 +11,103 @@ import Language.Haskell.TH.Quote import Control.Monad import Data.List (sortBy, isPrefixOf) +import Data.Char (isUpper) +import Control.Applicative ((<$>)) -type Vars = (Scope, Exp, [Stmt] -> [Stmt]) +type Vars = (Scope, [Stmt] -> [Stmt]) type Scope = [([Ident], Exp)] docsToExp :: [Doc] -> Q Exp docsToExp docs = do - arg <- newName "_arg" - (_, _, stmts) <- foldM docToStmt ([], VarE arg, id) docs - stmts' <- case stmts [] of - [] -> do - ret <- [|return ()|] - return [NoBindS ret] - x -> return x - return $ LamE [VarP arg] $ DoE stmts' + (_, stmts) <- foldM docToStmt ([], id) docs + safeDoE $ stmts [] +safeDoE :: [Stmt] -> Q Exp +safeDoE [] = [|return ()|] +safeDoE x = return $ DoE x + docToStmt :: Vars -> Doc -> Q Vars -docToStmt (vars, arg, stmts) (DocForall (Deref idents) ident@(Ident name) inside) = do +docToStmt (vars, stmts) (DocForall (Deref idents) ident@(Ident name) inside) = do (vars', deref', stmts', isEnum) <- case idents of [] -> error $ "Invalid forall deref: " ++ show idents [(x, Ident i)] -> do - let i' = VarE (mkName i) `AppE` arg - return (vars, i', id, x) + return (vars, getBase vars $ Ident i, id, x) _ -> do let front = Deref $ init idents (x, Ident i) = last idents - (vars', base, stmts') <- bindDeref vars arg front + (vars', base, stmts') <- bindDeref vars front return (vars', VarE (mkName i) `AppE` base, stmts', x) fl <- [|fromList|] let deref'' = if isEnum then deref' else fl `AppE` deref' mh <- [|mapH|] ident' <- newName name let vars'' = ([ident], VarE ident') : vars' - (_, _, inside') <- foldM docToStmt (vars'', arg, id) inside - let dos = LamE [VarP ident'] $ DoE $ inside' [] + (_, inside') <- foldM docToStmt (vars'', id) inside + dos <- LamE [VarP ident'] <$> (safeDoE $ inside' []) let stmt = NoBindS $ mh `AppE` dos `AppE` deref'' - return (vars', arg, stmts . stmts' . (:) stmt) -docToStmt (vars, arg, stmts) (DocMaybe deref ident@(Ident name) inside) = do - (vars', base, stmts') <- bindDeref vars arg deref + return (vars', stmts . stmts' . (:) stmt) +docToStmt (vars, stmts) (DocMaybe deref ident@(Ident name) inside) = do + (vars', base, stmts') <- bindDeref vars deref ident' <- newName name let vars'' = ([ident], VarE ident') : vars' - (_, _, inside') <- foldM docToStmt (vars'', arg, id) inside - let dos = LamE [VarP ident'] $ DoE $ inside' [] + (_, inside') <- foldM docToStmt (vars'', id) inside + dos <- LamE [VarP ident'] <$> (safeDoE $ inside' []) mh <- [|maybeH|] let stmt = NoBindS $ mh `AppE` base `AppE` dos - return (vars', arg, stmts . stmts' . (:) stmt) -docToStmt (vars, arg, stmts) (DocCond conds final) = do - conds' <- liftConds vars arg conds id + return (vars', stmts . stmts' . (:) stmt) +docToStmt (vars, stmts) (DocCond conds final) = do + conds' <- liftConds vars conds id final' <- case final of Nothing -> [|Nothing|] Just f -> do - (_, _, f') <- foldM docToStmt (vars, arg, id) f + (_, f') <- foldM docToStmt (vars, id) f j <- [|Just|] - return $ j `AppE` (DoE $ f' []) + AppE j <$> (safeDoE $ f' []) ch <- [|condH|] let stmt = NoBindS $ ch `AppE` conds' `AppE` final' - return (vars, arg, stmts . (:) stmt) + return (vars, stmts . (:) stmt) docToStmt v (DocContent c) = foldM contentToStmt v c contentToStmt :: Vars -> Content -> Q Vars -contentToStmt (a, b, c) (ContentRaw s) = do +contentToStmt (a, b) (ContentRaw s) = do os <- [|outputString|] s' <- lift s let stmt = NoBindS $ os `AppE` s' - return (a, b, c . (:) stmt) -contentToStmt (vars, arg, stmts) (ContentVar d) = do - (vars', d', stmts') <- bindDeref vars arg d + return (a, b . (:) stmt) +contentToStmt (vars, stmts) (ContentVar d) = do + (vars', d', stmts') <- bindDeref vars d oh <- [|outputHtml|] let stmt = NoBindS $ oh `AppE` d' - return (vars', arg, stmts . stmts' . (:) stmt) -contentToStmt (vars, arg, stmts) (ContentUrl d) = do - (vars', d', stmts') <- bindDeref vars arg d - ou <- [|outputUrl|] + return (vars', stmts . stmts' . (:) stmt) +contentToStmt (vars, stmts) (ContentUrl hasParams d) = do + (vars', d', stmts') <- bindDeref vars d + ou <- if hasParams then [|outputUrlParams|] else [|outputUrl|] let stmt = NoBindS $ ou `AppE` d' - return (vars', arg, stmts . stmts' . (:) stmt) -contentToStmt (vars, arg, stmts) (ContentEmbed d) = do - (vars', d', stmts') <- bindDeref vars arg d + return (vars', stmts . stmts' . (:) stmt) +contentToStmt (vars, stmts) (ContentEmbed d) = do + (vars', d', stmts') <- bindDeref vars d oe <- [|outputEmbed|] let stmt = NoBindS $ oe `AppE` d' - return (vars', arg, stmts . stmts' . (:) stmt) + return (vars', stmts . stmts' . (:) stmt) liftConds :: Scope - -> Exp -> [(Deref, [Doc])] -> (Exp -> Exp) -> Q Exp -liftConds _vars _arg [] front = do +liftConds _vars [] front = do nil <- [|[]|] return $ front nil -liftConds vars arg ((bool, doc):conds) front = do - let (base, rest) = shortestPath vars arg bool +liftConds vars ((bool, doc):conds) front = do + let (base, rest) = shortestPath vars bool bool' <- identsToVal False (Deref rest) base - (_, _, doc') <- foldM docToStmt (vars, arg, id) doc - let pair = TupE [bool', DoE $ doc' []] + (_, doc') <- foldM docToStmt (vars, id) doc + doe <- safeDoE $ doc' [] + let pair = TupE [bool', doe] cons <- [|(:)|] let front' rest' = front (cons `AppE` pair `AppE` rest') - liftConds vars arg conds front' + liftConds vars conds front' -- | Calls 'hamletWithSettings' with 'defaultHamletSettings'. hamlet :: QuasiQuoter @@ -140,23 +139,25 @@ -- deref helper funcs shortestPath :: Scope - -> Exp -- ^ original argument -> Deref -- ^ path sought -> (Exp, [(Bool, Ident)]) -- ^ (base, path from base) -shortestPath vars e (Deref is) = findMatch' svars is e +shortestPath scope (Deref is) = findMatch' svars where svars = sortBy (\(x, _) (y, _) - -> compare (length y) (length x)) vars - findMatch' [] is' e' = (e', is') - findMatch' (x:xs) is' e' = - case checkMatch x is' of + -> compare (length y) (length x)) scope + findMatch' [] = + case is of + ((False, top):rest) -> (getBase scope top, rest) + ((True, _):_) -> error "shortestPath: first segment is monadic" + [] -> error "shortestPath called with null deref" + findMatch' (x:xs) = + case checkMatch x of Just y -> y - Nothing -> findMatch' xs is' e' + Nothing -> findMatch' xs checkMatch :: ([Ident], Exp) - -> [(Bool, Ident)] -> Maybe (Exp, [(Bool, Ident)]) - checkMatch (a, e') b - | a `isPrefixOf` map snd b = Just (e', drop (length a) b) + checkMatch (a, e') + | a `isPrefixOf` map snd is = Just (e', drop (length a) is) | otherwise = Nothing -- | Converts a chain of idents and initial 'Exp' to a monadic value. @@ -184,33 +185,56 @@ let e' = fm `AppE` (VarE $ mkName i) `AppE` e identsToVal True (Deref is) e' +getBase :: Scope + -> Ident + -> Exp +getBase _ (Ident "") = error "Invalid empty ident" +getBase _ (Ident name@(x:_)) + | isUpper x = ConE $ mkName name +getBase scope (Ident top) = + case lookup [Ident top] scope of + Nothing -> VarE $ mkName top + Just e -> e + +bindMonadicVar :: String -> Exp -> Q (Exp, [Stmt] -> [Stmt]) +bindMonadicVar name e = do + lh <- [|liftHamlet|] + name' <- newName name + let stmt = BindS (VarP name') $ lh `AppE` e + return (VarE name', (:) stmt) + -- | Add a new binding for a 'Deref' bindDeref :: Scope - -> Exp -- ^ argument -> Deref -> Q (Scope, Exp, [Stmt] -> [Stmt]) -bindDeref vars arg (Deref []) = return (vars, arg, id) -bindDeref vars arg deref@(Deref idents) = - case lookup (map snd idents) vars of - Just e -> return (vars, e, id) - Nothing -> do - let front = init idents - (isMonad, Ident final) = last idents - (vars', base, stmts) <- bindDeref vars arg $ Deref front - lh <- [|liftHamlet|] - let rhs = VarE (mkName final) `AppE` base - var <- newName $ derefToName deref - let stmt = - if isMonad - then BindS (VarP var) $ lh `AppE` rhs - else LetS [FunD var - [ Clause [] (NormalB rhs) [] - ]] - let vars'' = (map snd idents, VarE var) : vars' - return (vars'', VarE var, stmts . (:) stmt) - -derefToName :: Deref -> String -derefToName (Deref is') = go is' where - go [] = "" - go [(_, Ident i)] = i - go ((_, Ident i):is) = i ++ "__" ++ go is +bindDeref _ (Deref []) = error "bindDeref with null deref" +bindDeref scopeFirst (Deref ((isMonadFirst, Ident base):rest)) = do + let base' = getBase scopeFirst $ Ident base + (base'', stmts) <- + if isMonadFirst + then bindMonadicVar base base' + else return (base', id) + (x, y, z, _) <- foldM go (scopeFirst, base'', stmts, [Ident base]) rest + return (x, y, z) + where + go :: (Scope, Exp, [Stmt] -> [Stmt], [Ident]) + -> (Bool, Ident) + -> Q (Scope, Exp, [Stmt] -> [Stmt], [Ident]) + go (scope, base', stmts, front) (isMonad, Ident func) = do + let (x, func') = + if not (null func) && isUpper (head func) + then (ConE, "var" ++ func) + else (VarE, func) + let rhs = x (mkName func) `AppE` base' + name <- newName func' + stmt <- + if isMonad + then do + lh <- [|liftHamlet|] + return $ BindS (VarP name) $ lh `AppE` rhs + else return $ LetS [FunD name + [ Clause [] (NormalB rhs) [] + ]] + let front' = front ++ [Ident func] + return ((front', VarE name) : scope, VarE name, + stmts . (:) stmt, front') diff --git a/hamlet.cabal b/hamlet.cabal --- a/hamlet.cabal +++ b/hamlet.cabal @@ -1,10 +1,33 @@ name: hamlet -version: 0.0.2 +version: 0.2.0 license: BSD3 license-file: LICENSE author: Michael Snoyman maintainer: Michael Snoyman synopsis: Haml-like template files that are compile-time checked +description: + Hamlet gives you a type-safe tool for generating HTML code. It works via Quasi-Quoting, and generating extremely efficient output code. The syntax is white-space sensitive, and it helps you avoid cross-site scripting issues and 404 errors. Please see the documentation at for more details. + . + As a quick overview, here is a sample Hamlet template: + . + > !!! + > %html + > %head + > %title Hamlet Demo + > %body + > %h1 Information on $name.person$ + > %p $*name.person$ is $age.person$ years old. + > %h2 + > $if isMarried.person + > Married + > $else + > Not married + > %ul + > $forall children.person child + > %li $child$ + > %p + > %a!href=@page.person@ See the page. + > ^footer^ category: Web stability: unstable cabal-version: >= 1.6 diff --git a/runtests.hs b/runtests.hs --- a/runtests.hs +++ b/runtests.hs @@ -53,11 +53,18 @@ , testCase "just" caseJust , testCase "just monad" caseJustMonad , testCase "just chain " caseJustChain + , testCase "constructor" caseConstructor + , testCase "url + params" caseUrlParams + , testCase "url + params monad" caseUrlParamsMonad + , testCase "escape" caseEscape + , testCase "empty statement list" caseEmptyStatementList ] -data Url = Home +data Url = Home | Sub SubUrl +data SubUrl = SubUrl render :: Url -> String render Home = "url" +render (Sub SubUrl) = "suburl" data Arg m url = Arg { getArg :: Arg m url @@ -78,33 +85,37 @@ , mnothing :: m (Maybe HtmlContent) , just :: Maybe HtmlContent , mjust :: m (Maybe HtmlContent) + , urlParams :: (Url, [(String, String)]) + , murlParams :: m (Url, [(String, String)]) } -arg :: Monad m => Arg m url -arg = Arg - { getArg = arg - , getArgM = return arg +theArg :: Arg IO url +theArg = Arg + { getArg = theArg + , getArgM = return theArg , var = Unencoded $ pack "" , mvar = return $ Unencoded $ pack "" , url = Home , murl = return Home - , embed = [$hamlet|embed|] () - , membed = return $ [$hamlet|embed|] () + , embed = [$hamlet|embed|] + , membed = return [$hamlet|embed|] , true = True , mtrue = return True , false = False , mfalse = return False - , list = [arg, arg, arg] - , enum = fromList $ list arg + , list = [theArg, theArg, theArg] + , enum = fromList $ list theArg , nothing = Nothing , mnothing = return Nothing , just = Just $ Unencoded $ pack "just" , mjust = return $ Just $ Unencoded $ pack "just" + , urlParams = (Home, [("foo", "bar"), ("foo1", "bar1")]) + , murlParams = return $ urlParams theArg } -helper :: String -> (Arg IO Url -> Hamlet Url IO ()) -> Assertion +helper :: String -> Hamlet Url IO () -> Assertion helper res h = do - x <- hamletToText render $ h arg + x <- hamletToText render h res @=? unpack x caseEmpty :: Assertion @@ -119,53 +130,65 @@ #bar baz|] caseVar :: Assertion -caseVar = helper "<var>" [$hamlet|$var$|] +caseVar = do + helper "<var>" [$hamlet|$var.theArg$|] caseVarMonad :: Assertion -caseVarMonad = helper "<var>" [$hamlet|$*mvar$|] +caseVarMonad = do + helper "<var>" [$hamlet|$*mvar.theArg$|] caseVarChain :: Assertion -caseVarChain = helper "<var>" [$hamlet|$getArg.*getArgM.getArg.var$|] +caseVarChain = do + helper "<var>" [$hamlet|$var.getArg.*getArgM.getArg.theArg$|] caseUrl :: Assertion -caseUrl = helper (render Home) [$hamlet|@url@|] +caseUrl = do + helper (render Home) [$hamlet|@url.theArg@|] caseUrlMonad :: Assertion -caseUrlMonad = helper (render Home) [$hamlet|@*murl@|] +caseUrlMonad = do + helper (render Home) [$hamlet|@*murl.theArg@|] caseUrlChain :: Assertion -caseUrlChain = helper (render Home) [$hamlet|@getArg.*getArgM.getArg.url@|] +caseUrlChain = do + helper (render Home) [$hamlet|@url.getArg.*getArgM.getArg.theArg@|] caseEmbed :: Assertion -caseEmbed = helper "embed" [$hamlet|^embed^|] +caseEmbed = do + helper "embed" [$hamlet|^embed.theArg^|] caseEmbedMonad :: Assertion -caseEmbedMonad = helper "embed" [$hamlet|^*membed^|] +caseEmbedMonad = do + helper "embed" [$hamlet|^*membed.theArg^|] caseEmbedChain :: Assertion -caseEmbedChain = helper "embed" [$hamlet|^getArg.*getArgM.getArg.embed^|] +caseEmbedChain = do + helper "embed" [$hamlet|^embed.getArg.*getArgM.getArg.theArg^|] caseIf :: Assertion -caseIf = helper "if" [$hamlet| -$if true +caseIf = do + helper "if" [$hamlet| +$if true.theArg if |] caseIfMonad :: Assertion -caseIfMonad = helper "if" [$hamlet| -$if *mtrue +caseIfMonad = do + helper "if" [$hamlet| +$if *mtrue.theArg if |] caseIfChain :: Assertion -caseIfChain = helper "if" [$hamlet| -$if getArg.*getArgM.getArg.*mtrue +caseIfChain = do + helper "if" [$hamlet| +$if *mtrue.getArg.*getArgM.getArg.theArg if |] caseElse :: Assertion caseElse = helper "else" [$hamlet| -$if false +$if false.theArg if $else else @@ -173,7 +196,7 @@ caseElseMonad :: Assertion caseElseMonad = helper "else" [$hamlet| -$if *mfalse +$if *mfalse.theArg if $else else @@ -181,7 +204,7 @@ caseElseChain :: Assertion caseElseChain = helper "else" [$hamlet| -$if getArg.*getArgM.getArg.*mfalse +$if *mfalse.getArg.*getArgM.getArg.theArg if $else else @@ -189,9 +212,9 @@ caseElseIf :: Assertion caseElseIf = helper "elseif" [$hamlet| -$if false +$if false.theArg if -$elseif true +$elseif true.theArg elseif $else else @@ -199,9 +222,9 @@ caseElseIfMonad :: Assertion caseElseIfMonad = helper "elseif" [$hamlet| -$if *mfalse +$if *mfalse.theArg if -$elseif *mtrue +$elseif *mtrue.theArg elseif $else else @@ -209,36 +232,43 @@ caseElseIfChain :: Assertion caseElseIfChain = helper "elseif" [$hamlet| -$if getArg.*getArgM.getArg.*mfalse +$if *mfalse.getArg.*getArgM.getArg.theArg if -$elseif getArg.*getArgM.getArg.*mtrue +$elseif *mtrue.getArg.*getArgM.getArg.theArg elseif $else else |] caseList :: Assertion -caseList = helper "xxx" [$hamlet| -$forall list x +caseList = do + helper "xxx" [$hamlet| +$forall list.theArg x x |] caseListChain :: Assertion -caseListChain = helper "urlurlurl" [$hamlet| -$forall getArg.*getArgM.getArg.getArg.*getArgM.list x - @x.*murl@ +caseListChain = do + helper "urlurlurl" [$hamlet| +$forall list.*getArgM.getArg.getArg.*getArgM.getArg.theArg x + @*murl.x@ |] caseEnum :: Assertion -caseEnum = helper "xxx" [$hamlet| -$forall *enum x +caseEnum = do + helper "xxx" [$hamlet| +$forall *enum.theArg x x |] + helper "xxx" [$hamlet| +$forall *enum.theArg x + x +|] caseEnumChain :: Assertion caseEnumChain = helper "urlurlurl" [$hamlet| -$forall getArg.*getArgM.getArg.getArg.*getArgM.*enum x - @x.*murl@ +$forall *enum.*getArgM.getArg.getArg.*getArgM.getArg.theArg x + @*murl.x@ |] caseScriptNotEmpty :: Assertion @@ -263,36 +293,66 @@ caseNothing :: Assertion caseNothing = helper "" [$hamlet| -$maybe nothing n +$maybe nothing.theArg n nothing |] caseNothingMonad :: Assertion caseNothingMonad = helper "" [$hamlet| -$maybe *mnothing n +$maybe *mnothing.theArg n nothing $n$ |] caseNothingChain :: Assertion caseNothingChain = helper "" [$hamlet| -$maybe getArg.*getArgM.getArg.*mnothing n +$maybe *mnothing.getArg.*getArgM.getArg.theArg n nothing $n$ |] caseJust :: Assertion caseJust = helper "it's just" [$hamlet| -$maybe just n +$maybe just.theArg n it's $n$ |] caseJustMonad :: Assertion caseJustMonad = helper "it's just" [$hamlet| -$maybe *mjust n +$maybe *mjust.theArg n it's $n$ |] caseJustChain :: Assertion caseJustChain = helper "it's just" [$hamlet| -$maybe getArg.*getArgM.getArg.*mjust n +$maybe *mjust.getArg.*getArgM.getArg.theArg n it's $n$ |] + +caseConstructor :: Assertion +caseConstructor = do + helper "url" [$hamlet|@Home@|] + helper "suburl" [$hamlet|@Sub.SubUrl@|] + let text = pack "" + helper "" [$hamlet|$Encoded.text$|] + +caseUrlParams :: Assertion +caseUrlParams = do + helper "url?foo=bar&foo1=bar1" [$hamlet|@?urlParams.theArg@|] + +caseUrlParamsMonad :: Assertion +caseUrlParamsMonad = do + helper "url?foo=bar&foo1=bar1" [$hamlet|@?*murlParams.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|]