hamlet 0.0.2 → 0.2.0
raw patch · 5 files changed
+310/−150 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Text.Hamlet.Monad: outputUrlParams :: (Monad m) => (url, [(String, String)]) -> Hamlet url m ()
- Text.Hamlet.Parse: ContentUrl :: Deref -> Content
+ Text.Hamlet.Parse: ContentUrl :: Bool -> Deref -> Content
Files
- Text/Hamlet/Monad.hs +36/−0
- Text/Hamlet/Parse.hs +35/−18
- Text/Hamlet/Quasi.hs +105/−81
- hamlet.cabal +24/−1
- runtests.hs +110/−50
Text/Hamlet/Monad.hs view
@@ -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 ()
Text/Hamlet/Parse.hs view
@@ -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)
Text/Hamlet/Quasi.hs view
@@ -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')
hamlet.cabal view
@@ -1,10 +1,33 @@ name: hamlet-version: 0.0.2+version: 0.2.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com> maintainer: Michael Snoyman <michael@snoyman.com> 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 <http://docs.yesodweb.com/hamlet/> 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
runtests.hs view
@@ -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 "<var>" , mvar = return $ Unencoded $ pack "<var>" , 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 "<raw text>"+ helper "<raw text>" [$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|]