1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeSynonymInstances #-}
-- | Module for parsing and rendering Hamlet templates at runtime, not compile
-- time. This uses the same Hamlet parsing as compile-time Hamlet, but has some
-- limitations, such as:
--
-- * No compile-time checking of validity
--
-- * Can't apply functions at runtime
--
-- * No URL rendering
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import Text.Hamlet.Runtime
-- > import qualified Data.Map as Map
-- > import Text.Blaze.Html.Renderer.String (renderHtml)
-- >
-- > main :: IO ()
-- > main = do
-- > template <- parseHamletTemplate defaultHamletSettings $ unlines
-- > [ "<p>Hello, #{name}"
-- > , "$if hungry"
-- > , " <p>Available food:"
-- > , " <ul>"
-- > , " $forall food <- foods"
-- > , " <li>#{food}"
-- > ]
-- > let hamletDataMap = Map.fromList
-- > [ ("name", "Michael")
-- > , ("hungry", toHamletData True) -- always True
-- > , ("foods", toHamletData
-- > [ "Apples"
-- > , "Bananas"
-- > , "Carrots"
-- > ])
-- > ]
-- > html <- renderHamletTemplate template hamletDataMap
-- > putStrLn $ renderHtml html
--
-- @since 2.0.6
module Text.Hamlet.Runtime
( HamletTemplate
, HamletSettings
, defaultHamletSettings
, HamletData
, ToHamletData (..)
, parseHamletTemplate
, readHamletTemplateFile
, renderHamletTemplate
) where
import Control.Arrow ((***))
import Control.Monad.Catch (MonadThrow)
import Text.Hamlet (HamletSettings, defaultHamletSettings)
import qualified Text.Hamlet.RT as RT
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
import Data.String
import Text.Blaze.Html (Html, toHtml)
import Control.Monad (liftM)
import Control.Monad.IO.Class
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.ByteString as S
import qualified Data.Text as T
-- Just to skip a dependency for GHC < 7.10
data Void
absurd :: Void -> a
absurd _ = error "absurd"
-- | A parsed Hamlet template. See 'parseHamletTemplate' and
-- 'readHamletTemplateFile'.
--
-- @since 2.0.6
newtype HamletTemplate = HamletTemplate RT.HamletRT
-- | A piece of data that can be embedded and passed to a Hamlet template (via
-- 'renderHamletTemplate').
--
-- This supplies an 'IsString' instance, so with @OverloadedStrings@ it will
-- support literal strings, which are converted to HTML via 'toHtml'. For other
-- datatypes, use 'toHamletData'.
--
-- @since 2.0.6
newtype HamletData = HamletData { unHamletData :: RT.HamletData Void }
instance IsString HamletData where
fromString = HamletData . RT.HDHtml . fromString
-- | Data which can be passed to a Hamlet template.
--
-- @since 2.0.6
class ToHamletData a where
toHamletData :: a -> HamletData
instance ToHamletData HamletData where
toHamletData = id
instance a ~ HamletData => ToHamletData [a] where
toHamletData = HamletData . RT.HDList . map (\x -> [([], unHamletData x)])
instance a ~ HamletData => ToHamletData (Maybe a) where
toHamletData = HamletData . RT.HDMaybe . fmap (\x -> [([], unHamletData x)])
instance ToHamletData Text where
toHamletData = toHamletData . toHtml
instance ToHamletData Html where
toHamletData = HamletData . RT.HDHtml
instance ToHamletData Bool where
toHamletData = HamletData . RT.HDBool
-- | Parse an in-memory Hamlet template. This operation may fail if the
-- template is not parsable.
--
-- @since 2.0.6
parseHamletTemplate :: MonadThrow m => HamletSettings -> String -> m HamletTemplate
parseHamletTemplate set str = HamletTemplate `liftM` RT.parseHamletRT set str
-- | Same as 'parseHamletTemplate', but reads from a file. The file is assumed
-- to be UTF-8 encoded (same assumption as compile-time Hamlet).
--
-- @since 2.0.6
readHamletTemplateFile :: (MonadThrow m, MonadIO m) => HamletSettings -> FilePath -> m HamletTemplate
readHamletTemplateFile set fp = do
bs <- liftIO $ S.readFile fp
parseHamletTemplate set $ T.unpack $ decodeUtf8With lenientDecode bs
-- | Render a runtime Hamlet template, together with a 'Map' of variables to
-- pass in, into an 'Html' value. This can fail if the template references a
-- variable that is not present in the @Map@.
--
-- @since 2.0.6
renderHamletTemplate :: MonadThrow m => HamletTemplate -> Map Text HamletData -> m Html
renderHamletTemplate (HamletTemplate rt) m =
RT.renderHamletRT' True rt m' renderUrl
where
m' = map (return . T.unpack *** unHamletData) $ Map.toList m
renderUrl url _ = absurd url
|
