{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeSynonymInstances #-}
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
data Void
absurd :: Void -> a
absurd :: forall a. Void -> a
absurd Void
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"absurd"
newtype HamletTemplate = HamletTemplate RT.HamletRT
newtype HamletData = HamletData { HamletData -> HamletData Void
unHamletData :: RT.HamletData Void }
instance IsString HamletData where
fromString :: [Char] -> HamletData
fromString = HamletData Void -> HamletData
HamletData (HamletData Void -> HamletData)
-> ([Char] -> HamletData Void) -> [Char] -> HamletData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> HamletData Void
forall url. Html -> HamletData url
RT.HDHtml (Html -> HamletData Void)
-> ([Char] -> Html) -> [Char] -> HamletData Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Html
forall a. IsString a => [Char] -> a
fromString
class ToHamletData a where
toHamletData :: a -> HamletData
instance ToHamletData HamletData where
toHamletData :: HamletData -> HamletData
toHamletData = HamletData -> HamletData
forall a. a -> a
id
instance a ~ HamletData => ToHamletData [a] where
toHamletData :: [a] -> HamletData
toHamletData = HamletData Void -> HamletData
HamletData (HamletData Void -> HamletData)
-> ([a] -> HamletData Void) -> [a] -> HamletData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HamletMap Void] -> HamletData Void
forall url. [HamletMap url] -> HamletData url
RT.HDList ([HamletMap Void] -> HamletData Void)
-> ([a] -> [HamletMap Void]) -> [a] -> HamletData Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> HamletMap Void) -> [a] -> [HamletMap Void]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> [([], HamletData -> HamletData Void
unHamletData a
HamletData
x)])
instance a ~ HamletData => ToHamletData (Maybe a) where
toHamletData :: Maybe a -> HamletData
toHamletData = HamletData Void -> HamletData
HamletData (HamletData Void -> HamletData)
-> (Maybe a -> HamletData Void) -> Maybe a -> HamletData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (HamletMap Void) -> HamletData Void
forall url. Maybe (HamletMap url) -> HamletData url
RT.HDMaybe (Maybe (HamletMap Void) -> HamletData Void)
-> (Maybe a -> Maybe (HamletMap Void))
-> Maybe a
-> HamletData Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> HamletMap Void) -> Maybe a -> Maybe (HamletMap Void)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> [([], HamletData -> HamletData Void
unHamletData a
HamletData
x)])
instance ToHamletData Text where
toHamletData :: Text -> HamletData
toHamletData = Html -> HamletData
forall a. ToHamletData a => a -> HamletData
toHamletData (Html -> HamletData) -> (Text -> Html) -> Text -> HamletData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
forall a. ToMarkup a => a -> Html
toHtml
instance ToHamletData Html where
toHamletData :: Html -> HamletData
toHamletData = HamletData Void -> HamletData
HamletData (HamletData Void -> HamletData)
-> (Html -> HamletData Void) -> Html -> HamletData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> HamletData Void
forall url. Html -> HamletData url
RT.HDHtml
instance ToHamletData Bool where
toHamletData :: Bool -> HamletData
toHamletData = HamletData Void -> HamletData
HamletData (HamletData Void -> HamletData)
-> (Bool -> HamletData Void) -> Bool -> HamletData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> HamletData Void
forall url. Bool -> HamletData url
RT.HDBool
parseHamletTemplate :: MonadThrow m => HamletSettings -> String -> m HamletTemplate
parseHamletTemplate :: forall (m :: * -> *).
MonadThrow m =>
HamletSettings -> [Char] -> m HamletTemplate
parseHamletTemplate HamletSettings
set [Char]
str = HamletRT -> HamletTemplate
HamletTemplate (HamletRT -> HamletTemplate) -> m HamletRT -> m HamletTemplate
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` HamletSettings -> [Char] -> m HamletRT
forall (m :: * -> *).
MonadThrow m =>
HamletSettings -> [Char] -> m HamletRT
RT.parseHamletRT HamletSettings
set [Char]
str
readHamletTemplateFile :: (MonadThrow m, MonadIO m) => HamletSettings -> FilePath -> m HamletTemplate
readHamletTemplateFile :: forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
HamletSettings -> [Char] -> m HamletTemplate
readHamletTemplateFile HamletSettings
set [Char]
fp = do
ByteString
bs <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
S.readFile [Char]
fp
HamletSettings -> [Char] -> m HamletTemplate
forall (m :: * -> *).
MonadThrow m =>
HamletSettings -> [Char] -> m HamletTemplate
parseHamletTemplate HamletSettings
set ([Char] -> m HamletTemplate) -> [Char] -> m HamletTemplate
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
bs
renderHamletTemplate :: MonadThrow m => HamletTemplate -> Map Text HamletData -> m Html
renderHamletTemplate :: forall (m :: * -> *).
MonadThrow m =>
HamletTemplate -> Map Text HamletData -> m Html
renderHamletTemplate (HamletTemplate HamletRT
rt) Map Text HamletData
m =
Bool
-> HamletRT
-> HamletMap Void
-> (Void -> [(Text, Text)] -> Text)
-> m Html
forall (m :: * -> *) url.
MonadThrow m =>
Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
RT.renderHamletRT' Bool
True HamletRT
rt HamletMap Void
m' Void -> [(Text, Text)] -> Text
forall {p} {a}. Void -> p -> a
renderUrl
where
m' :: HamletMap Void
m' = ((Text, HamletData) -> ([[Char]], HamletData Void))
-> [(Text, HamletData)] -> HamletMap Void
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [[Char]]) -> (Text -> [Char]) -> Text -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [[Char]])
-> (HamletData -> HamletData Void)
-> (Text, HamletData)
-> ([[Char]], HamletData Void)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** HamletData -> HamletData Void
unHamletData) ([(Text, HamletData)] -> HamletMap Void)
-> [(Text, HamletData)] -> HamletMap Void
forall a b. (a -> b) -> a -> b
$ Map Text HamletData -> [(Text, HamletData)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text HamletData
m
renderUrl :: Void -> p -> a
renderUrl Void
url p
_ = Void -> a
forall a. Void -> a
absurd Void
url