packages feed

hamlet 0.4.1 → 0.4.2

raw patch · 6 files changed

+291/−17 lines, 6 filesdep +failurePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: failure

API changes (from Hackage documentation)

+ Text.Hamlet: HDBool :: Bool -> HamletData url
+ Text.Hamlet: HDHtml :: (Html ()) -> HamletData url
+ Text.Hamlet: HDList :: [HamletData url] -> HamletData url
+ Text.Hamlet: HDMap :: [(String, HamletData url)] -> HamletData url
+ Text.Hamlet: HDMaybe :: (Maybe (HamletData url)) -> HamletData url
+ Text.Hamlet: HDTemplate :: HamletRT -> HamletData url
+ Text.Hamlet: HDUrl :: url -> HamletData url
+ Text.Hamlet: HDUrlParams :: url -> [(String, String)] -> HamletData url
+ Text.Hamlet: HamletParseException :: String -> HamletException
+ Text.Hamlet: HamletRenderException :: String -> HamletException
+ Text.Hamlet: HamletUnsupportedDocException :: Doc -> HamletException
+ Text.Hamlet: data HamletData url
+ Text.Hamlet: data HamletException
+ Text.Hamlet: data HamletRT
+ Text.Hamlet: hamlet' :: QuasiQuoter
+ Text.Hamlet: hamletCloseNewline :: HamletSettings -> Bool
+ Text.Hamlet: hamletDebug :: QuasiQuoter
+ Text.Hamlet: parseHamletRT :: (Failure HamletException m) => HamletSettings -> String -> m HamletRT
+ Text.Hamlet: renderHamletRT :: (Failure HamletException m) => HamletRT -> HamletData url -> (url -> String) -> m (Html ())
+ Text.Hamlet: xhamlet' :: QuasiQuoter
+ Text.Hamlet: xhtmlHamletSettings :: HamletSettings
+ Text.Hamlet.RT: HDBool :: Bool -> HamletData url
+ Text.Hamlet.RT: HDHtml :: (Html ()) -> HamletData url
+ Text.Hamlet.RT: HDList :: [HamletData url] -> HamletData url
+ Text.Hamlet.RT: HDMap :: [(String, HamletData url)] -> HamletData url
+ Text.Hamlet.RT: HDMaybe :: (Maybe (HamletData url)) -> HamletData url
+ Text.Hamlet.RT: HDTemplate :: HamletRT -> HamletData url
+ Text.Hamlet.RT: HDUrl :: url -> HamletData url
+ Text.Hamlet.RT: HDUrlParams :: url -> [(String, String)] -> HamletData url
+ Text.Hamlet.RT: HamletParseException :: String -> HamletException
+ Text.Hamlet.RT: HamletRT :: [SimpleDoc] -> HamletRT
+ Text.Hamlet.RT: HamletRenderException :: String -> HamletException
+ Text.Hamlet.RT: HamletUnsupportedDocException :: Doc -> HamletException
+ Text.Hamlet.RT: SDCond :: [([String], [SimpleDoc])] -> [SimpleDoc] -> SimpleDoc
+ Text.Hamlet.RT: SDForall :: [String] -> String -> [SimpleDoc] -> SimpleDoc
+ Text.Hamlet.RT: SDMaybe :: [String] -> String -> [SimpleDoc] -> [SimpleDoc] -> SimpleDoc
+ Text.Hamlet.RT: SDRaw :: String -> SimpleDoc
+ Text.Hamlet.RT: SDTemplate :: [String] -> SimpleDoc
+ Text.Hamlet.RT: SDUrl :: Bool -> [String] -> SimpleDoc
+ Text.Hamlet.RT: SDVar :: [String] -> SimpleDoc
+ Text.Hamlet.RT: data HamletData url
+ Text.Hamlet.RT: data HamletException
+ Text.Hamlet.RT: data SimpleDoc
+ Text.Hamlet.RT: instance Exception HamletException
+ Text.Hamlet.RT: instance Show HamletException
+ Text.Hamlet.RT: instance Typeable HamletException
+ Text.Hamlet.RT: newtype HamletRT
+ Text.Hamlet.RT: parseHamletRT :: (Failure HamletException m) => HamletSettings -> String -> m HamletRT
+ Text.Hamlet.RT: renderHamletRT :: (Failure HamletException m) => HamletRT -> HamletData url -> (url -> String) -> m (Html ())
- Text.Hamlet: HamletSettings :: String -> Bool -> HamletSettings
+ Text.Hamlet: HamletSettings :: String -> Bool -> Bool -> HamletSettings

Files

Text/Hamlet.hs view
@@ -2,6 +2,9 @@     ( -- * Basic quasiquoters       hamlet     , xhamlet+    , hamlet'+    , xhamlet'+    , hamletDebug       -- * Load from external file     , hamletFile     , xhamletFile@@ -10,6 +13,7 @@     , hamletFileWithSettings     , HamletSettings (..)     , defaultHamletSettings+    , xhtmlHamletSettings       -- * Datatypes     , Html     , Hamlet@@ -20,10 +24,17 @@     , string     , unsafeByteString     , cdata+      -- * Runtime Hamlet+    , HamletRT+    , HamletData (..)+    , HamletException (..)+    , parseHamletRT+    , renderHamletRT     ) where  import Text.Hamlet.Parse import Text.Hamlet.Quasi+import Text.Hamlet.RT import Text.Blaze import qualified Data.ByteString.Lazy as L import Data.Monoid (mappend)
Text/Hamlet/Parse.hs view
@@ -8,6 +8,8 @@     , parseDoc     , HamletSettings (..)     , defaultHamletSettings+    , xhtmlHamletSettings+    , debugHamletSettings     )     where @@ -265,6 +267,8 @@                  _ -> DocContent $ ContentRaw ">"         start = DocContent $ ContentRaw $ "<" ++ tn         attrs'' = concatMap attrToContent attrs'+        newline' = DocContent $ ContentRaw+                 $ if hamletCloseNewline set then "\n" else ""     inside' <- nestToDoc set inside     rest' <- nestToDoc set rest     Ok $ start@@ -273,6 +277,7 @@        : map DocContent content       ++ inside'       ++ end+       : newline'        : rest' nestToDoc set (Nest (LineContent content) inside:rest) = do     inside' <- nestToDoc set inside@@ -326,11 +331,24 @@       -- | 'True' means to close empty tags (eg, img) with a trailing slash, ie       -- XML-style empty tags. 'False' uses HTML-style.     , hamletCloseEmpties :: Bool+      -- | Should we put a newline after closing a tag?+    , hamletCloseNewline :: Bool     }  -- | Defaults settings: HTML5 doctype and HTML-style empty tags. defaultHamletSettings :: HamletSettings-defaultHamletSettings = HamletSettings "<!DOCTYPE html>" False+defaultHamletSettings = HamletSettings "<!DOCTYPE html>" False False++xhtmlHamletSettings :: HamletSettings+xhtmlHamletSettings =+    HamletSettings doctype True False+  where+    doctype =+      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" " +++      "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"++debugHamletSettings :: HamletSettings+debugHamletSettings = HamletSettings "<!DOCTYPE html>" False True  data CloseStyle = NoClose | CloseInside | CloseSeparate
Text/Hamlet/Quasi.hs view
@@ -4,10 +4,15 @@ module Text.Hamlet.Quasi     ( hamlet     , xhamlet+    , hamlet'+    , xhamlet'+    , hamletDebug     , hamletWithSettings+    , hamletWithSettings'     , hamletFile     , xhamletFile     , hamletFileWithSettings+    , showParams     ) where  import Text.Hamlet.Parse@@ -101,16 +106,25 @@     let d' = deref scope d     return (d' `AppE` render) +-- | Calls 'hamletWithSettings'' with 'defaultHamletSettings'.+hamlet' :: QuasiQuoter+hamlet' = hamletWithSettings' defaultHamletSettings++-- | Calls 'hamletWithSettings'' using XHTML 1.0 Strict settings.+xhamlet' :: QuasiQuoter+xhamlet' = hamletWithSettings' xhtmlHamletSettings+ -- | Calls 'hamletWithSettings' with 'defaultHamletSettings'. hamlet :: QuasiQuoter hamlet = hamletWithSettings defaultHamletSettings +-- | Calls 'hamletWithSettings' with 'debugHamletSettings'.+hamletDebug :: QuasiQuoter+hamletDebug = hamletWithSettings debugHamletSettings+ -- | Calls 'hamletWithSettings' using XHTML 1.0 Strict settings. xhamlet :: QuasiQuoter-xhamlet = hamletWithSettings $ HamletSettings doctype True where-    doctype =-      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" " ++-      "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"+xhamlet = hamletWithSettings xhtmlHamletSettings  -- | A quasi-quoter that converts Hamlet syntax into a function of form: --@@ -122,6 +136,17 @@     QuasiQuoter (hamletFromString set)       $ error "Cannot quasi-quote Hamlet to patterns" +-- | A quasi-quoter that converts Hamlet syntax into a 'Html' ().+--+-- Please see accompanying documentation for a description of Hamlet syntax.+hamletWithSettings' :: HamletSettings -> QuasiQuoter+hamletWithSettings' set =+    QuasiQuoter (\s -> do+        x <- hamletFromString set s+        id' <- [|id|]+        return $ x `AppE` id')+    $ error "Cannot quasi-quote Hamlet to patterns"+ hamletFromString :: HamletSettings -> String -> Q Exp hamletFromString set s = do   case parseDoc set s of@@ -142,12 +167,7 @@  -- | Calls 'hamletFileWithSettings' using XHTML 1.0 Strict settings. xhamletFile :: FilePath -> Q Exp-xhamletFile =-    hamletFileWithSettings $ HamletSettings doctype True-  where-    doctype =-      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" " ++-      "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"+xhamletFile = hamletFileWithSettings xhtmlHamletSettings  deref :: Scope -> Deref -> Exp deref scope (DerefBranch x y) =@@ -197,8 +217,11 @@ outputUrlParams render (u, params) = mappend     (outputUrl render u)     (string $ showParams params)++showParams :: [(String, String)] -> String+showParams z =+    '?' : intercalate "&" (map go z)   where-    showParams x = '?' : intercalate "&" (map go x)     go (x, y) = go' x ++ '=' : go' y     go' = concatMap encodeUrlChar
+ Text/Hamlet/RT.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+-- | Most everything exported here is exported also by "Text.Hamlet". The+-- exceptions to that rule should not be necessary for normal usage.+module Text.Hamlet.RT+    ( -- * Public API+      HamletRT (..)+    , HamletData (..)+    , HamletException (..)+    , parseHamletRT+    , renderHamletRT+    , SimpleDoc (..)+    ) where++import Data.Monoid (mconcat)+import Control.Monad (liftM, forM)+import Control.Exception (Exception)+import Data.Typeable (Typeable)+import Control.Failure+import Text.Blaze+import Text.Hamlet.Parse+import Text.Hamlet.Quasi (showParams)+import Data.List (intercalate)++data HamletData url = HDHtml (Html ())+                    | HDUrl url+                    | HDUrlParams url [(String, String)]+                    | HDTemplate HamletRT+                    | HDBool Bool+                    | HDMaybe (Maybe (HamletData url))+                    | HDList [HamletData url]+                    | HDMap [(String, HamletData url)]++data SimpleDoc = SDRaw String+               | SDVar [String]+               | SDUrl Bool [String]+               | SDTemplate [String]+               | SDForall [String] String [SimpleDoc]+               | SDMaybe [String] String [SimpleDoc] [SimpleDoc]+               | SDCond [([String], [SimpleDoc])] [SimpleDoc]++newtype HamletRT = HamletRT [SimpleDoc]++data HamletException = HamletParseException String+                     | HamletUnsupportedDocException Doc+                     | HamletRenderException String+    deriving (Show, Typeable)+instance Exception HamletException++parseHamletRT :: Failure HamletException m+              => HamletSettings -> String -> m HamletRT+parseHamletRT set s =+    case parseDoc set s of+        Error s' -> failure $ HamletParseException s'+        Ok x -> liftM HamletRT $ mapM convert x+  where+    convert x@(DocForall deref (Ident ident) docs) = do+        deref' <- flattenDeref x deref+        docs' <- mapM convert docs+        return $ SDForall deref' ident docs'+    convert x@(DocMaybe deref (Ident ident) jdocs ndocs) = do+        deref' <- flattenDeref x deref+        jdocs' <- mapM convert jdocs+        ndocs' <- maybe (return []) (mapM convert) ndocs+        return $ SDMaybe deref' ident jdocs' ndocs'+    convert (DocContent (ContentRaw s')) = return $ SDRaw s'+    convert x@(DocContent (ContentVar deref)) = do+        y <- flattenDeref x deref+        return $ SDVar y+    convert x@(DocContent (ContentUrl p deref)) = do+        y <- flattenDeref x deref+        return $ SDUrl p y+    convert x@(DocContent (ContentEmbed deref)) = do+        y <- flattenDeref x deref+        return $ SDTemplate y+    convert x@(DocCond conds els) = do+        conds' <- mapM go conds+        els' <- maybe (return []) (mapM convert) els+        return $ SDCond conds' els'+      where+        go (deref, docs') = do+            deref' <- flattenDeref x deref+            docs'' <- mapM convert docs'+            return (deref', docs'')+    flattenDeref _ (DerefLeaf (Ident x)) = return [x]+    flattenDeref orig (DerefBranch (DerefLeaf (Ident x)) y) = do+        y' <- flattenDeref orig y+        return $ x : y'+    flattenDeref orig _ = failure $ HamletUnsupportedDocException orig++renderHamletRT :: Failure HamletException m+               => HamletRT+               -> HamletData url+               -> (url -> String)+               -> m (Html ())+renderHamletRT (HamletRT docs) (HDMap scope0) renderUrl =+    liftM mconcat $ mapM (go scope0) docs+  where+    go _ (SDRaw s) = return $ preEscapedString s+    go scope (SDVar n) = do+        v <- lookup' n n $ HDMap scope+        case v of+            HDHtml h -> return h+            _ -> fa $ intercalate "." n ++ ": expected HDHtml"+    go scope (SDUrl p n) = do+        v <- lookup' n n $ HDMap scope+        case (p, v) of+            (False, HDUrl u) -> return $ preEscapedString $ renderUrl u+            (True, HDUrlParams u q) ->+                return $ preEscapedString $ renderUrl u ++ showParams q+            (False, _) -> fa $ intercalate "." n ++ ": expected HDUrl"+            (True, _) -> fa $ intercalate "." n ++ ": expected HDUrlParams"+    go scope (SDTemplate n) = do+        v <- lookup' n n $ HDMap scope+        case v of+            HDTemplate h -> renderHamletRT h (HDMap scope) renderUrl+            _ -> fa $ intercalate "." n ++ ": expected HDTemplate"+    go scope (SDForall n ident docs') = do+        v <- lookup' n n $ HDMap scope+        case v of+            HDList os -> do+                liftM mconcat $ forM os $ \o -> do+                    let scope' = HDMap $ (ident, o) : scope+                    renderHamletRT (HamletRT docs') scope' renderUrl+            _ -> fa $ intercalate "." n ++ ": expected HDList"+    go scope (SDMaybe n ident jdocs ndocs) = do+        v <- lookup' n n $ HDMap scope+        (scope', docs') <-+            case v of+                HDMaybe Nothing -> return (scope, ndocs)+                HDMaybe (Just o) -> return ((ident, o) : scope, jdocs)+                _ -> fa $ intercalate "." n ++ ": expected HDMaybe"+        renderHamletRT (HamletRT docs') (HDMap scope') renderUrl+    go scope (SDCond [] docs') =+        renderHamletRT (HamletRT docs') (HDMap scope) renderUrl+    go scope (SDCond ((b, docs'):cs) els) = do+        v <- lookup' b b $ HDMap scope+        case v of+            HDBool True ->+                renderHamletRT (HamletRT docs') (HDMap scope) renderUrl+            HDBool False -> go scope (SDCond cs els)+            _ -> fa $ intercalate "." b ++ ": expected HDBool"+    lookup' _ [] x = return x+    lookup' orig (n:ns) (HDMap m) =+        case lookup n m of+            Nothing -> fa $ intercalate "." orig ++ " not found"+            Just o -> lookup' orig ns o+    lookup' orig _ _ = fa $ intercalate "." orig ++ ": unexpected type"+    fa = failure . HamletRenderException+renderHamletRT _ _ _ =+    failure $ HamletRenderException "renderHamletRT must be given a HDMap"
hamlet.cabal view
@@ -1,5 +1,5 @@ name:            hamlet-version:         0.4.1+version:         0.4.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -44,8 +44,10 @@                      utf8-string >= 0.3.4 && < 0.4,                      template-haskell,                      blaze-html >= 0.1.1 && < 0.2,-                     parsec >= 2 && < 4+                     parsec >= 2 && < 4,+                     failure >= 0.1.0 && < 0.2     exposed-modules: Text.Hamlet+                     Text.Hamlet.RT     other-modules:   Text.Hamlet.Parse                      Text.Hamlet.Quasi     ghc-options:     -Wall
runtests.hs view
@@ -56,6 +56,9 @@     , testCase "currency symbols" caseCurrency
     , testCase "external" caseExternal
     , testCase "parens" caseParens
+    , testCase "hamlet' and xhamlet'" caseHamlet'
+    , testCase "hamletDebug" caseHamletDebug
+    , testCase "hamlet runtime" caseHamletRT
     ]
 
 data Url = Home | Sub SubUrl
@@ -354,7 +357,7 @@   where
     users = ["1", "2"]
     name = "foo"
-    val = 5
+    val = 5 :: Int
     isBoolBlank _ = True
     isBoolTrue _ = False
     isBoolFalse _ = False
@@ -384,8 +387,74 @@     helper "xy" [$hamlet|$(plus x) y$|]
     helper "xy" [$hamlet|$(plus.x).y$|]
     helper "xxy" [$hamlet|$(plus (plus x).x).y$|]
-    let list = ["1", "2", "3"]
+    let alist = ["1", "2", "3"]
     helper "123" [$hamlet|
-$forall (id id.id id.list) x
+$forall (id id.id id.alist) x
     $x$
 |]
+
+helper' :: String -> Html ()-> Assertion
+helper' res h = do
+    let x = renderHtml h
+    res @=? toString x
+
+caseHamlet' :: Assertion
+caseHamlet' = do
+    helper' "foo" [$hamlet'|foo|]
+    helper' "foo" [$xhamlet'|foo|]
+
+caseHamletDebug :: Assertion
+caseHamletDebug = do
+    helper "<p>foo</p>\n<p>bar</p>\n" [$hamletDebug|
+%p foo
+%p bar
+|]
+
+caseHamletRT :: Assertion
+caseHamletRT = do
+    temp <- parseHamletRT defaultHamletSettings "$var$"
+    rt <- parseHamletRT defaultHamletSettings $
+            unlines
+                [ "$foo.bar.baz$ bin $"
+                , "$forall list l"
+                , "  $l$"
+                , "$maybe just j"
+                , "  $j$"
+                , "$maybe nothing n"
+                , "$nothing"
+                , "  nothing"
+                , "^template^"
+                , "@url@"
+                , "$if false"
+                , "$elseif false"
+                , "$elseif true"
+                , "  a"
+                , "$if false"
+                , "$else"
+                , "  b"
+                , "@?urlp@"
+                ]
+    let scope =
+            HDMap
+                [ ("foo", HDMap
+                    [ ("bar", HDMap
+                        [ ("baz", HDHtml $ preEscapedString "foo<bar>baz")
+                        ])
+                    ])
+                , ("list", HDList
+                    [ HDHtml $ string "1"
+                    , HDHtml $ string "2"
+                    , HDHtml $ string "3"
+                    ])
+                , ("just", HDMaybe $ Just $ HDHtml $ string "just")
+                , ("nothing", HDMaybe Nothing)
+                , ("template", HDTemplate temp)
+                , ("var", HDHtml $ string "var")
+                , ("url", HDUrl Home)
+                , ("urlp", HDUrlParams Home [("foo", "bar")])
+                , ("true", HDBool True)
+                , ("false", HDBool False)
+                ]
+    rend <- renderHamletRT rt scope render
+    toString (renderHtml rend) @?=
+        "foo<bar>baz bin 123justnothingvarurlaburl?foo=bar"