hamlet 0.10.2 → 0.10.3

raw patch · 3 files changed

+180/−2 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Text/Hamlet.hs +1/−0
• Text/Hamlet/RT.hs +176/−0
• hamlet.cabal +3/−2

@@ -24,6 +24,7 @@     , ihamlet     , ihamletFile       -- * Internal, for making more+    , HamletSettings     , hamletWithSettings     , hamletFileWithSettings     , defaultHamletSettings

@@ -0,0 +1,176 @@+{-# 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 (..)+    , HamletMap+    , HamletException (..)+    , parseHamletRT+    , renderHamletRT+    , renderHamletRT'+    , SimpleDoc (..)+    ) where++import Text.Shakespeare.Base+import Data.Monoid (mconcat)+import Control.Monad (liftM, forM)+import Control.Exception (Exception)+import Data.Typeable (Typeable)+import Control.Failure+import Text.Hamlet.Parse+import Data.List (intercalate)+import Text.Blaze (preEscapedString, preEscapedText, Html)+import Data.Text (Text)++type HamletMap url = [([String], HamletData url)]++data HamletData url+    = HDHtml Html+    | HDUrl url+    | HDUrlParams url [(Text, Text)]+    | HDTemplate HamletRT+    | HDBool Bool+    | HDMaybe (Maybe (HamletMap url))+    | HDList [HamletMap url]++-- FIXME switch to Text?+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 (DocContent ContentMsg{}) =+        error "Runtime hamlet does not currently support message interpolation"+    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'')+    convert DocWith{} = error "Runtime hamlet does not currently support $with"++renderHamletRT :: Failure HamletException m+               => HamletRT+               -> HamletMap url+               -> (url -> [(Text, Text)] -> Text)+               -> m Html+renderHamletRT = renderHamletRT' False++renderHamletRT' :: Failure HamletException m+                => Bool+                -> HamletRT+                -> HamletMap url+                -> (url -> [(Text, Text)] -> Text)+                -> m Html+renderHamletRT' tempAsHtml (HamletRT docs) scope0 renderUrl =+    liftM mconcat $ mapM (go scope0) docs+  where+    go _ (SDRaw s) = return $ preEscapedString s+    go scope (SDVar n) = do+        v <- lookup' n n scope+        case v of+            HDHtml h -> return h+            _ -> fa $ showName n ++ ": expected HDHtml"+    go scope (SDUrl p n) = do+        v <- lookup' n n scope+        case (p, v) of+            (False, HDUrl u) -> return $ preEscapedText $ renderUrl u []+            (True, HDUrlParams u q) ->+                return $ preEscapedText $ renderUrl u q+            (False, _) -> fa $ showName n ++ ": expected HDUrl"+            (True, _) -> fa $ showName n ++ ": expected HDUrlParams"+    go scope (SDTemplate n) = do+        v <- lookup' n n scope+        case (tempAsHtml, v) of+            (False, HDTemplate h) -> renderHamletRT' tempAsHtml h scope renderUrl+            (False, _) -> fa $ showName n ++ ": expected HDTemplate"+            (True, HDHtml h) -> return h+            (True, _) -> fa $ showName n ++ ": expected HDHtml"+    go scope (SDForall n ident docs') = do+        v <- lookup' n n scope+        case v of+            HDList os ->+                liftM mconcat $ forM os $ \o -> do+                    let scope' = map (\(x, y) -> (ident : x, y)) o ++ scope+                    renderHamletRT' tempAsHtml (HamletRT docs') scope' renderUrl+            _ -> fa $ showName n ++ ": expected HDList"+    go scope (SDMaybe n ident jdocs ndocs) = do+        v <- lookup' n n scope+        (scope', docs') <-+            case v of+                HDMaybe Nothing -> return (scope, ndocs)+                HDMaybe (Just o) -> do+                    let scope' = map (\(x, y) -> (ident : x, y)) o ++ scope+                    return (scope', jdocs)+                _ -> fa $ showName n ++ ": expected HDMaybe"+        renderHamletRT' tempAsHtml (HamletRT docs') scope' renderUrl+    go scope (SDCond [] docs') =+        renderHamletRT' tempAsHtml (HamletRT docs') scope renderUrl+    go scope (SDCond ((b, docs'):cs) els) = do+        v <- lookup' b b scope+        case v of+            HDBool True ->+                renderHamletRT' tempAsHtml (HamletRT docs') scope renderUrl+            HDBool False -> go scope (SDCond cs els)+            _ -> fa $ showName b ++ ": expected HDBool"+    lookup' :: Failure HamletException m+            => [String] -> [String] -> HamletMap url -> m (HamletData url)+    lookup' orig k m =+        case lookup k m of+            Nothing -> fa $ showName orig ++ ": not found"+            Just x -> return x++fa :: Failure HamletException m => String -> m a+fa = failure . HamletRenderException++showName :: [String] -> String+showName = intercalate "." . reverse++flattenDeref' :: Failure HamletException f => Doc -> Deref -> f [String]+flattenDeref' orig deref =+    case flattenDeref deref of+        Nothing -> failure $ HamletUnsupportedDocException orig+        Just x -> return x

@@ -1,5 +1,5 @@ name:            hamlet-version:         0.10.2+version:         0.10.3 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -8,7 +8,7 @@ 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/book/hamlet/> for more details.     .-    Here is a quick overview of hamlet html. Due to haddock escaping issues, we can't properly show variable insertion, but we are still going to show some conditionals. Please see http://docs.yesodweb.com/book/templates for a thorough description+    Here is a quick overview of hamlet html. Due to haddock escaping issues, we can't properly show variable insertion, but we are still going to show some conditionals. Please see http://www.yesodweb.com/book/templates for a thorough description     .     > !!!     > <html>@@ -51,6 +51,7 @@                    , blaze-builder    >= 0.2     && < 0.4                    , process          >= 1.0     && < 1.2     exposed-modules: Text.Hamlet+                     Text.Hamlet.RT     other-modules:   Text.Hamlet.Parse     ghc-options:     -Wall