hamlet 0.5.0.2 → 0.5.1

raw patch · 6 files changed

+115/−70 lines, 6 filesdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• Text/Cassius.hs +2/−6
• Text/Hamlet.hs +1/−0
• Text/Hamlet/Quasi.hs +95/−50
• Text/Julius.hs +1/−4
• hamlet.cabal +10/−10
• runtests.hs +6/−0

@@ -268,9 +268,8 @@  cassiusMixin :: QuasiQuoter cassiusMixin =-    QuasiQuoter e p+    QuasiQuoter { quoteExp = e }   where-    p = error "cassiusMixin quasi-quoter for patterns does not exist"     e s = do         let a = either (error . show) id               $ parse parseLines s s@@ -288,10 +287,7 @@ newtype CassiusMixin url = CassiusMixin { unCassiusMixin :: Cassius url }  cassius :: QuasiQuoter-cassius =-    QuasiQuoter cassiusFromString p-  where-    p = error "cassius quasi-quoter for patterns does not exist"+cassius = QuasiQuoter { quoteExp = cassiusFromString }  cassiusFromString :: String -> Q Exp cassiusFromString s = do

@@ -21,6 +21,7 @@     , Hamlet       -- * Typeclass     , ToHtml (..)+    , HamletValue (..)       -- * Construction/rendering     , renderHamlet     , renderHtml

@@ -1,7 +1,10 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE EmptyDataDecls #-} module Text.Hamlet.Quasi     ( hamlet     , xhamlet@@ -14,6 +17,7 @@     , xhamletFile     , hamletFileWithSettings     , ToHtml (..)+    , HamletValue (..)     , varName     , Html (..)     , Hamlet@@ -44,47 +48,45 @@  type Scope = [(Ident, Exp)] -docsToExp :: Exp -> Scope -> [Doc] -> Q Exp-docsToExp render scope docs = do-    exps <- mapM (docToExp render scope) docs-    me <- [|mempty|]-    ma <- [|mappend|]-    let ma' x y = InfixE (Just x) ma $ Just y-    return $-        case exps of-            [] -> me-            [x] -> x-            _ -> foldr1 ma' exps+docsToExp :: Scope -> [Doc] -> Q Exp+docsToExp scope docs = do+    exps <- mapM (docToExp scope) docs+    let stmts = map (BindS $ TupP []) exps+    rnull <- [|return ()|]+    return $ case exps of+        [] -> rnull+        [x] -> x+        _ -> DoE $ stmts ++ [NoBindS rnull] -docToExp :: Exp -> Scope -> Doc -> Q Exp-docToExp render scope (DocForall list ident@(Ident name) inside) = do+docToExp :: Scope -> Doc -> Q Exp+docToExp scope (DocForall list ident@(Ident name) inside) = do     let list' = deref scope list     name' <- newName name     let scope' = (ident, VarE name') : scope-    mh <- [|\a -> mconcat . map a|]-    inside' <- docsToExp render scope' inside+    mh <- [|mapM_|]+    inside' <- docsToExp scope' inside     let lam = LamE [VarP name'] inside'     return $ mh `AppE` lam `AppE` list'-docToExp render scope (DocMaybe val ident@(Ident name) inside mno) = do+docToExp scope (DocMaybe val ident@(Ident name) inside mno) = do     let val' = deref scope val     name' <- newName name     let scope' = (ident, VarE name') : scope-    inside' <- docsToExp render scope' inside+    inside' <- docsToExp scope' inside     let inside'' = LamE [VarP name'] inside'     ninside' <- case mno of                     Nothing -> [|Nothing|]                     Just no -> do-                        no' <- docsToExp render scope no+                        no' <- docsToExp scope no                         j <- [|Just|]                         return $ j `AppE` no'     mh <- [|maybeH|]     return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'-docToExp render scope (DocCond conds final) = do+docToExp scope (DocCond conds final) = do     conds' <- mapM go conds     final' <- case final of                 Nothing -> [|Nothing|]                 Just f -> do-                    f' <- docsToExp render scope f+                    f' <- docsToExp scope f                     j <- [|Just|]                     return $ j `AppE` f'     ch <- [|condH|]@@ -93,35 +95,38 @@     go :: (Deref, [Doc]) -> Q Exp     go (d, docs) = do         let d' = deref scope d-        docs' <- docsToExp render scope docs+        docs' <- docsToExp scope docs         return $ TupE [d', docs']-docToExp render v (DocContent c) = contentToExp render v c+docToExp v (DocContent c) = contentToExp v c -contentToExp :: Exp -> Scope -> Content -> Q Exp-contentToExp _ _ (ContentRaw s) = do-    os <- [|Html . fromByteString . S8.pack|]+contentToExp :: Scope -> Content -> Q Exp+contentToExp _ (ContentRaw s) = do+    os <- [|htmlToHamletMonad . Html . fromByteString . S8.pack|]     let s' = LitE $ StringL $ S8.unpack $ BSU.fromString s     return $ os `AppE` s'-contentToExp _ scope (ContentVar d) = do-    str <- [|toHtml|]+contentToExp scope (ContentVar d) = do+    str <- [|htmlToHamletMonad . toHtml|]     return $ str `AppE` deref scope d-contentToExp render scope (ContentUrl hasParams d) = do+contentToExp scope (ContentUrl hasParams d) = do     ou <- if hasParams-            then [|\r (u, p) -> Html $ fromHtmlEscapedString $ r u p|]-            else [|\r u -> Html $ fromHtmlEscapedString $ r u []|]+            then [|\(u, p) -> urlToHamletMonad u p|]+            else [|\u -> urlToHamletMonad u []|]     let d' = deref scope d-    return $ ou `AppE` render `AppE` d'-contentToExp render scope (ContentEmbed d) = do+    return $ ou `AppE` d'+contentToExp scope (ContentEmbed d) = do     let d' = deref scope d-    return (d' `AppE` render)+    fhv <- [|fromHamletValue|]+    return $ fhv `AppE` d'  -- | Calls 'hamletWithSettings'' with 'defaultHamletSettings'. hamlet' :: QuasiQuoter hamlet' = hamletWithSettings' defaultHamletSettings+{-# DEPRECATED hamlet' "Use hamlet directly now" #-}  -- | Calls 'hamletWithSettings'' using XHTML 1.0 Strict settings. xhamlet' :: QuasiQuoter xhamlet' = hamletWithSettings' xhtmlHamletSettings+{-# DEPRECATED xhamlet' "Use xhamlet directly now" #-}  -- | Calls 'hamletWithSettings' with 'defaultHamletSettings'. hamlet :: QuasiQuoter@@ -142,28 +147,30 @@ -- Please see accompanying documentation for a description of Hamlet syntax. hamletWithSettings :: HamletSettings -> QuasiQuoter hamletWithSettings set =-    QuasiQuoter (hamletFromString set)-      $ error "Cannot quasi-quote Hamlet to patterns"+    QuasiQuoter+        { quoteExp = hamletFromString set+        }  -- | 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"+    QuasiQuoter+        { quoteExp = \s -> do+            x <- hamletFromString set s+            id' <- [|(\y _ -> y) :: String -> [(String, String)] -> String|]+            return $ x `AppE` id'+        }  hamletFromString :: HamletSettings -> String -> Q Exp hamletFromString set s = do-  case parseDoc set s of-    Error s' -> error s'-    Ok d -> do-        render <- newName "_render"-        func <- docsToExp (VarE render) [] d-        return $ LamE [VarP render] func+    case parseDoc set s of+        Error s' -> error s'+        Ok d -> do+            thv <- [|toHamletValue|]+            exp' <- docsToExp [] d+            return $ thv `AppE` exp'  hamletFileWithSettings :: HamletSettings -> FilePath -> Q Exp hamletFileWithSettings set fp = do@@ -203,16 +210,16 @@ -- a true exists, then the corresponding right action is performed. Only the -- first is performed. In there are no true values, then the second argument is -- performed, if supplied.-condH :: [(Bool, Html)] -> Maybe Html -> Html-condH [] Nothing = mempty+condH :: Monad m => [(Bool, m ())] -> Maybe (m ()) -> m ()+condH [] Nothing = return () condH [] (Just x) = x condH ((True, y):_) _ = y condH ((False, _):rest) z = condH rest z  -- | Runs the second argument with the value in the first, if available. -- Otherwise, runs the third argument, if available.-maybeH :: Maybe v -> (v -> Html) -> Maybe Html -> Html-maybeH Nothing _ Nothing = mempty+maybeH :: Monad m => Maybe v -> (v -> m ()) -> Maybe (m ()) -> m ()+maybeH Nothing _ Nothing = return () maybeH Nothing _ (Just x) = x maybeH (Just v) f _ = f v @@ -225,3 +232,41 @@  -- | An function generating an 'Html' given a URL-rendering function. type Hamlet url = (url -> [(String, String)] -> String) -> Html++class Monad (HamletMonad a) => HamletValue a where+    data HamletMonad a :: * -> *+    type HamletUrl a+    toHamletValue :: HamletMonad a () -> a+    htmlToHamletMonad :: Html -> HamletMonad a ()+    urlToHamletMonad :: HamletUrl a -> [(String, String)] -> HamletMonad a ()+    fromHamletValue :: a -> HamletMonad a ()++type Render url = url -> [(String, String)] -> String+instance HamletValue (Hamlet url) where+    newtype HamletMonad (Hamlet url) a =+        HMonad { runHMonad :: Render url -> (Html, a) }+    type HamletUrl (Hamlet url) = url+    toHamletValue = fmap fst . runHMonad+    htmlToHamletMonad x = HMonad $ const (x, ())+    urlToHamletMonad url pairs = HMonad $ \r ->+        (Html $ fromHtmlEscapedString $ r url pairs, ())+    fromHamletValue f = HMonad $ \r -> (f r, ())+instance Monad (HamletMonad (Hamlet url)) where+    return x = HMonad $ const (mempty, x)+    (HMonad f) >>= g = HMonad $ \render ->+        let (html1, x) = f render+            (html2, y) = runHMonad (g x) render+         in (html1 `mappend` html2, y)+data NoConstructor+instance HamletValue Html where+    newtype HamletMonad Html a = HtmlMonad { runHtmlMonad :: (Html, a) }+    type HamletUrl Html = NoConstructor+    toHamletValue = fst . runHtmlMonad+    htmlToHamletMonad x = HtmlMonad (x, ())+    urlToHamletMonad = error "urlToHamletMonad on NoConstructor"+    fromHamletValue h = HtmlMonad (h, ())+instance Monad (HamletMonad Html) where+    return x = HtmlMonad (mempty, x)+    HtmlMonad (html1, x) >>= g = HtmlMonad $+        let HtmlMonad (html2, y) = g x+         in (html1 `mappend` html2, y)

@@ -118,10 +118,7 @@     return $ LamE [VarP r] d  julius :: QuasiQuoter-julius =-    QuasiQuoter juliusFromString p-  where-    p = error "julius quasi-quoter for patterns does not exist"+julius = QuasiQuoter { quoteExp = juliusFromString }  juliusFromString :: String -> Q Exp juliusFromString s = do

@@ -1,5 +1,5 @@ name:            hamlet-version:         0.5.0.2+version:         0.5.1 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -32,21 +32,21 @@ stability:       unstable cabal-version:   >= 1.6 build-type:      Simple-homepage:        http://docs.yesodweb.com/hamlet/+homepage:        http://docs.yesodweb.com/  flag buildtests   description: Build the executable to run unit tests   default: False  library-    build-depends:   base >= 4 && < 5,-                     bytestring >= 0.9 && < 0.10,-                     utf8-string >= 0.3.4 && < 0.4,-                     template-haskell,-                     blaze-builder >= 0.1 && < 0.2,-                     neither >= 0.0.1 && < 0.1,-                     parsec >= 2 && < 4,-                     failure >= 0.1.0 && < 0.2+    build-depends:   base             >= 4       && < 5+                   , bytestring       >= 0.9     && < 0.10+                   , utf8-string      >= 0.3.4   && < 0.4+                   , template-haskell+                   , blaze-builder    >= 0.1     && < 0.2+                   , neither          >= 0.0.1   && < 0.1+                   , parsec           >= 2       && < 4+                   , failure          >= 0.1.0   && < 0.2     exposed-modules: Text.Hamlet                      Text.Hamlet.RT                      Text.Cassius

@@ -459,6 +459,12 @@     helper "<br>" $ const $ [$hamlet'|%br|]
     helper "<br/>" $ const $ [$xhamlet'|%br|]
 
+    -- new with generalized stuff
+    helper' "foo" [$hamlet|foo|]
+    helper' "foo" [$xhamlet|foo|]
+    helper "<br>" $ const $ [$hamlet|%br|]
+    helper "<br/>" $ const $ [$xhamlet|%br|]
+
 caseHamletDebug :: Assertion
 caseHamletDebug = do
     helper "<p>foo</p>\n<p>bar</p>\n" [$hamletDebug|