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



parseHamletRT :: MonadThrow m
              => HamletSettings -> String -> m HamletRT
parseHamletRT :: forall (m :: * -> *).
MonadThrow m =>
HamletSettings -> String -> m HamletRT
parseHamletRT HamletSettings
set String
s =
    case HamletSettings -> String -> Result (Maybe NewlineStyle, [Doc])
parseDoc HamletSettings
set String
s of
        Error String
s' -> HamletException -> m HamletRT
forall e a. Exception e => e -> m a
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 (Maybe NewlineStyle
_, [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 (BindAs Ident
_ Binding
_) [Doc]
docs) =
       String -> m SimpleDoc
forall a. HasCallStack => String -> a
error String
"Runtime Hamlet does not currently support 'as' patterns"
    convert x :: Doc
x@(DocForall Deref
deref (BindVar (Ident String
ident)) [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Doc -> m SimpleDoc
convert [Doc]
docs
        SimpleDoc -> m SimpleDoc
forall a. a -> m a
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 String
"Runtime Hamlet does not currently support tuple patterns"
    convert x :: Doc
x@(DocMaybe Deref
deref (BindAs Ident
_ Binding
_) [Doc]
jdocs Maybe [Doc]
ndocs) =
       String -> m SimpleDoc
forall a. HasCallStack => String -> a
error String
"Runtime Hamlet does not currently support 'as' patterns"
    convert x :: Doc
x@(DocMaybe Deref
deref (BindVar (Ident String
ident)) [Doc]
jdocs 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Doc -> m SimpleDoc
convert) Maybe [Doc]
ndocs
        SimpleDoc -> m SimpleDoc
forall a. a -> m a
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 String
"Runtime Hamlet does not currently support tuple patterns"
    convert (DocContent (ContentRaw String
s')) = SimpleDoc -> m SimpleDoc
forall a. a -> m a
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)) = do
        [String]
y <- Doc -> Deref -> m [String]
forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
x Deref
deref
        SimpleDoc -> m SimpleDoc
forall a. a -> m a
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 Bool
p 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 a. a -> m a
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)) = do
        [String]
y <- Doc -> Deref -> m [String]
forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
x Deref
deref
        SimpleDoc -> m SimpleDoc
forall a. a -> m a
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 String
"Runtime hamlet does not currently support message interpolation"
    convert (DocContent ContentAttrs{}) =
        String -> m SimpleDoc
forall a. HasCallStack => String -> a
error String
"Runtime hamlet does not currently support attrs interpolation"

    convert x :: Doc
x@(DocCond [(Deref, [Doc])]
conds 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Doc -> m SimpleDoc
convert) Maybe [Doc]
els
        SimpleDoc -> m SimpleDoc
forall a. a -> m a
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 Ident
x) Deref
_, 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)
forall (m :: * -> *) a b. 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String
"True"], t SimpleDoc
docs'')
        go (Deref
deref, 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)
forall (m :: * -> *) a b. 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 a. a -> m a
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 String
"Runtime hamlet does not currently support $with"
    convert DocCase{} = String -> m SimpleDoc
forall a. HasCallStack => String -> a
error String
"Runtime hamlet does not currently support $case"

renderHamletRT :: MonadThrow m
               => HamletRT
               -> HamletMap url
               -> UrlRenderer url
               -> m Html
renderHamletRT :: forall (m :: * -> *) url.
MonadThrow m =>
HamletRT -> HamletMap url -> UrlRenderer url -> m Html
renderHamletRT = 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
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' :: forall (m :: * -> *) url.
MonadThrow m =>
Bool
-> HamletRT
-> HamletMap url
-> (url -> [(Text, Text)] -> Text)
-> m Html
renderHamletRT' Bool
tempAsHtml (HamletRT [SimpleDoc]
docs) HamletMap url
scope0 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 HamletMap url
_ (SDRaw String
s) = Html -> m Html
forall a. a -> m a
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 HamletMap url
scope (SDVar [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 Html
h -> Html -> m Html
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Html
h
            HamletData url
_ -> 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]
++ String
": expected HDHtml"
    go HamletMap url
scope (SDUrl Bool
p [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
            (Bool
False, HDUrl url
u) -> Html -> m Html
forall a. a -> m a
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 []
            (Bool
True, HDUrlParams url
u [(Text, Text)]
q) ->
                Html -> m Html
forall a. a -> m a
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
            (Bool
False, HamletData url
_) -> 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]
++ String
": expected HDUrl"
            (Bool
True, HamletData url
_) -> 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]
++ String
": expected HDUrlParams"
    go HamletMap url
scope (SDTemplate [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
            (Bool
False, HDTemplate 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
            (Bool
False, HamletData url
_) -> 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]
++ String
": expected HDTemplate"
            (Bool
True, HDHtml Html
h) -> Html -> m Html
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Html
h
            (Bool
True, HamletData url
_) -> 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]
++ String
": expected HDHtml"
    go HamletMap url
scope (SDForall [String]
n String
ident [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 [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
$ \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 (\([String]
x, 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
            HamletData url
_ -> 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]
++ String
": expected HDList"
    go HamletMap url
scope (SDMaybe [String]
n String
ident [SimpleDoc]
jdocs [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
        (HamletMap url
scope', [SimpleDoc]
docs') <-
            case HamletData url
v of
                HDMaybe Maybe (HamletMap url)
Nothing -> (HamletMap url, [SimpleDoc]) -> m (HamletMap url, [SimpleDoc])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HamletMap url
scope, [SimpleDoc]
ndocs)
                HDMaybe (Just 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 (\([String]
x, 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HamletMap url
scope', [SimpleDoc]
jdocs)
                HamletData url
_ -> 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]
++ String
": 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 HamletMap url
scope (SDCond [] [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 HamletMap url
scope (SDCond (([String]
b, [SimpleDoc]
docs'):[([String], [SimpleDoc])]
cs) [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 Bool
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 Bool
False -> HamletMap url -> SimpleDoc -> m Html
go HamletMap url
scope ([([String], [SimpleDoc])] -> [SimpleDoc] -> SimpleDoc
SDCond [([String], [SimpleDoc])]
cs [SimpleDoc]
els)
            HamletData url
_ -> 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]
++ String
": expected HDBool"
    lookup' :: MonadThrow m => [String] -> [String] -> HamletMap url -> m (HamletData url)
    lookup' :: forall (m :: * -> *) url.
MonadThrow m =>
[String] -> [String] -> HamletMap url -> m (HamletData url)
lookup' [String]
orig [String]
k 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
            Maybe (HamletData url)
Nothing | [String]
k [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"True"] -> HamletData url -> m (HamletData url)
forall a. a -> m a
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
            Maybe (HamletData url)
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]
++ String
": not found"
            Just HamletData url
x -> HamletData url -> m (HamletData url)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return HamletData url
x

fa :: MonadThrow m => String -> m a
fa :: forall (m :: * -> *) a. MonadThrow m => String -> m a
fa = HamletException -> m a
forall e a. Exception e => e -> 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] -> 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' :: forall (f :: * -> *). MonadThrow f => Doc -> Deref -> f [String]
flattenDeref' Doc
orig Deref
deref =
    case Deref -> Maybe [String]
flattenDeref Deref
deref of
        Maybe [String]
Nothing -> HamletException -> f [String]
forall e a. Exception e => e -> f a
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 [String]
x -> [String] -> f [String]
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
x