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