hamlet 0.0.1 → 0.0.2

raw patch · 5 files changed

+123/−22 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/Hamlet/Monad.hs +9/−0
• Text/Hamlet/Parse.hs +45/−21
• Text/Hamlet/Quasi.hs +9/−0
• hamlet.cabal +1/−1
• runtests.hs +59/−0

@@ -18,6 +18,7 @@     , liftHamlet     , mapH     , condH+    , maybeH     , printHamlet     , hamletToText     , cdata@@ -176,6 +177,14 @@ condH ((x, y):rest) z = do     x' <- liftHamlet x     if x' then y else condH rest z++-- | Runs the second argument with the value in the first, if available.+maybeH :: Monad m+       => Maybe v+       -> (v -> Hamlet url m ())+       -> Hamlet url m ()+maybeH Nothing _ = return ()+maybeH (Just v) f = f v  -- | Prints a Hamlet to standard out. Good for debugging. printHamlet :: (url -> String) -> Hamlet url IO () -> IO ()

@@ -19,6 +19,7 @@ import Control.Monad import Control.Arrow import Data.Data+import Data.List (intercalate)  #if TEST import Test.Framework (testGroup, Test)@@ -54,10 +55,12 @@           | LineIf Deref           | LineElseIf Deref           | LineElse+          | LineMaybe Deref Ident           | LineTag             { _lineTagName :: String             , _lineAttr :: [(String, [Content])]             , _lineContent :: [Content]+            , _lineClasses :: [[Content]]             }           | LineContent [Content]     deriving (Eq, Show, Read)@@ -86,12 +89,19 @@ 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+            (False, y') <- parseIdent' False y+            return $ LineMaybe x' y'+        _ -> Error $ "Invalid maybe: " ++ rest parseLine _ x@(c:_) | c `elem` "%#." = do     let (begin, rest) = break (== ' ') x         rest' = dropWhile (== ' ') rest-    (tn, attr) <- parseTag begin+    (tn, attr, classes) <- parseTag begin     con <- parseContent rest'-    return $ LineTag tn attr con+    return $ LineTag tn attr con classes parseLine _ s = LineContent <$> parseContent s  #if TEST@@ -105,14 +115,16 @@     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 fooBar])] [] [])     parseLine' ".$foo.bar$"-        @?= Ok (LineTag "div" [("class", [ContentVar fooBar])] [])-    parseLine' "%span#foo.bar!baz=bin"-        @?= Ok (LineTag "span" [ ("baz", [ContentRaw "bin"])-                               , ("class", [ContentRaw "bar"])-                               , ("id", [ContentRaw "foo"])-                               ] [])+        @?= Ok (LineTag "div" [] [] [[ContentVar fooBar]])+    parseLine' "%span#foo.bar.bar2!baz=bin"+        @?= Ok (LineTag "span" [ ("id", [ContentRaw "foo"])+                               , ("baz", [ContentRaw "bin"])+                               ] []+                               [ [ContentRaw "bar"]+                               , [ContentRaw "bar2"]+                               ]) #endif  parseContent :: String -> Result [Content]@@ -199,25 +211,26 @@     parseIdent "*foo" @?= Ok (True, Ident "foo") #endif -parseTag :: String -> Result (String, [(String, [Content])])+parseTag :: String -> Result (String, [(String, [Content])], [[Content]]) parseTag s = do     pieces <- takePieces s-    foldM go ("div", []) pieces+    (a, b, c) <- foldM go ("div", id, id) pieces+    return (a, b [], c [])   where-    go (_, attrs) ('%':tn) = Ok (tn, attrs)-    go (tn, attrs) ('.':cl) = do+    go (_, attrs, classes) ('%':tn) = Ok (tn, attrs, classes)+    go (tn, attrs, classes) ('.':cl) = do         con <- parseContent cl-        Ok (tn, ("class", con) : attrs)-    go (tn, attrs) ('#':cl) = do+        Ok (tn, attrs, classes . (:) con)+    go (tn, attrs, classes) ('#':cl) = do         con <- parseContent cl-        Ok (tn, ("id", con) : attrs)-    go (tn, attrs) ('!':rest) = do+        Ok (tn, attrs . (:) ("id", con), classes)+    go (tn, attrs, classes) ('!':rest) = do         let (name, val) = break (== '=') rest         val' <-             case val of                 ('=':rest') -> parseContent rest'                 _ -> Ok []-        Ok (tn, (name, val') : attrs)+        Ok (tn, attrs . (:) (name, val'), classes)     go _ _ = error "Invalid branch in Text.Hamlet.Parse.parseTag"  takePieces :: String -> Result [String]@@ -247,6 +260,7 @@  data Doc = DocForall Deref Ident [Doc]          | DocCond [(Deref, [Doc])] (Maybe [Doc])+         | DocMaybe Deref Ident [Doc]          | DocContent [Content]     deriving (Show, Eq, Read, Data, Typeable) @@ -261,7 +275,15 @@     (ifs, el, rest') <- parseConds set ((:) (d, inside')) rest     rest'' <- nestToDoc set rest'     Ok $ DocCond ifs el : rest''-nestToDoc set (Nest (LineTag tn attrs content) inside:rest) = do+nestToDoc set (Nest (LineMaybe d i) inside:rest) = do+    inside' <- nestToDoc set inside+    rest' <- nestToDoc set rest+    Ok $ DocMaybe d i inside' : rest'+nestToDoc set (Nest (LineTag tn attrs content classes) inside:rest) = do+    let attrs' = case classes of+                    [] -> attrs+                    _ -> ("class", intercalate [ContentRaw " "] classes)+                       : attrs     let closeStyle =             if not (null content) || not (null inside)                 then CloseSeparate@@ -273,10 +295,10 @@                  CloseInside -> ContentRaw "/>"                  _ -> ContentRaw ">"         start = ContentRaw $ "<" ++ tn-        attrs' = concatMap attrToContent attrs+        attrs'' = concatMap attrToContent attrs'     inside' <- nestToDoc set inside     rest' <- nestToDoc set rest-    Ok $ DocContent (start : attrs' ++ seal : content)+    Ok $ DocContent (start : attrs'' ++ seal : content)        : inside' ++ end ++ rest' nestToDoc set (Nest (LineContent content) inside:rest) = do     inside' <- nestToDoc set inside@@ -289,6 +311,8 @@ compressDoc [] = [] compressDoc (DocForall d i doc:rest) =     DocForall d i (compressDoc doc) : compressDoc rest+compressDoc (DocMaybe d i doc:rest) =+    DocMaybe d i (compressDoc doc) : compressDoc rest compressDoc (DocCond x y:rest) =     DocCond (map (second compressDoc) x) (compressDoc `fmap` y)     : compressDoc rest

@@ -49,6 +49,15 @@     let dos = LamE [VarP ident'] $ DoE $ 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+    ident' <- newName name+    let vars'' = ([ident], VarE ident') : vars'+    (_, _, inside') <- foldM docToStmt (vars'', arg, id) inside+    let dos = LamE [VarP ident'] $ DoE $ 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     final' <- case final of

@@ -1,5 +1,5 @@ name:            hamlet-version:         0.0.1+version:         0.0.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>

@@ -45,6 +45,14 @@     , 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 monad" caseNothingMonad+    , testCase "nothing chain " caseNothingChain+    , testCase "just" caseJust+    , testCase "just monad" caseJustMonad+    , testCase "just chain " caseJustChain     ]  data Url = Home@@ -66,6 +74,10 @@     , mfalse :: m Bool     , list :: [Arg m url]     , enum :: Enumerator (Arg m url) m+    , nothing :: Maybe HtmlContent+    , mnothing :: m (Maybe HtmlContent)+    , just :: Maybe HtmlContent+    , mjust :: m (Maybe HtmlContent)     }  arg :: Monad m => Arg m url@@ -84,6 +96,10 @@     , mfalse = return False     , list = [arg, arg, arg]     , enum = fromList $ list arg+    , nothing = Nothing+    , mnothing = return Nothing+    , just = Just $ Unencoded $ pack "just"+    , mjust = return $ Just $ Unencoded $ pack "just"     }  helper :: String -> (Arg IO Url -> Hamlet Url IO ()) -> Assertion@@ -237,3 +253,46 @@ 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 = helper "" [$hamlet|+$maybe nothing n+    nothing+|]++caseNothingMonad :: Assertion+caseNothingMonad = helper "" [$hamlet|+$maybe *mnothing n+    nothing $n$+|]++caseNothingChain :: Assertion+caseNothingChain = helper "" [$hamlet|+$maybe getArg.*getArgM.getArg.*mnothing n+    nothing $n$+|]++caseJust :: Assertion+caseJust = helper "it's just" [$hamlet|+$maybe just n+    it's $n$+|]++caseJustMonad :: Assertion+caseJustMonad = helper "it's just" [$hamlet|+$maybe *mjust n+    it's $n$+|]++caseJustChain :: Assertion+caseJustChain = helper "it's just" [$hamlet|+$maybe getArg.*getArgM.getArg.*mjust n+    it's $n$+|]