{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
-- | Provides functionality for runtime Hamlet templates. Please use
-- "Text.Hamlet.Runtime" instead.
module Text.Hamlet.RT
    ( -- * Public API
      HamletRT (..)
    , HamletData (..)
    , HamletMap
    , HamletException (..)
    , parseHamletRT
    , renderHamletRT
    , renderHamletRT'
    , SimpleDoc (..)
    ) where

import Text.Shakespeare.Base
import Data.Monoid (mconcat)
import Control.Monad (liftM, forM)
import Control.Exception (Exception)
import Data.Typeable (Typeable)
import Text.Hamlet.Parse
import Data.List (intercalate)
import Text.Blaze.Html (Html)
import Text.Blaze.Internal (preEscapedString, preEscapedText)
import Data.Text (Text)

import Control.Monad.Catch (MonadThrow, throwM)

type HamletMap url = [([String], HamletData url)]
type UrlRenderer url = (url -> [(Text, Text)] -> Text)

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 (Int -> HamletException -> ShowS
[HamletException] -> ShowS
HamletException -> String
(Int -> HamletException -> ShowS)
-> (HamletException -> String)
-> ([HamletException] -> ShowS)
-> Show HamletException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HamletException] -> ShowS
$cshowList :: [HamletException] -> ShowS
show :: HamletException -> String
$cshow :: HamletException -> String
showsPrec :: Int -> HamletException -> ShowS
$cshowsPrec :: Int -> HamletException -> ShowS
Show, Typeable)
instance Exception HamletException



parseHamletRT :: MonadThrow m
              => HamletSettings -> String -> m HamletRT
parseHamletRT :: HamletSettings -> String -> m HamletRT
parseHamletRT set :: HamletSettings
set s :: String
s =
    case HamletSettings -> String -> Result (Maybe NewlineStyle, [Doc])
parseDoc HamletSettings
set String
s of
        Error s' :: String
s' -> HamletException -> m HamletRT
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HamletException -> m HamletRT) -> HamletException -> m HamletRT
forall a b. (a -> b) -> a -> b
$ String -> HamletException
HamletParseException String
s'
        Ok (_, x :: [Doc]
x) -> ([SimpleDoc] -> HamletRT) -> m [SimpleDoc] -> m HamletRT
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [SimpleDoc] -> HamletRT
HamletRT (m [SimpleDoc] -> m HamletRT) -> m [SimpleDoc] -> m HamletRT
forall a b. (a -> b) -> a -> b
$ (Doc -> m SimpleDoc) -> [Doc] -> m [SimpleDoc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Doc -> m SimpleDoc
forall (m :: * -> *). MonadThrow m => Doc -> m SimpleDoc
convert [Doc]
x
  where
    convert :: Doc -> m SimpleDoc
convert x :: Doc
x@(DocForall deref :: Deref
deref (BindAs _ _) docs :: [Doc]
docs) =
       String -> m SimpleDoc
forall a. HasCallStack => String -> a
error "Runtime Hamlet does not currently support 'as' patterns"
    convert x :: Doc
x@(DocForall deref :: Deref
deref (BindVar (Ident ident :: String
ident)) docs :: [Doc]
docs) = do
        [String]
deref' <- Doc -> Deref -> m [String]
forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
x Deref
deref
        [SimpleDoc]
docs' <- (Doc -> m SimpleDoc) -> [Doc] -> m [SimpleDoc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Doc -> m SimpleDoc
convert [Doc]
docs
        SimpleDoc -> m SimpleDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleDoc -> m SimpleDoc) -> SimpleDoc -> m SimpleDoc
forall a b. (a -> b) -> a -> b
$ [String] -> String -> [SimpleDoc] -> SimpleDoc
SDForall [String]
deref' String
ident [SimpleDoc]
docs'
    convert DocForall{} = String -> m SimpleDoc
forall a. HasCallStack => String -> a
error "Runtime Hamlet does not currently support tuple patterns"
    convert x :: Doc
x@(DocMaybe deref :: Deref
deref (BindAs _ _) jdocs :: [Doc]
jdocs ndocs :: Maybe [Doc]
ndocs) =
       String -> m SimpleDoc
forall a. HasCallStack => String -> a
error "Runtime Hamlet does not currently support 'as' patterns"
    convert x :: Doc
x@(DocMaybe deref :: Deref
deref (BindVar (Ident ident :: String
ident)) jdocs :: [Doc]
jdocs ndocs :: Maybe [Doc]
ndocs) = do
        [String]
deref' <- Doc -> Deref -> m [String]
forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
x Deref
deref
        [SimpleDoc]
jdocs' <- (Doc -> m SimpleDoc) -> [Doc] -> m [SimpleDoc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Doc -> m SimpleDoc
convert [Doc]
jdocs
        [SimpleDoc]
ndocs' <- m [SimpleDoc]
-> ([Doc] -> m [SimpleDoc]) -> Maybe [Doc] -> m [SimpleDoc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([SimpleDoc] -> m [SimpleDoc]
forall (m :: * -> *) a. Monad m => a -> m a
return []) ((Doc -> m SimpleDoc) -> [Doc] -> m [SimpleDoc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Doc -> m SimpleDoc
convert) Maybe [Doc]
ndocs
        SimpleDoc -> m SimpleDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleDoc -> m SimpleDoc) -> SimpleDoc -> m SimpleDoc
forall a b. (a -> b) -> a -> b
$ [String] -> String -> [SimpleDoc] -> [SimpleDoc] -> SimpleDoc
SDMaybe [String]
deref' String
ident [SimpleDoc]
jdocs' [SimpleDoc]
ndocs'
    convert DocMaybe{} = String -> m SimpleDoc
forall a. HasCallStack => String -> a
error "Runtime Hamlet does not currently support tuple patterns"
    convert (DocContent (ContentRaw s' :: String
s')) = SimpleDoc -> m SimpleDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleDoc -> m SimpleDoc) -> SimpleDoc -> m SimpleDoc
forall a b. (a -> b) -> a -> b
$ String -> SimpleDoc
SDRaw String
s'
    convert x :: Doc
x@(DocContent (ContentVar deref :: Deref
deref)) = do
        [String]
y <- Doc -> Deref -> m [String]
forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
x Deref
deref
        SimpleDoc -> m SimpleDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleDoc -> m SimpleDoc) -> SimpleDoc -> m SimpleDoc
forall a b. (a -> b) -> a -> b
$ [String] -> SimpleDoc
SDVar [String]
y
    convert x :: Doc
x@(DocContent (ContentUrl p :: Bool
p deref :: Deref
deref)) = do
        [String]
y <- Doc -> Deref -> m [String]
forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
x Deref
deref
        SimpleDoc -> m SimpleDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleDoc -> m SimpleDoc) -> SimpleDoc -> m SimpleDoc
forall a b. (a -> b) -> a -> b
$ Bool -> [String] -> SimpleDoc
SDUrl Bool
p [String]
y
    convert x :: Doc
x@(DocContent (ContentEmbed deref :: Deref
deref)) = do
        [String]
y <- Doc -> Deref -> m [String]
forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
x Deref
deref
        SimpleDoc -> m SimpleDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleDoc -> m SimpleDoc) -> SimpleDoc -> m SimpleDoc
forall a b. (a -> b) -> a -> b
$ [String] -> SimpleDoc
SDTemplate [String]
y
    convert (DocContent ContentMsg{}) =
        String -> m SimpleDoc
forall a. HasCallStack => String -> a
error "Runtime hamlet does not currently support message interpolation"
    convert (DocContent ContentAttrs{}) =
        String -> m SimpleDoc
forall a. HasCallStack => String -> a
error "Runtime hamlet does not currently support attrs interpolation"

    convert x :: Doc
x@(DocCond conds :: [(Deref, [Doc])]
conds els :: Maybe [Doc]
els) = do
        [([String], [SimpleDoc])]
conds' <- ((Deref, [Doc]) -> m ([String], [SimpleDoc]))
-> [(Deref, [Doc])] -> m [([String], [SimpleDoc])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Deref, [Doc]) -> m ([String], [SimpleDoc])
forall (t :: * -> *).
Traversable t =>
(Deref, t Doc) -> m ([String], t SimpleDoc)
go [(Deref, [Doc])]
conds
        [SimpleDoc]
els' <- m [SimpleDoc]
-> ([Doc] -> m [SimpleDoc]) -> Maybe [Doc] -> m [SimpleDoc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([SimpleDoc] -> m [SimpleDoc]
forall (m :: * -> *) a. Monad m => a -> m a
return []) ((Doc -> m SimpleDoc) -> [Doc] -> m [SimpleDoc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Doc -> m SimpleDoc
convert) Maybe [Doc]
els
        SimpleDoc -> m SimpleDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleDoc -> m SimpleDoc) -> SimpleDoc -> m SimpleDoc
forall a b. (a -> b) -> a -> b
$ [([String], [SimpleDoc])] -> [SimpleDoc] -> SimpleDoc
SDCond [([String], [SimpleDoc])]
conds' [SimpleDoc]
els'
      where
        -- | See the comments in Text.Hamlet.Parse.testIncludeClazzes. The conditional
        -- added there doesn't work for runtime Hamlet, so we remove it here.
        go :: (Deref, t Doc) -> m ([String], t SimpleDoc)
go (DerefBranch (DerefIdent x :: Ident
x) _, docs' :: t Doc
docs') | Ident
x Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
specialOrIdent = do
            t SimpleDoc
docs'' <- (Doc -> m SimpleDoc) -> t Doc -> m (t SimpleDoc)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Doc -> m SimpleDoc
convert t Doc
docs'
            ([String], t SimpleDoc) -> m ([String], t SimpleDoc)
forall (m :: * -> *) a. Monad m => a -> m a
return (["True"], t SimpleDoc
docs'')
        go (deref :: Deref
deref, docs' :: t Doc
docs') = do
            [String]
deref' <- Doc -> Deref -> m [String]
forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
x Deref
deref
            t SimpleDoc
docs'' <- (Doc -> m SimpleDoc) -> t Doc -> m (t SimpleDoc)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Doc -> m SimpleDoc
convert t Doc
docs'
            ([String], t SimpleDoc) -> m ([String], t SimpleDoc)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
deref', t SimpleDoc
docs'')
    convert DocWith{} = String -> m SimpleDoc
forall a. HasCallStack => String -> a
error "Runtime hamlet does not currently support $with"
    convert DocCase{} = String -> m SimpleDoc
forall a. HasCallStack => String -> a
error "Runtime hamlet does not currently support $case"

renderHamletRT :: MonadThrow m
               => HamletRT
               -> HamletMap url
               -> UrlRenderer url
               -> m Html
renderHamletRT :: HamletRT -> HamletMap url -> UrlRenderer url -> m Html
renderHamletRT = Bool -> HamletRT -> HamletMap url -> UrlRenderer url -> m Html
forall (m :: * -> *) url.
MonadThrow m =>
Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
renderHamletRT' Bool
False

renderHamletRT' :: MonadThrow m
                => Bool -- ^ should embeded template (via ^{..}) be plain Html or actual templates?
                -> HamletRT
                -> HamletMap url
                -> (url -> [(Text, Text)] -> Text)
                -> m Html
renderHamletRT' :: Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
renderHamletRT' tempAsHtml :: Bool
tempAsHtml (HamletRT docs :: [SimpleDoc]
docs) scope0 :: HamletMap url
scope0 renderUrl :: url -> [(Text, Text)] -> Text
renderUrl =
    ([Html] -> Html) -> m [Html] -> m Html
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat (m [Html] -> m Html) -> m [Html] -> m Html
forall a b. (a -> b) -> a -> b
$ (SimpleDoc -> m Html) -> [SimpleDoc] -> m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HamletMap url -> SimpleDoc -> m Html
forall (m :: * -> *).
MonadThrow m =>
HamletMap url -> SimpleDoc -> m Html
go HamletMap url
scope0) [SimpleDoc]
docs
  where
    go :: HamletMap url -> SimpleDoc -> m Html
go _ (SDRaw s :: String
s) = Html -> m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ String -> Html
preEscapedString String
s
    go scope :: HamletMap url
scope (SDVar n :: [String]
n) = do
        HamletData url
v <- [String] -> [String] -> HamletMap url -> m (HamletData url)
forall (m :: * -> *) url.
MonadThrow m =>
[String] -> [String] -> HamletMap url -> m (HamletData url)
lookup' [String]
n [String]
n HamletMap url
scope
        case HamletData url
v of
            HDHtml h :: Html
h -> Html -> m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
h
            _ -> String -> m Html
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m Html) -> String -> m Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected HDHtml"
    go scope :: HamletMap url
scope (SDUrl p :: Bool
p n :: [String]
n) = do
        HamletData url
v <- [String] -> [String] -> HamletMap url -> m (HamletData url)
forall (m :: * -> *) url.
MonadThrow m =>
[String] -> [String] -> HamletMap url -> m (HamletData url)
lookup' [String]
n [String]
n HamletMap url
scope
        case (Bool
p, HamletData url
v) of
            (False, HDUrl u :: url
u) -> Html -> m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
preEscapedText (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ url -> [(Text, Text)] -> Text
renderUrl url
u []
            (True, HDUrlParams u :: url
u q :: [(Text, Text)]
q) ->
                Html -> m Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
preEscapedText (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ url -> [(Text, Text)] -> Text
renderUrl url
u [(Text, Text)]
q
            (False, _) -> String -> m Html
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m Html) -> String -> m Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected HDUrl"
            (True, _) -> String -> m Html
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m Html) -> String -> m Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected HDUrlParams"
    go scope :: HamletMap url
scope (SDTemplate n :: [String]
n) = do
        HamletData url
v <- [String] -> [String] -> HamletMap url -> m (HamletData url)
forall (m :: * -> *) url.
MonadThrow m =>
[String] -> [String] -> HamletMap url -> m (HamletData url)
lookup' [String]
n [String]
n HamletMap url
scope
        case (Bool
tempAsHtml, HamletData url
v) of
            (False, HDTemplate h :: HamletRT
h) -> Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
forall (m :: * -> *) url.
MonadThrow m =>
Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
renderHamletRT' Bool
tempAsHtml HamletRT
h HamletMap url
scope url -> [(Text, Text)] -> Text
renderUrl
            (False, _) -> String -> m Html
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m Html) -> String -> m Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected HDTemplate"
            (True, HDHtml h :: Html
h) -> Html -> m Html
forall (m :: * -> *) a. Monad m => a -> m a
return Html
h
            (True, _) -> String -> m Html
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m Html) -> String -> m Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected HDHtml"
    go scope :: HamletMap url
scope (SDForall n :: [String]
n ident :: String
ident docs' :: [SimpleDoc]
docs') = do
        HamletData url
v <- [String] -> [String] -> HamletMap url -> m (HamletData url)
forall (m :: * -> *) url.
MonadThrow m =>
[String] -> [String] -> HamletMap url -> m (HamletData url)
lookup' [String]
n [String]
n HamletMap url
scope
        case HamletData url
v of
            HDList os :: [HamletMap url]
os ->
                ([Html] -> Html) -> m [Html] -> m Html
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat (m [Html] -> m Html) -> m [Html] -> m Html
forall a b. (a -> b) -> a -> b
$ [HamletMap url] -> (HamletMap url -> m Html) -> m [Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [HamletMap url]
os ((HamletMap url -> m Html) -> m [Html])
-> (HamletMap url -> m Html) -> m [Html]
forall a b. (a -> b) -> a -> b
$ \o :: HamletMap url
o -> do
                    let scope' :: HamletMap url
scope' = (([String], HamletData url) -> ([String], HamletData url))
-> HamletMap url -> HamletMap url
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: [String]
x, y :: HamletData url
y) -> (String
ident String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
x, HamletData url
y)) HamletMap url
o HamletMap url -> HamletMap url -> HamletMap url
forall a. [a] -> [a] -> [a]
++ HamletMap url
scope
                    Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
forall (m :: * -> *) url.
MonadThrow m =>
Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
renderHamletRT' Bool
tempAsHtml ([SimpleDoc] -> HamletRT
HamletRT [SimpleDoc]
docs') HamletMap url
scope' url -> [(Text, Text)] -> Text
renderUrl
            _ -> String -> m Html
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m Html) -> String -> m Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected HDList"
    go scope :: HamletMap url
scope (SDMaybe n :: [String]
n ident :: String
ident jdocs :: [SimpleDoc]
jdocs ndocs :: [SimpleDoc]
ndocs) = do
        HamletData url
v <- [String] -> [String] -> HamletMap url -> m (HamletData url)
forall (m :: * -> *) url.
MonadThrow m =>
[String] -> [String] -> HamletMap url -> m (HamletData url)
lookup' [String]
n [String]
n HamletMap url
scope
        (scope' :: HamletMap url
scope', docs' :: [SimpleDoc]
docs') <-
            case HamletData url
v of
                HDMaybe Nothing -> (HamletMap url, [SimpleDoc]) -> m (HamletMap url, [SimpleDoc])
forall (m :: * -> *) a. Monad m => a -> m a
return (HamletMap url
scope, [SimpleDoc]
ndocs)
                HDMaybe (Just o :: HamletMap url
o) -> do
                    let scope' :: HamletMap url
scope' = (([String], HamletData url) -> ([String], HamletData url))
-> HamletMap url -> HamletMap url
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: [String]
x, y :: HamletData url
y) -> (String
ident String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
x, HamletData url
y)) HamletMap url
o HamletMap url -> HamletMap url -> HamletMap url
forall a. [a] -> [a] -> [a]
++ HamletMap url
scope
                    (HamletMap url, [SimpleDoc]) -> m (HamletMap url, [SimpleDoc])
forall (m :: * -> *) a. Monad m => a -> m a
return (HamletMap url
scope', [SimpleDoc]
jdocs)
                _ -> String -> m (HamletMap url, [SimpleDoc])
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m (HamletMap url, [SimpleDoc]))
-> String -> m (HamletMap url, [SimpleDoc])
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected HDMaybe"
        Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
forall (m :: * -> *) url.
MonadThrow m =>
Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
renderHamletRT' Bool
tempAsHtml ([SimpleDoc] -> HamletRT
HamletRT [SimpleDoc]
docs') HamletMap url
scope' url -> [(Text, Text)] -> Text
renderUrl
    go scope :: HamletMap url
scope (SDCond [] docs' :: [SimpleDoc]
docs') =
        Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
forall (m :: * -> *) url.
MonadThrow m =>
Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
renderHamletRT' Bool
tempAsHtml ([SimpleDoc] -> HamletRT
HamletRT [SimpleDoc]
docs') HamletMap url
scope url -> [(Text, Text)] -> Text
renderUrl
    go scope :: HamletMap url
scope (SDCond ((b :: [String]
b, docs' :: [SimpleDoc]
docs'):cs :: [([String], [SimpleDoc])]
cs) els :: [SimpleDoc]
els) = do
        HamletData url
v <- [String] -> [String] -> HamletMap url -> m (HamletData url)
forall (m :: * -> *) url.
MonadThrow m =>
[String] -> [String] -> HamletMap url -> m (HamletData url)
lookup' [String]
b [String]
b HamletMap url
scope
        case HamletData url
v of
            HDBool True ->
                Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
forall (m :: * -> *) url.
MonadThrow m =>
Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
renderHamletRT' Bool
tempAsHtml ([SimpleDoc] -> HamletRT
HamletRT [SimpleDoc]
docs') HamletMap url
scope url -> [(Text, Text)] -> Text
renderUrl
            HDBool False -> HamletMap url -> SimpleDoc -> m Html
go HamletMap url
scope ([([String], [SimpleDoc])] -> [SimpleDoc] -> SimpleDoc
SDCond [([String], [SimpleDoc])]
cs [SimpleDoc]
els)
            _ -> String -> m Html
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m Html) -> String -> m Html
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": expected HDBool"
    lookup' :: MonadThrow m => [String] -> [String] -> HamletMap url -> m (HamletData url)
    lookup' :: [String] -> [String] -> HamletMap url -> m (HamletData url)
lookup' orig :: [String]
orig k :: [String]
k m :: HamletMap url
m =
        case [String] -> HamletMap url -> Maybe (HamletData url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [String]
k HamletMap url
m of
            Nothing | [String]
k [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== ["True"] -> HamletData url -> m (HamletData url)
forall (m :: * -> *) a. Monad m => a -> m a
return (HamletData url -> m (HamletData url))
-> HamletData url -> m (HamletData url)
forall a b. (a -> b) -> a -> b
$ Bool -> HamletData url
forall url. Bool -> HamletData url
HDBool Bool
True
            Nothing -> String -> m (HamletData url)
forall (m :: * -> *) a. MonadThrow m => String -> m a
fa (String -> m (HamletData url)) -> String -> m (HamletData url)
forall a b. (a -> b) -> a -> b
$ [String] -> String
showName [String]
orig String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": not found"
            Just x :: HamletData url
x -> HamletData url -> m (HamletData url)
forall (m :: * -> *) a. Monad m => a -> m a
return HamletData url
x

fa :: MonadThrow m => String -> m a
fa :: String -> m a
fa = HamletException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HamletException -> m a)
-> (String -> HamletException) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HamletException
HamletRenderException

showName :: [String] -> String
showName :: [String] -> String
showName = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "." ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse

flattenDeref' :: MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' :: Doc -> Deref -> f [String]
flattenDeref' orig :: Doc
orig deref :: Deref
deref =
    case Deref -> Maybe [String]
flattenDeref Deref
deref of
        Nothing -> HamletException -> f [String]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (HamletException -> f [String]) -> HamletException -> f [String]
forall a b. (a -> b) -> a -> b
$ Doc -> HamletException
HamletUnsupportedDocException Doc
orig
        Just x :: [String]
x -> [String] -> f [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
x