packages feed

hamlet 0.8.2.1 → 0.9.0

raw patch · 11 files changed

+273/−911 lines, 11 filesdep +hspecdep −QuickCheckdep −json-typesdep −test-frameworkdep ~hamletdep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

Dependencies removed: QuickCheck, json-types, test-framework, test-framework-hunit

Dependency ranges changed: hamlet, text

API changes (from Hackage documentation)

- Text.Hamlet: HDBool :: Bool -> HamletData url
- Text.Hamlet: HDHtml :: Html -> HamletData url
- Text.Hamlet: HDList :: [HamletMap url] -> HamletData url
- Text.Hamlet: HDMaybe :: (Maybe (HamletMap url)) -> HamletData url
- Text.Hamlet: HDTemplate :: HamletRT -> HamletData url
- Text.Hamlet: HDUrl :: url -> HamletData url
- Text.Hamlet: HDUrlParams :: url -> [(Text, Text)] -> HamletData url
- Text.Hamlet: HamletParseException :: String -> HamletException
- Text.Hamlet: HamletRenderException :: String -> HamletException
- Text.Hamlet: HamletSettings :: String -> Bool -> (String -> CloseStyle) -> HamletSettings
- Text.Hamlet: HamletUnsupportedDocException :: Doc -> HamletException
- Text.Hamlet: cdata :: Html -> Html
- Text.Hamlet: class Monad (HamletMonad a) => HamletValue a where { data family HamletMonad a :: * -> *; type family HamletUrl a; }
- Text.Hamlet: data HamletData url
- Text.Hamlet: data HamletException
- Text.Hamlet: data HamletRT
- Text.Hamlet: data HamletSettings
- Text.Hamlet: fromHamletValue :: HamletValue a => a -> HamletMonad a ()
- Text.Hamlet: hamletCloseNewline :: HamletSettings -> Bool
- Text.Hamlet: hamletCloseStyle :: HamletSettings -> String -> CloseStyle
- Text.Hamlet: hamletDebug :: QuasiQuoter
- Text.Hamlet: hamletDoctype :: HamletSettings -> String
- Text.Hamlet: hamletFileDebug :: FilePath -> Q Exp
- Text.Hamlet: htmlToHamletMonad :: HamletValue a => Html -> HamletMonad a ()
- Text.Hamlet: parseHamletRT :: Failure HamletException m => HamletSettings -> String -> m HamletRT
- Text.Hamlet: preEscapedLazyText :: Text -> Html
- Text.Hamlet: preEscapedString :: String -> Html
- Text.Hamlet: preEscapedText :: Text -> Html
- Text.Hamlet: renderHamlet :: (url -> [(Text, Text)] -> Text) -> Hamlet url -> ByteString
- Text.Hamlet: renderHamletRT :: Failure HamletException m => HamletRT -> HamletMap url -> (url -> [(Text, Text)] -> Text) -> m Html
- Text.Hamlet: renderHamletText :: (url -> [(Text, Text)] -> Text) -> Hamlet url -> Text
- Text.Hamlet: renderHtml :: Html -> ByteString
- Text.Hamlet: renderHtmlText :: Html -> Text
- Text.Hamlet: string :: String -> Html
- Text.Hamlet: toHamletValue :: HamletValue a => HamletMonad a () -> a
- Text.Hamlet: toHtml :: ToHtml a => a -> Html
- Text.Hamlet: unsafeByteString :: ByteString -> Html
- Text.Hamlet: urlToHamletMonad :: HamletValue a => HamletUrl a -> [(Text, Text)] -> HamletMonad a ()
- Text.Hamlet.NonPoly: Env :: Maybe ((Exp -> Q Exp) -> Q Exp) -> Maybe ((Exp -> Q Exp) -> Q Exp) -> Env
- Text.Hamlet.NonPoly: HamletRules :: Exp -> ((Env -> Q Exp) -> Q Exp) -> (Env -> Exp -> Q Exp) -> HamletRules
- Text.Hamlet.NonPoly: data Env
- Text.Hamlet.NonPoly: data HamletRules
- Text.Hamlet.NonPoly: defaultHamletSettings :: HamletSettings
- Text.Hamlet.NonPoly: hamlet :: QuasiQuoter
- Text.Hamlet.NonPoly: hamletFile :: FilePath -> Q Exp
- Text.Hamlet.NonPoly: hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
- Text.Hamlet.NonPoly: hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
- Text.Hamlet.NonPoly: hrEmbed :: HamletRules -> Env -> Exp -> Q Exp
- Text.Hamlet.NonPoly: hrFromHtml :: HamletRules -> Exp
- Text.Hamlet.NonPoly: hrWithEnv :: HamletRules -> (Env -> Q Exp) -> Q Exp
- Text.Hamlet.NonPoly: html :: QuasiQuoter
- Text.Hamlet.NonPoly: htmlFile :: FilePath -> Q Exp
- Text.Hamlet.NonPoly: ihamlet :: QuasiQuoter
- Text.Hamlet.NonPoly: ihamletFile :: FilePath -> Q Exp
- Text.Hamlet.NonPoly: msgRender :: Env -> Maybe ((Exp -> Q Exp) -> Q Exp)
- Text.Hamlet.NonPoly: type Hamlet url = Render url -> Html
- Text.Hamlet.NonPoly: type Html = HtmlM ()
- Text.Hamlet.NonPoly: type IHamlet msg url = Translate msg -> Render url -> Html
- Text.Hamlet.NonPoly: urlRender :: Env -> Maybe ((Exp -> Q Exp) -> Q Exp)
- Text.Hamlet.RT: HDBool :: Bool -> HamletData url
- Text.Hamlet.RT: HDHtml :: Html -> HamletData url
- Text.Hamlet.RT: HDList :: [HamletMap url] -> HamletData url
- Text.Hamlet.RT: HDMaybe :: (Maybe (HamletMap url)) -> HamletData url
- Text.Hamlet.RT: HDTemplate :: HamletRT -> HamletData url
- Text.Hamlet.RT: HDUrl :: url -> HamletData url
- Text.Hamlet.RT: HDUrlParams :: url -> [(Text, Text)] -> 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 -> HamletMap url -> (url -> [(Text, Text)] -> Text) -> m Html
- Text.Hamlet.RT: renderHamletRT' :: Failure HamletException m => Bool -> HamletRT -> HamletMap url -> (url -> [(Text, Text)] -> Text) -> m Html
- Text.Hamlet.RT: type HamletMap url = [([String], HamletData url)]
+ Text.Hamlet: Env :: Maybe ((Exp -> Q Exp) -> Q Exp) -> Maybe ((Exp -> Q Exp) -> Q Exp) -> Env
+ Text.Hamlet: HamletRules :: Exp -> ((Env -> Q Exp) -> Q Exp) -> (Env -> Exp -> Q Exp) -> HamletRules
+ Text.Hamlet: data Env
+ Text.Hamlet: data HamletRules
+ Text.Hamlet: hrEmbed :: HamletRules -> Env -> Exp -> Q Exp
+ Text.Hamlet: hrFromHtml :: HamletRules -> Exp
+ Text.Hamlet: hrWithEnv :: HamletRules -> (Env -> Q Exp) -> Q Exp
+ Text.Hamlet: html :: QuasiQuoter
+ Text.Hamlet: htmlFile :: FilePath -> Q Exp
+ Text.Hamlet: ihamlet :: QuasiQuoter
+ Text.Hamlet: ihamletFile :: FilePath -> Q Exp
+ Text.Hamlet: msgRender :: Env -> Maybe ((Exp -> Q Exp) -> Q Exp)
+ Text.Hamlet: type IHamlet msg url = Translate msg -> Render url -> Html
+ Text.Hamlet: urlRender :: Env -> Maybe ((Exp -> Q Exp) -> Q Exp)
+ Text.Hamlet: xhtml :: QuasiQuoter
+ Text.Hamlet: xhtmlFile :: FilePath -> Q Exp
+ Text.Shakespeare: readUtf8File :: FilePath -> IO Text
- Text.Hamlet: hamletFileWithSettings :: HamletSettings -> FilePath -> Q Exp
+ Text.Hamlet: hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
- Text.Hamlet: hamletWithSettings :: HamletSettings -> QuasiQuoter
+ Text.Hamlet: hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
- Text.Hamlet: type Hamlet url = (url -> [(Text, Text)] -> Text) -> Html
+ Text.Hamlet: type Hamlet url = Render url -> Html

Files

Text/Cassius.hs view
@@ -47,7 +47,6 @@ import Data.Bits import qualified Data.Text as TS import qualified Data.Text.Lazy as TL-import Text.Hamlet.Quasi (readUtf8File) import Data.Char (isSpace)  data Color = Color Word8 Word8 Word8
Text/Css.hs view
@@ -11,7 +11,6 @@ import Data.Text (Text, pack) import Language.Haskell.TH.Syntax import System.IO.Unsafe (unsafePerformIO)-import Text.Hamlet.Quasi (readUtf8File) import Text.ParserCombinators.Parsec (Parser, parse) import Text.Shakespeare import Language.Haskell.TH
Text/Hamlet.hs view
@@ -1,78 +1,266 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-} module Text.Hamlet-    ( -- * Basic quasiquoters-      hamlet-    , xhamlet-    , hamletDebug-      -- * Load from external file+    ( -- * Plain HTML+      Html+    , html+    , htmlFile+    , xhtml+    , xhtmlFile+      -- * Hamlet+    , Hamlet+    , hamlet     , hamletFile+    , xhamlet     , xhamletFile-    , hamletFileDebug-      -- * Customized settings+      -- * I18N Hamlet+    , IHamlet+    , ihamlet+    , ihamletFile+      -- * Internal, for making more     , hamletWithSettings     , hamletFileWithSettings-    , HamletSettings (..)     , defaultHamletSettings     , xhtmlHamletSettings-      -- * Datatypes-    , Html-    , Hamlet-      -- * Typeclass-    , HamletValue (..)-      -- * Construction-    , preEscapedString-    , preEscapedText-    , preEscapedLazyText-    , string-    , unsafeByteString-    , cdata-    , toHtml-      -- * Rendering-      -- ** ByteString-    , renderHamlet-    , renderHtml-      -- ** Text-    , renderHamletText-    , renderHtmlText-      -- * Runtime Hamlet-    , HamletRT-    , HamletData (..)-    , HamletException (..)-    , parseHamletRT-    , renderHamletRT+    , Env (..)+    , HamletRules (..)     ) where +import Text.Shakespeare import Text.Hamlet.Parse-import Text.Hamlet.Quasi-import Text.Hamlet.RT-import Text.Hamlet.Debug-import qualified Data.ByteString.Lazy as L-import Data.Monoid (mappend)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.Encoding as T-import qualified Data.Text.Encoding.Error as T-import Text.Blaze.Renderer.Utf8 (renderHtml)-import qualified Text.Blaze.Renderer.Text as BT-import Text.Blaze (preEscapedText, preEscapedString, string, unsafeByteString, toHtml, preEscapedLazyText)-import Data.Text (Text)+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Quote+import Data.Char (isUpper, isDigit)+import Data.Monoid (Monoid (..))+import Data.Maybe (fromMaybe)+import Data.Text (Text, pack)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TIO+import qualified System.IO as SIO+import Text.Blaze (Html, preEscapedText, toHtml)+import qualified Data.Foldable as F+import Control.Applicative ((<$>))+import Control.Monad (ap) --- | Converts a 'Hamlet' to lazy bytestring.-renderHamlet :: (url -> [(Text, Text)] -> Text) -> Hamlet url -> L.ByteString-renderHamlet render h = renderHtml $ h render+type Render url = url -> [(Text, Text)] -> Text+type Translate msg = msg -> Html -renderHamletText :: (url -> [(Text, Text)] -> Text) -> Hamlet url-                 -> T.Text-renderHamletText render h =-    T.decodeUtf8With T.lenientDecode $ renderHtml $ h render+-- | A function generating an 'Html' given a URL-rendering function.+type Hamlet url = Render url -> Html -renderHtmlText :: Html -> T.Text-renderHtmlText = BT.renderHtml+-- | A function generating an 'Html' given a message translator and a URL rendering function.+type IHamlet msg url = Translate msg -> Render url -> Html --- | Wrap an 'Html' for embedding in an XML file.-cdata :: Html -> Html-cdata h =-    preEscapedText "<![CDATA["-    `mappend`-    h-    `mappend`-    preEscapedText "]]>"+docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp+docsToExp env hr scope docs = do+    exps <- mapM (docToExp env hr scope) docs+    case exps of+        [] -> [|return ()|]+        [x] -> return x+        _ -> return $ DoE $ map NoBindS exps++docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp+docToExp env hr scope (DocForall list ident@(Ident name) inside) = do+    let list' = derefToExp scope list+    name' <- newName name+    let scope' = (ident, VarE name') : scope+    mh <- [|F.mapM_|]+    inside' <- docsToExp env hr scope' inside+    let lam = LamE [VarP name'] inside'+    return $ mh `AppE` lam `AppE` list'+docToExp env hr scope (DocWith [] inside) = do+    inside' <- docsToExp env hr scope inside+    return $ inside'+docToExp env hr scope (DocWith ((deref,ident@(Ident name)):dis) inside) = do+    let deref' = derefToExp scope deref+    name' <- newName name+    let scope' = (ident, VarE name') : scope+    inside' <- docToExp env hr scope' (DocWith dis inside)+    let lam = LamE [VarP name'] inside'+    return $ lam `AppE` deref'+docToExp env hr scope (DocMaybe val ident@(Ident name) inside mno) = do+    let val' = derefToExp scope val+    name' <- newName name+    let scope' = (ident, VarE name') : scope+    inside' <- docsToExp env hr scope' inside+    let inside'' = LamE [VarP name'] inside'+    ninside' <- case mno of+                    Nothing -> [|Nothing|]+                    Just no -> do+                        no' <- docsToExp env hr scope no+                        j <- [|Just|]+                        return $ j `AppE` no'+    mh <- [|maybeH|]+    return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'+docToExp env hr scope (DocCond conds final) = do+    conds' <- mapM go conds+    final' <- case final of+                Nothing -> [|Nothing|]+                Just f -> do+                    f' <- docsToExp env hr scope f+                    j <- [|Just|]+                    return $ j `AppE` f'+    ch <- [|condH|]+    return $ ch `AppE` ListE conds' `AppE` final'+  where+    go :: (Deref, [Doc]) -> Q Exp+    go (d, docs) = do+        let d' = derefToExp scope d+        docs' <- docsToExp env hr scope docs+        return $ TupE [d', docs']+docToExp env hr v (DocContent c) = contentToExp env hr v c++contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp+contentToExp _ hr _ (ContentRaw s) = do+    os <- [|preEscapedText . pack|]+    let s' = LitE $ StringL s+    return $ hrFromHtml hr `AppE` (os `AppE` s')+contentToExp _ hr scope (ContentVar d) = do+    str <- [|toHtml|]+    return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d)+contentToExp env hr scope (ContentUrl hasParams d) =+    case urlRender env of+        Nothing -> error "URL interpolation used, but no URL renderer provided"+        Just wrender -> wrender $ \render -> do+            let render' = return render+            ou <- if hasParams+                    then [|\(u, p) -> $(render') u p|]+                    else [|\u -> $(render') u []|]+            let d' = derefToExp scope d+            pet <- [|toHtml|]+            return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d'))+contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d+contentToExp env hr scope (ContentMsg d) =+    case msgRender env of+        Nothing -> error "Message interpolation used, but no message renderer provided"+        Just wrender -> wrender $ \render ->+            return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d)++html :: QuasiQuoter+html = hamletWithSettings htmlRules defaultHamletSettings++xhtml :: QuasiQuoter+xhtml = hamletWithSettings htmlRules xhtmlHamletSettings++htmlRules :: Q HamletRules+htmlRules = do+    i <- [|id|]+    return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b)++hamlet :: QuasiQuoter+hamlet = hamletWithSettings hamletRules defaultHamletSettings++xhamlet :: QuasiQuoter+xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings++hamletRules :: Q HamletRules+hamletRules = do+    i <- [|id|]+    let ur f = do+            r <- newName "_render"+            let env = Env+                    { urlRender = Just ($ (VarE r))+                    , msgRender = Nothing+                    }+            h <- f env+            return $ LamE [VarP r] h+    let em (Env (Just urender) Nothing) e =+            urender $ \ur -> return (e `AppE` ur)+    return $ HamletRules i ur em++ihamlet :: QuasiQuoter+ihamlet = hamletWithSettings ihamletRules defaultHamletSettings++ihamletRules :: Q HamletRules+ihamletRules = do+    i <- [|id|]+    let ur f = do+            u <- newName "_urender"+            m <- newName "_mrender"+            let env = Env+                    { urlRender = Just ($ (VarE u))+                    , msgRender = Just ($ (VarE m))+                    }+            h <- f env+            return $ LamE [VarP m, VarP u] h+    let em (Env (Just urender) (Just mrender)) e =+            urender $ \ur -> mrender $ \mr -> return (e `AppE` mr `AppE` ur)+    return $ HamletRules i ur em++hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter+hamletWithSettings hr set =+    QuasiQuoter+        { quoteExp = hamletFromString hr set+        }++data HamletRules = HamletRules+    { hrFromHtml :: Exp+    , hrWithEnv :: (Env -> Q Exp) -> Q Exp+    , hrEmbed :: Env -> Exp -> Q Exp+    }++data Env = Env+    { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)+    , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)+    }++hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp+hamletFromString qhr set s = do+    hr <- qhr+    case parseDoc set s of+        Error s' -> error s'+        Ok d -> hrWithEnv hr $ \env -> docsToExp env hr [] d++hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp+hamletFileWithSettings qhr set fp = do+    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp+    hamletFromString qhr set contents++hamletFile :: FilePath -> Q Exp+hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings++xhamletFile :: FilePath -> Q Exp+xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings++htmlFile :: FilePath -> Q Exp+htmlFile = hamletFileWithSettings htmlRules defaultHamletSettings++xhtmlFile :: FilePath -> Q Exp+xhtmlFile = hamletFileWithSettings htmlRules xhtmlHamletSettings++ihamletFile :: FilePath -> Q Exp+ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings++varName :: Scope -> String -> Exp+varName _ "" = error "Illegal empty varName"+varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope++strToExp :: String -> Exp+strToExp s@(c:_)+    | all isDigit s = LitE $ IntegerL $ read s+    | isUpper c = ConE $ mkName s+    | otherwise = VarE $ mkName s+strToExp "" = error "strToExp on empty string"++-- | Checks for truth in the left value in each pair in the first argument. If+-- 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 :: 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 :: Monad m => Maybe v -> (v -> m ()) -> Maybe (m ()) -> m ()+maybeH Nothing _ Nothing = return ()+maybeH Nothing _ (Just x) = x+maybeH (Just v) f _ = f v
− Text/Hamlet/Debug.hs
@@ -1,140 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module Text.Hamlet.Debug-    ( hamletFileDebug-    ) where--import Text.Hamlet.Parse-import Text.Hamlet.Quasi-import Text.Hamlet.RT-import Language.Haskell.TH.Syntax-import System.IO.Unsafe (unsafePerformIO)-import Control.Arrow-import Data.Either-import Control.Monad (forM)-import qualified Data.Text.Lazy as T-import Text.Blaze (toHtml)-import Data.Text (Text)--unsafeRenderTemplate :: FilePath -> HamletMap url-                     -> (url -> [(Text, Text)] -> Text) -> Html-unsafeRenderTemplate fp hd render = unsafePerformIO $ do-    contents <- fmap T.unpack $ readUtf8File fp-    temp <- parseHamletRT defaultHamletSettings contents-    renderHamletRT' True temp hd render--hamletFileDebug :: FilePath -> Q Exp-hamletFileDebug fp = do-    contents <- fmap T.unpack $ qRunIO $ readUtf8File fp-    HamletRT docs <- qRunIO $ parseHamletRT defaultHamletSettings contents-    urt <- [|unsafeRenderTemplate|]-    render <- newName "render"-    let hd = combineDVals $ concatMap getHD docs-    hd' <- liftDVals (VarE render) hd-    let h = urt `AppE` LitE (StringL fp) `AppE` hd' `AppE` VarE render-    return $ LamE [VarP render] h--derefToExp :: [Exp] -> Exp-derefToExp = foldr1 AppE . reverse--type DVal = ([Exp], DVal')-data DVal' = DHtml-           | DUrl-           | DUrlParam-           | DTemplate-           | DBool-           | DMaybe [([String], DVal)]-           | DList [([String], DVal)]-    deriving (Show, Eq)--liftDVals :: Exp -> [([String], DVal)] -> Q Exp-liftDVals render pairs = do-    pairs' <- forM pairs $ \(k, d) -> do-        let k' = ListE $ map (LitE . StringL) k-        d' <- liftDVal render d-        return $ TupE [k', d']-    return $ ListE pairs'--liftDVal :: Exp -> DVal -> Q Exp-liftDVal _ (x, DHtml) = do-    f <- [|HDHtml . toHtml|]-    return $ f `AppE` derefToExp x-liftDVal _ (x, DUrl) = do-    f <- [|HDUrl|]-    return $ f `AppE` derefToExp x-liftDVal _ (x, DUrlParam) = do-    f <- [|uncurry HDUrlParams|]-    return $ f `AppE` derefToExp x-liftDVal render (x, DTemplate) = do-    f <- [|HDHtml|]-    return $ f `AppE` (derefToExp x `AppE` render)-liftDVal _ (x, DBool) = do-    f <- [|HDBool|]-    return $ f `AppE` derefToExp x-liftDVal render (x, DMaybe each) = do-    var <- newName "_var"-    each' <- liftDVals render $ map (second $ replaceFirst $ VarE var) each-    let each'' = LamE [VarP var] each'-    hdlist <- [|HDMaybe|]-    map' <- [|fmap|]-    return $ hdlist `AppE` (map' `AppE` each'' `AppE` derefToExp x)-liftDVal render (x, DList each) = do-    var <- newName "_var"-    each' <- liftDVals render $ map (second $ replaceFirst $ VarE var) each-    let each'' = LamE [VarP var] each'-    hdlist <- [|HDList|]-    map' <- [|map|]-    return $ hdlist `AppE` (map' `AppE` each'' `AppE` derefToExp x)--combineDVals :: [([String], DVal)] -> [([String], DVal)]-combineDVals [] = []-combineDVals ((x1, y1):rest) =-    case matches of-        [] -> (x1, y1) : combineDVals rest-        ys -> (x1, foldr combine' y1 ys) : combineDVals nomatch-  where-    matches = map snd $ filter (\(x, _) -> x == x1) rest-    nomatch = filter (\(x, _) -> x /= x1) rest-    combine' (a, x) (b, y)-        | a == b = (a, combine x y)-        | otherwise = error $ "Bad parameters to combine': " ++ show ((a, x), (b, y))-    combine (DList x) (DList y) = DList $ combineDVals $ x ++ y-    combine (DMaybe x) (DMaybe y) = DMaybe $ combineDVals $ x ++ y-    combine x y-        | x == y = x-    combine x y = error $ "Bad parameters to combine: " ++ show (x, y)--varNames :: [String] -> [Exp]-varNames = map $ varName []-getHD :: SimpleDoc -> [([String], DVal)]-getHD SDRaw{} = []-getHD (SDVar x) = [(x, (varNames x, DHtml))]-getHD (SDUrl hasParams x) =-    [(x, (varNames x, if hasParams then DUrlParam else DUrl))]-getHD (SDTemplate x) = [(x, (varNames x, DTemplate))]-getHD (SDCond xs edocs) =-    let hd = concatMap getHD $ edocs ++ concatMap snd xs-        bools = map (\(x, _) -> (x, (varNames x, DBool))) xs-     in hd ++ bools-getHD (SDMaybe x y docs ndocs) =-    (x, (varNames x, DMaybe subs)) : tops ++ ntops-  where-    hd = concatMap getHD docs-    (tops, subs) = partitionEithers $ map go hd-    ntops = concatMap getHD ndocs-    go (a@(y':rest), e)-        | y == y' = Right (rest, e)-        | otherwise = Left (a, e)-    go ([], _) = error "getHD of SDMaybe"-getHD (SDForall x y docs) =-     (x, (varNames x, DList subs)) : tops-  where-    hd = concatMap getHD docs-    (tops, subs) = partitionEithers $ map go hd-    go (a@(y':rest), e)-        | y == y' = Right (rest, e)-        | otherwise = Left (a, e)-    go ([], _) = error "getHD of SDForall"--replaceFirst :: Exp -> DVal -> DVal-replaceFirst x (_:y, z) = (x:y, z)-replaceFirst _ _ = error "replaceFirst on something empty"
− Text/Hamlet/NonPoly.hs
@@ -1,255 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-module Text.Hamlet.NonPoly-    ( -- * Plain HTML-      Html-    , html-    , htmlFile-      -- * Hamlet-    , Hamlet-    , hamlet-    , hamletFile-      -- * I18N Hamlet-    , IHamlet-    , ihamlet-    , ihamletFile-      -- * Internal, for making more-    , hamletWithSettings-    , hamletFileWithSettings-    , defaultHamletSettings-    , Env (..)-    , HamletRules (..)-    ) where--import Text.Shakespeare-import Text.Hamlet.Parse-import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Quote-import Data.Char (isUpper, isDigit)-import Data.Monoid (Monoid (..))-import Data.Maybe (fromMaybe)-import Data.Text (Text, pack)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TIO-import qualified System.IO as SIO-import Text.Blaze (Html, preEscapedText, toHtml)-import qualified Data.Foldable as F-import Control.Applicative ((<$>))-import Control.Monad (ap)--type Render url = url -> [(Text, Text)] -> Text-type Translate msg = msg -> Html---- | A function generating an 'Html' given a URL-rendering function.-type Hamlet url = Render url -> Html---- | A function generating an 'Html' given a message translator and a URL rendering function.-type IHamlet msg url = Translate msg -> Render url -> Html--readUtf8File :: FilePath -> IO TL.Text-readUtf8File fp = do-    h <- SIO.openFile fp SIO.ReadMode-    SIO.hSetEncoding h SIO.utf8_bom-    TIO.hGetContents h--docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp-docsToExp env hr scope docs = do-    exps <- mapM (docToExp env hr scope) docs-    case exps of-        [] -> [|return ()|]-        [x] -> return x-        _ -> return $ DoE $ map NoBindS exps--docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp-docToExp env hr scope (DocForall list ident@(Ident name) inside) = do-    let list' = derefToExp scope list-    name' <- newName name-    let scope' = (ident, VarE name') : scope-    mh <- [|F.mapM_|]-    inside' <- docsToExp env hr scope' inside-    let lam = LamE [VarP name'] inside'-    return $ mh `AppE` lam `AppE` list'-docToExp env hr scope (DocWith [] inside) = do-    inside' <- docsToExp env hr scope inside-    return $ inside'-docToExp env hr scope (DocWith ((deref,ident@(Ident name)):dis) inside) = do-    let deref' = derefToExp scope deref-    name' <- newName name-    let scope' = (ident, VarE name') : scope-    inside' <- docToExp env hr scope' (DocWith dis inside)-    let lam = LamE [VarP name'] inside'-    return $ lam `AppE` deref'-docToExp env hr scope (DocMaybe val ident@(Ident name) inside mno) = do-    let val' = derefToExp scope val-    name' <- newName name-    let scope' = (ident, VarE name') : scope-    inside' <- docsToExp env hr scope' inside-    let inside'' = LamE [VarP name'] inside'-    ninside' <- case mno of-                    Nothing -> [|Nothing|]-                    Just no -> do-                        no' <- docsToExp env hr scope no-                        j <- [|Just|]-                        return $ j `AppE` no'-    mh <- [|maybeH|]-    return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'-docToExp env hr scope (DocCond conds final) = do-    conds' <- mapM go conds-    final' <- case final of-                Nothing -> [|Nothing|]-                Just f -> do-                    f' <- docsToExp env hr scope f-                    j <- [|Just|]-                    return $ j `AppE` f'-    ch <- [|condH|]-    return $ ch `AppE` ListE conds' `AppE` final'-  where-    go :: (Deref, [Doc]) -> Q Exp-    go (d, docs) = do-        let d' = derefToExp scope d-        docs' <- docsToExp env hr scope docs-        return $ TupE [d', docs']-docToExp env hr v (DocContent c) = contentToExp env hr v c--contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp-contentToExp _ hr _ (ContentRaw s) = do-    os <- [|preEscapedText . pack|]-    let s' = LitE $ StringL s-    return $ hrFromHtml hr `AppE` (os `AppE` s')-contentToExp _ hr scope (ContentVar d) = do-    str <- [|toHtml|]-    return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d)-contentToExp env hr scope (ContentUrl hasParams d) =-    case urlRender env of-        Nothing -> error "URL interpolation used, but no URL renderer provided"-        Just wrender -> wrender $ \render -> do-            let render' = return render-            ou <- if hasParams-                    then [|\(u, p) -> $(render') u p|]-                    else [|\u -> $(render') u []|]-            let d' = derefToExp scope d-            pet <- [|preEscapedText|]-            return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d'))-contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d-contentToExp env hr scope (ContentMsg d) =-    case msgRender env of-        Nothing -> error "Message interpolation used, but no message renderer provided"-        Just wrender -> wrender $ \render ->-            return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d)--html :: QuasiQuoter-html = hamletWithSettings htmlRules defaultHamletSettings--htmlRules :: Q HamletRules-htmlRules = do-    i <- [|id|]-    return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b)--hamlet :: QuasiQuoter-hamlet = hamletWithSettings hamletRules defaultHamletSettings--hamletRules :: Q HamletRules-hamletRules = do-    i <- [|id|]-    let ur f = do-            r <- newName "_render"-            let env = Env-                    { urlRender = Just ($ (VarE r))-                    , msgRender = Nothing-                    }-            h <- f env-            return $ LamE [VarP r] h-    let em (Env (Just urender) Nothing) e =-            urender $ \ur -> return (e `AppE` ur)-    return $ HamletRules i ur em--ihamlet :: QuasiQuoter-ihamlet = hamletWithSettings ihamletRules defaultHamletSettings--ihamletRules :: Q HamletRules-ihamletRules = do-    i <- [|id|]-    let ur f = do-            u <- newName "_urender"-            m <- newName "_mrender"-            let env = Env-                    { urlRender = Just ($ (VarE u))-                    , msgRender = Just ($ (VarE m))-                    }-            h <- f env-            return $ LamE [VarP m, VarP u] h-    let em (Env (Just urender) (Just mrender)) e =-            urender $ \ur -> mrender $ \mr -> return (e `AppE` mr `AppE` ur)-    return $ HamletRules i ur em--hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter-hamletWithSettings hr set =-    QuasiQuoter-        { quoteExp = hamletFromString hr set-        }--data HamletRules = HamletRules-    { hrFromHtml :: Exp-    , hrWithEnv :: (Env -> Q Exp) -> Q Exp-    , hrEmbed :: Env -> Exp -> Q Exp-    }--data Env = Env-    { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)-    , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)-    }--hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp-hamletFromString qhr set s = do-    hr <- qhr-    case parseDoc set s of-        Error s' -> error s'-        Ok d -> hrWithEnv hr $ \env -> docsToExp env hr [] d--hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp-hamletFileWithSettings qhr set fp = do-    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp-    hamletFromString qhr set contents--hamletFile :: FilePath -> Q Exp-hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings--htmlFile :: FilePath -> Q Exp-htmlFile = hamletFileWithSettings htmlRules defaultHamletSettings--ihamletFile :: FilePath -> Q Exp-ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings--varName :: Scope -> String -> Exp-varName _ "" = error "Illegal empty varName"-varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope--strToExp :: String -> Exp-strToExp s@(c:_)-    | all isDigit s = LitE $ IntegerL $ read s-    | isUpper c = ConE $ mkName s-    | otherwise = VarE $ mkName s-strToExp "" = error "strToExp on empty string"---- | Checks for truth in the left value in each pair in the first argument. If--- 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 :: 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 :: Monad m => Maybe v -> (v -> m ()) -> Maybe (m ()) -> m ()-maybeH Nothing _ Nothing = return ()-maybeH Nothing _ (Just x) = x-maybeH (Just v) f _ = f v
− Text/Hamlet/Quasi.hs
@@ -1,251 +0,0 @@--- NOTE: This module is being deprecated, in favor of NonPoly. In Hamlet 0.9,--- this code will be replaced entirely. Avoid changes here whenever possible.--{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-module Text.Hamlet.Quasi-    ( hamlet-    , xhamlet-    , hamletDebug-    , hamletWithSettings-    , hamletWithSettings'-    , hamletFile-    , xhamletFile-    , hamletFileWithSettings-    , HamletValue (..)-    , varName-    , Html-    , Hamlet-    , readUtf8File-    ) where--import Text.Shakespeare-import Text.Hamlet.Parse-import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Quote-import Data.Char (isUpper, isDigit)-import Data.Monoid (Monoid (..))-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TIO-import qualified System.IO as SIO-import Text.Blaze (Html, preEscapedString, toHtml)-import qualified Data.Foldable as F--readUtf8File :: FilePath -> IO TL.Text-readUtf8File fp = do-    h <- SIO.openFile fp SIO.ReadMode-    SIO.hSetEncoding h SIO.utf8_bom-    TIO.hGetContents h--docsToExp :: Scope -> [Doc] -> Q Exp-docsToExp scope docs = do-    exps <- mapM (docToExp scope) docs-    case exps of-        [] -> [|return ()|]-        [x] -> return x-        _ -> return $ DoE $ map NoBindS exps--docToExp :: Scope -> Doc -> Q Exp-docToExp scope (DocForall list ident@(Ident name) inside) = do-    let list' = derefToExp scope list-    name' <- newName name-    let scope' = (ident, VarE name') : scope-    mh <- [|F.mapM_|]-    inside' <- docsToExp scope' inside-    let lam = LamE [VarP name'] inside'-    return $ mh `AppE` lam `AppE` list'-docToExp scope (DocWith [] inside) = do-    inside' <- docsToExp scope inside-    return $ inside'-docToExp scope (DocWith ((deref,ident@(Ident name)):dis) inside) = do-    let deref' = derefToExp scope deref-    name' <- newName name-    let scope' = (ident, VarE name') : scope-    inside' <- docToExp scope' (DocWith dis inside)-    let lam = LamE [VarP name'] inside'-    return $ lam `AppE` deref'-docToExp scope (DocMaybe val ident@(Ident name) inside mno) = do-    let val' = derefToExp scope val-    name' <- newName name-    let scope' = (ident, VarE name') : scope-    inside' <- docsToExp scope' inside-    let inside'' = LamE [VarP name'] inside'-    ninside' <- case mno of-                    Nothing -> [|Nothing|]-                    Just no -> do-                        no' <- docsToExp scope no-                        j <- [|Just|]-                        return $ j `AppE` no'-    mh <- [|maybeH|]-    return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'-docToExp scope (DocCond conds final) = do-    conds' <- mapM go conds-    final' <- case final of-                Nothing -> [|Nothing|]-                Just f -> do-                    f' <- docsToExp scope f-                    j <- [|Just|]-                    return $ j `AppE` f'-    ch <- [|condH|]-    return $ ch `AppE` ListE conds' `AppE` final'-  where-    go :: (Deref, [Doc]) -> Q Exp-    go (d, docs) = do-        let d' = derefToExp scope d-        docs' <- docsToExp scope docs-        return $ TupE [d', docs']-docToExp v (DocContent c) = contentToExp v c--contentToExp :: Scope -> Content -> Q Exp-contentToExp _ (ContentRaw s) = do-    os <- [|htmlToHamletMonad . preEscapedString|]-    let s' = LitE $ StringL s-    return $ os `AppE` s'-contentToExp scope (ContentVar d) = do-    str <- [|htmlToHamletMonad . toHtml|]-    return $ str `AppE` derefToExp scope d-contentToExp scope (ContentUrl hasParams d) = do-    ou <- if hasParams-            then [|\(u, p) -> urlToHamletMonad u p|]-            else [|\u -> urlToHamletMonad u []|]-    let d' = derefToExp scope d-    return $ ou `AppE` d'-contentToExp scope (ContentEmbed d) = do-    let d' = derefToExp scope d-    fhv <- [|fromHamletValue|]-    return $ fhv `AppE` d'-contentToExp _ ContentMsg{} = error "Poly-Hamlet does not support messages"---- | 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 xhtmlHamletSettings---- | A quasi-quoter that converts Hamlet syntax into a function of form:------ > (url -> String) -> Html------ Please see accompanying documentation for a description of Hamlet syntax.-hamletWithSettings :: HamletSettings -> QuasiQuoter-hamletWithSettings set =-    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-        { 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-            thv <- [|toHamletValue|]-            exp' <- docsToExp [] d-            return $ thv `AppE` exp'--hamletFileWithSettings :: HamletSettings -> FilePath -> Q Exp-hamletFileWithSettings set fp = do-    contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp-    hamletFromString set contents---- | Calls 'hamletFileWithSettings' with 'defaultHamletSettings'.-hamletFile :: FilePath -> Q Exp-hamletFile = hamletFileWithSettings defaultHamletSettings---- | Calls 'hamletFileWithSettings' using XHTML 1.0 Strict settings.-xhamletFile :: FilePath -> Q Exp-xhamletFile = hamletFileWithSettings xhtmlHamletSettings--varName :: Scope -> String -> Exp-varName _ "" = error "Illegal empty varName"-varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope--strToExp :: String -> Exp-strToExp s@(c:_)-    | all isDigit s = LitE $ IntegerL $ read s-    | isUpper c = ConE $ mkName s-    | otherwise = VarE $ mkName s-strToExp "" = error "strToExp on empty string"---- | Checks for truth in the left value in each pair in the first argument. If--- 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 :: 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 :: Monad m => Maybe v -> (v -> m ()) -> Maybe (m ()) -> m ()-maybeH Nothing _ Nothing = return ()-maybeH Nothing _ (Just x) = x-maybeH (Just v) f _ = f v---- | An function generating an 'Html' given a URL-rendering function.-type Hamlet url = (url -> [(Text, Text)] -> Text) -> 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 -> [(Text, Text)] -> HamletMonad a ()-    fromHamletValue :: a -> HamletMonad a ()--type Render url = url -> [(Text, Text)] -> Text-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 ->-        (toHtml $ 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)
− Text/Hamlet/RT.hs
@@ -1,174 +0,0 @@-{-# 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-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 Text.Hamlet.Quasi (Html)-import Data.List (intercalate)-import Text.Blaze (preEscapedString, preEscapedText)-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 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'')--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
Text/Lucius.hs view
@@ -27,7 +27,6 @@ import Text.ParserCombinators.Parsec hiding (Line) import Text.Css import Data.Char (isSpace)-import Text.Hamlet.Quasi (readUtf8File) import Control.Applicative ((<$>)) import Data.Either (partitionEithers) 
Text/Romeo.hs view
@@ -23,7 +23,6 @@ import System.IO.Unsafe (unsafePerformIO) import qualified Data.Text as TS import qualified Data.Text.Lazy as TL-import Text.Hamlet.Quasi (readUtf8File) import Text.Shakespeare  -- move to Shakespeare?
Text/Shakespeare.hs view
@@ -17,6 +17,7 @@     , parseInt     , derefToExp     , flattenDeref+    , readUtf8File     ) where  import Language.Haskell.TH.Syntax@@ -27,6 +28,9 @@ import Data.Ratio (Ratio, numerator, denominator, (%)) import Data.Data (Data) import Data.Typeable (Typeable)+import qualified Data.Text.Lazy as TL+import qualified System.IO as SIO+import qualified Data.Text.Lazy.IO as TIO  newtype Ident = Ident String     deriving (Show, Eq, Read, Data, Typeable)@@ -213,3 +217,9 @@         deref <- parseDeref         _ <- char '}'         return $ Right deref) <|> return (Left "_")++readUtf8File :: FilePath -> IO TL.Text+readUtf8File fp = do+    h <- SIO.openFile fp SIO.ReadMode+    SIO.hSetEncoding h SIO.utf8_bom+    TIO.hGetContents h
hamlet.cabal view
@@ -1,5 +1,5 @@ name:            hamlet-version:         0.8.2.1+version:         0.9.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -25,15 +25,9 @@ stability:       Stable cabal-version:   >= 1.8 build-type:      Simple-homepage:        http://www.yesodweb.com/--flag test-  description: Build the executable to run unit tests-  default: False+homepage:        http://www.yesodweb.com/book/templates  library-    if flag(test)-        Buildable: False     build-depends:   base             >= 4       && < 5                    , bytestring       >= 0.9     && < 0.10                    , template-haskell@@ -45,8 +39,6 @@                    , blaze-builder    >= 0.2     && < 0.4                    , process          >= 1.0     && < 1.1     exposed-modules: Text.Hamlet-                     Text.Hamlet.NonPoly-                     Text.Hamlet.RT                      Text.Cassius                      Text.Lucius                      Text.Julius@@ -54,8 +46,6 @@                      Text.Romeo                      Text.Shakespeare     other-modules:   Text.Hamlet.Parse-                     Text.Hamlet.Quasi-                     Text.Hamlet.Debug                      Text.MkSizeType                      Text.Css     ghc-options:     -Wall@@ -66,18 +56,16 @@     type: exitcode-stdio-1.0      ghc-options:   -Wall-    build-depends: hamlet >= 0.7.2,-                   base             >= 4       && < 5,-                   parsec           >= 2       && < 4,-                   containers       >= 0.2     && < 0.5,-                   json-types       >= 0.1     && < 0.2,-                   text             >= 0.7     && < 0.12,-                   HUnit,-                   QuickCheck >= 2 && < 3,-                   test-framework-hunit,-                   test-framework+    build-depends: hamlet           >= 0.9     && < 0.10+                 , base             >= 4       && < 5+                 , parsec           >= 2       && < 4+                 , containers       >= 0.2     && < 0.5+                 , text             >= 0.7     && < 1+                 , HUnit+                 , hspec+                 , blaze-html       >= 0.4     && < 0.5   source-repository head   type:     git-  location: git://github.com/snoyberg/hamlet.git+  location: git://github.com/yesodweb/hamlet.git