{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Hamlet
    ( -- * Plain HTML
      Html
    , shamlet
    , shamletFile
    , xshamlet
    , xshamletFile
      -- * Hamlet
    , HtmlUrl
    , Render
    , hamlet
    , hamletFile
    , hamletFileReload
    , xhamlet
    , xhamletFile
      -- * I18N Hamlet
    , HtmlUrlI18n
    , Translate
    , ihamlet
    , ihamletFile
    , ihamletFileReload
      -- * Type classes
    , ToAttributes (..)
      -- * Internal, for making more
    , HamletSettings (..)
    , NewlineStyle (..)
    , hamletWithSettings
    , hamletFileWithSettings
    , defaultHamletSettings
    , xhtmlHamletSettings
    , Env (..)
    , HamletRules (..)
    , hamletRules
    , ihamletRules
    , htmlRules
    , CloseStyle (..)
      -- * Used by generated code
    , condH
    , maybeH
    , asHtmlUrl
    , attrsToHtml
     -- * low-level
    , hamletFromString
    ) where

import Text.Shakespeare.Base
import Text.Hamlet.Parse
import Language.Haskell.TH.Syntax hiding (Module)
import Language.Haskell.TH.Quote
import Data.Char (isUpper, isDigit)
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import qualified Data.Text.Lazy as TL
import Text.Blaze.Html (Html, toHtml)
import Text.Blaze.Internal (preEscapedText)
import qualified Data.Foldable as F
import Control.Monad (mplus)
import Data.Monoid (mempty, mappend, mconcat)
import Control.Arrow ((***))
import Data.List (intercalate)

import Data.IORef
import qualified Data.Map as M
import System.IO.Unsafe (unsafePerformIO)
import System.Directory (getModificationTime)
import Data.Time (UTCTime)
import Text.Blaze.Html (preEscapedToHtml)

-- | Convert some value to a list of attribute pairs.
class ToAttributes a where
    toAttributes :: a -> [(Text, Text)]
instance ToAttributes (Text, Text) where
    toAttributes :: (Text, Text) -> [(Text, Text)]
toAttributes = (Text, Text) -> [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return
instance ToAttributes (String, String) where
    toAttributes :: (String, String) -> [(Text, Text)]
toAttributes (String
k, String
v) = [(String -> Text
pack String
k, String -> Text
pack String
v)]
instance ToAttributes [(Text, Text)] where
    toAttributes :: [(Text, Text)] -> [(Text, Text)]
toAttributes = [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id
instance ToAttributes [(String, String)] where
    toAttributes :: [(String, String)] -> [(Text, Text)]
toAttributes = ((String, String) -> (Text, Text))
-> [(String, String)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
pack (String -> Text)
-> (String -> Text) -> (String, String) -> (Text, Text)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Text
pack)

attrsToHtml :: [(Text, Text)] -> Html
attrsToHtml :: [(Text, Text)] -> Html
attrsToHtml =
    ((Text, Text) -> Html -> Html) -> Html -> [(Text, Text)] -> Html
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, Text) -> Html -> Html
forall a. ToMarkup a => (Text, a) -> Html -> Html
go Html
forall a. Monoid a => a
mempty
  where
    go :: (Text, a) -> Html -> Html
go (Text
k, a
v) Html
rest =
        String -> Html
forall a. ToMarkup a => a -> Html
toHtml String
" "
        Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` Text -> Html
preEscapedText Text
k
        Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` Text -> Html
preEscapedText (String -> Text
pack String
"=\"")
        Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` a -> Html
forall a. ToMarkup a => a -> Html
toHtml a
v
        Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` Text -> Html
preEscapedText (String -> Text
pack String
"\"")
        Html -> Html -> Html
forall a. Monoid a => a -> a -> a
`mappend` Html
rest

type Render url = url -> [(Text, Text)] -> Text
type Translate msg = msg -> Html

-- | A function generating an 'Html' given a URL-rendering function.
type HtmlUrl url = Render url -> Html

-- | A function generating an 'Html' given a message translator and a URL rendering function.
type HtmlUrlI18n msg url = Translate msg -> Render url -> Html

docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr Scope
scope [Doc]
docs = do
    [Exp]
exps <- (Doc -> Q Exp) -> [Doc] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env -> HamletRules -> Scope -> Doc -> Q Exp
docToExp Env
env HamletRules
hr Scope
scope) [Doc]
docs
    case [Exp]
exps of
        [] -> [|return ()|]
        [Exp
x] -> Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
x
        [Exp]
_ -> Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Stmt] -> Exp
DoE
#if MIN_VERSION_template_haskell(2,17,0)
                Nothing
#endif
                ([Stmt] -> Exp) -> [Stmt] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Stmt) -> [Exp] -> [Stmt]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Stmt
NoBindS [Exp]
exps

unIdent :: Ident -> String
unIdent :: Ident -> String
unIdent (Ident String
s) = String
s

bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)])
bindingPattern :: Binding -> Q (Pat, Scope)
bindingPattern (BindAs i :: Ident
i@(Ident String
s) Binding
b) = do
    Name
name <- String -> Q Name
newName String
s
    (Pat
newPattern, Scope
scope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
b
    (Pat, Scope) -> Q (Pat, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Pat -> Pat
AsP Name
name Pat
newPattern, (Ident
i, Name -> Exp
VarE Name
name)(Ident, Exp) -> Scope -> Scope
forall a. a -> [a] -> [a]
:Scope
scope)
bindingPattern (BindVar i :: Ident
i@(Ident String
s))
    | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_" = (Pat, Scope) -> Q (Pat, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat
WildP, [])
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
s = do
        (Pat, Scope) -> Q (Pat, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (Lit -> Pat
LitP (Lit -> Pat) -> Lit -> Pat
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read String
s, [])
    | Bool
otherwise = do
        Name
name <- String -> Q Name
newName String
s
        (Pat, Scope) -> Q (Pat, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Pat
VarP Name
name, [(Ident
i, Name -> Exp
VarE Name
name)])
bindingPattern (BindTuple [Binding]
is) = do
    ([Pat]
patterns, [Scope]
scopes) <- ([(Pat, Scope)] -> ([Pat], [Scope]))
-> Q [(Pat, Scope)] -> Q ([Pat], [Scope])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Pat, Scope)] -> ([Pat], [Scope])
forall a b. [(a, b)] -> ([a], [b])
unzip (Q [(Pat, Scope)] -> Q ([Pat], [Scope]))
-> Q [(Pat, Scope)] -> Q ([Pat], [Scope])
forall a b. (a -> b) -> a -> b
$ (Binding -> Q (Pat, Scope)) -> [Binding] -> Q [(Pat, Scope)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Binding -> Q (Pat, Scope)
bindingPattern [Binding]
is
    (Pat, Scope) -> Q (Pat, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pat] -> Pat
TupP [Pat]
patterns, [Scope] -> Scope
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Scope]
scopes)
bindingPattern (BindList [Binding]
is) = do
    ([Pat]
patterns, [Scope]
scopes) <- ([(Pat, Scope)] -> ([Pat], [Scope]))
-> Q [(Pat, Scope)] -> Q ([Pat], [Scope])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Pat, Scope)] -> ([Pat], [Scope])
forall a b. [(a, b)] -> ([a], [b])
unzip (Q [(Pat, Scope)] -> Q ([Pat], [Scope]))
-> Q [(Pat, Scope)] -> Q ([Pat], [Scope])
forall a b. (a -> b) -> a -> b
$ (Binding -> Q (Pat, Scope)) -> [Binding] -> Q [(Pat, Scope)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Binding -> Q (Pat, Scope)
bindingPattern [Binding]
is
    (Pat, Scope) -> Q (Pat, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pat] -> Pat
ListP [Pat]
patterns, [Scope] -> Scope
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Scope]
scopes)
bindingPattern (BindConstr DataConstr
con [Binding]
is) = do
    ([Pat]
patterns, [Scope]
scopes) <- ([(Pat, Scope)] -> ([Pat], [Scope]))
-> Q [(Pat, Scope)] -> Q ([Pat], [Scope])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Pat, Scope)] -> ([Pat], [Scope])
forall a b. [(a, b)] -> ([a], [b])
unzip (Q [(Pat, Scope)] -> Q ([Pat], [Scope]))
-> Q [(Pat, Scope)] -> Q ([Pat], [Scope])
forall a b. (a -> b) -> a -> b
$ (Binding -> Q (Pat, Scope)) -> [Binding] -> Q [(Pat, Scope)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Binding -> Q (Pat, Scope)
bindingPattern [Binding]
is
    (Pat, Scope) -> Q (Pat, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Pat] -> Pat
conP (DataConstr -> Name
mkConName DataConstr
con) [Pat]
patterns, [Scope] -> Scope
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Scope]
scopes)
bindingPattern (BindRecord DataConstr
con [(Ident, Binding)]
fields Bool
wild) = do
    let f :: (Ident, Binding) -> Q ((Name, Pat), Scope)
f (Ident String
field,Binding
b) =
           do (Pat
p,Scope
s) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
b
              ((Name, Pat), Scope) -> Q ((Name, Pat), Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> Name
mkName String
field,Pat
p),Scope
s)
    ([(Name, Pat)]
patterns, [Scope]
scopes) <- ([((Name, Pat), Scope)] -> ([(Name, Pat)], [Scope]))
-> Q [((Name, Pat), Scope)] -> Q ([(Name, Pat)], [Scope])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((Name, Pat), Scope)] -> ([(Name, Pat)], [Scope])
forall a b. [(a, b)] -> ([a], [b])
unzip (Q [((Name, Pat), Scope)] -> Q ([(Name, Pat)], [Scope]))
-> Q [((Name, Pat), Scope)] -> Q ([(Name, Pat)], [Scope])
forall a b. (a -> b) -> a -> b
$ ((Ident, Binding) -> Q ((Name, Pat), Scope))
-> [(Ident, Binding)] -> Q [((Name, Pat), Scope)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ident, Binding) -> Q ((Name, Pat), Scope)
f [(Ident, Binding)]
fields
    ([(Name, Pat)]
patterns1, Scope
scopes1) <- if Bool
wild
       then DataConstr -> [Ident] -> Q ([(Name, Pat)], Scope)
bindWildFields DataConstr
con ([Ident] -> Q ([(Name, Pat)], Scope))
-> [Ident] -> Q ([(Name, Pat)], Scope)
forall a b. (a -> b) -> a -> b
$ ((Ident, Binding) -> Ident) -> [(Ident, Binding)] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, Binding) -> Ident
forall a b. (a, b) -> a
fst [(Ident, Binding)]
fields
       else ([(Name, Pat)], Scope) -> Q ([(Name, Pat)], Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
    (Pat, Scope) -> Q (Pat, Scope)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [(Name, Pat)] -> Pat
RecP (DataConstr -> Name
mkConName DataConstr
con) ([(Name, Pat)]
patterns[(Name, Pat)] -> [(Name, Pat)] -> [(Name, Pat)]
forall a. [a] -> [a] -> [a]
++[(Name, Pat)]
patterns1), [Scope] -> Scope
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Scope]
scopes Scope -> Scope -> Scope
forall a. [a] -> [a] -> [a]
++ Scope
scopes1)

mkConName :: DataConstr -> Name
mkConName :: DataConstr -> Name
mkConName = String -> Name
mkName (String -> Name) -> (DataConstr -> String) -> DataConstr -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataConstr -> String
conToStr

conToStr :: DataConstr -> String
conToStr :: DataConstr -> String
conToStr (DCUnqualified (Ident String
x)) = String
x
conToStr (DCQualified (Module [String]
xs) (Ident String
x)) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
x]

conP :: Name -> [Pat] -> Pat
#if MIN_VERSION_template_haskell(2,18,0)
conP name = ConP name []
#else
conP :: Name -> [Pat] -> Pat
conP = Name -> [Pat] -> Pat
ConP
#endif

-- Wildcards bind all of the unbound fields to variables whose name
-- matches the field name.
--
-- For example: data R = C { f1, f2 :: Int }
-- C {..}           is equivalent to   C {f1=f1, f2=f2}
-- C {f1 = a, ..}   is equivalent to   C {f1=a,  f2=f2}
-- C {f2 = a, ..}   is equivalent to   C {f1=f1, f2=a}
bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])
bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], Scope)
bindWildFields DataConstr
conName [Ident]
fields = do
  [Name]
fieldNames <- DataConstr -> Q [Name]
recordToFieldNames DataConstr
conName
  let available :: Name -> Bool
available Name
n     = Name -> String
nameBase Name
n String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Ident -> String) -> [Ident] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> String
unIdent [Ident]
fields
  let remainingFields :: [Name]
remainingFields = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
available [Name]
fieldNames
  let mkPat :: Name -> Q ((Name, Pat), (Ident, Exp))
mkPat Name
n = do
        Name
e <- String -> Q Name
newName (Name -> String
nameBase Name
n)
        ((Name, Pat), (Ident, Exp)) -> Q ((Name, Pat), (Ident, Exp))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name
n,Name -> Pat
VarP Name
e), (String -> Ident
Ident (Name -> String
nameBase Name
n), Name -> Exp
VarE Name
e))
  ([((Name, Pat), (Ident, Exp))] -> ([(Name, Pat)], Scope))
-> Q [((Name, Pat), (Ident, Exp))] -> Q ([(Name, Pat)], Scope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((Name, Pat), (Ident, Exp))] -> ([(Name, Pat)], Scope)
forall a b. [(a, b)] -> ([a], [b])
unzip (Q [((Name, Pat), (Ident, Exp))] -> Q ([(Name, Pat)], Scope))
-> Q [((Name, Pat), (Ident, Exp))] -> Q ([(Name, Pat)], Scope)
forall a b. (a -> b) -> a -> b
$ (Name -> Q ((Name, Pat), (Ident, Exp)))
-> [Name] -> Q [((Name, Pat), (Ident, Exp))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> Q ((Name, Pat), (Ident, Exp))
mkPat [Name]
remainingFields

-- Important note! reify will fail if the record type is defined in the
-- same module as the reify is used. This means quasi-quoted Hamlet
-- literals will not be able to use wildcards to match record types
-- defined in the same module.
recordToFieldNames :: DataConstr -> Q [Name]
recordToFieldNames :: DataConstr -> Q [Name]
recordToFieldNames DataConstr
conStr = do
  -- use 'lookupValueName' instead of just using 'mkName' so we reify the
  -- data constructor and not the type constructor if their names match.
  Just Name
conName                <- String -> Q (Maybe Name)
lookupValueName (String -> Q (Maybe Name)) -> String -> Q (Maybe Name)
forall a b. (a -> b) -> a -> b
$ DataConstr -> String
conToStr DataConstr
conStr
  DataConI Name
_ Type
_ Name
typeName         <- Name -> Q Info
reify Name
conName
  TyConI (DataD Cxt
_ Name
_ [TyVarBndr]
_ Maybe Type
_ [Con]
cons [DerivClause]
_) <- Name -> Q Info
reify Name
typeName
  [[VarBangType]
fields] <- [[VarBangType]] -> Q [[VarBangType]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[VarBangType]
fields | RecC Name
name [VarBangType]
fields <- [Con]
cons, Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
conName]
  [Name] -> Q [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
fieldName | (Name
fieldName, Bang
_, Type
_) <- [VarBangType]
fields]

docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp
docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp
docToExp Env
env HamletRules
hr Scope
scope (DocForall Deref
list Binding
idents [Doc]
inside) = do
    let list' :: Exp
list' = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
list
    (Pat
pat, Scope
extraScope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
idents
    let scope' :: Scope
scope' = Scope
extraScope Scope -> Scope -> Scope
forall a. [a] -> [a] -> [a]
++ Scope
scope
    Exp
mh <- [|F.mapM_|]
    Exp
inside' <- Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr Scope
scope' [Doc]
inside
    let lam :: Exp
lam = [Pat] -> Exp -> Exp
LamE [Pat
pat] Exp
inside'
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
mh Exp -> Exp -> Exp
`AppE` Exp
lam Exp -> Exp -> Exp
`AppE` Exp
list'
docToExp Env
env HamletRules
hr Scope
scope (DocWith [] [Doc]
inside) = do
    Exp
inside' <- Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr Scope
scope [Doc]
inside
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
inside'
docToExp Env
env HamletRules
hr Scope
scope (DocWith ((Deref
deref, Binding
idents):[(Deref, Binding)]
dis) [Doc]
inside) = do
    let deref' :: Exp
deref' = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
deref
    (Pat
pat, Scope
extraScope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
idents
    let scope' :: Scope
scope' = Scope
extraScope Scope -> Scope -> Scope
forall a. [a] -> [a] -> [a]
++ Scope
scope
    Exp
inside' <- Env -> HamletRules -> Scope -> Doc -> Q Exp
docToExp Env
env HamletRules
hr Scope
scope' ([(Deref, Binding)] -> [Doc] -> Doc
DocWith [(Deref, Binding)]
dis [Doc]
inside)
    let lam :: Exp
lam = [Pat] -> Exp -> Exp
LamE [Pat
pat] Exp
inside'
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
lam Exp -> Exp -> Exp
`AppE` Exp
deref'
docToExp Env
env HamletRules
hr Scope
scope (DocMaybe Deref
val Binding
idents [Doc]
inside Maybe [Doc]
mno) = do
    let val' :: Exp
val' = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
val
    (Pat
pat, Scope
extraScope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
idents
    let scope' :: Scope
scope' = Scope
extraScope Scope -> Scope -> Scope
forall a. [a] -> [a] -> [a]
++ Scope
scope
    Exp
inside' <- Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr Scope
scope' [Doc]
inside
    let inside'' :: Exp
inside'' = [Pat] -> Exp -> Exp
LamE [Pat
pat] Exp
inside'
    Exp
ninside' <- case Maybe [Doc]
mno of
                    Maybe [Doc]
Nothing -> [|Nothing|]
                    Just [Doc]
no -> do
                        Exp
no' <- Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr Scope
scope [Doc]
no
                        Exp
j <- [|Just|]
                        Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
j Exp -> Exp -> Exp
`AppE` Exp
no'
    Exp
mh <- [|maybeH|]
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
mh Exp -> Exp -> Exp
`AppE` Exp
val' Exp -> Exp -> Exp
`AppE` Exp
inside'' Exp -> Exp -> Exp
`AppE` Exp
ninside'
docToExp Env
env HamletRules
hr Scope
scope (DocCond [(Deref, [Doc])]
conds Maybe [Doc]
final) = do
    [Exp]
conds' <- ((Deref, [Doc]) -> Q Exp) -> [(Deref, [Doc])] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Deref, [Doc]) -> Q Exp
go [(Deref, [Doc])]
conds
    Exp
final' <- case Maybe [Doc]
final of
                Maybe [Doc]
Nothing -> [|Nothing|]
                Just [Doc]
f -> do
                    Exp
f' <- Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr Scope
scope [Doc]
f
                    Exp
j <- [|Just|]
                    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
j Exp -> Exp -> Exp
`AppE` Exp
f'
    Exp
ch <- [|condH|]
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
ch Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
conds' Exp -> Exp -> Exp
`AppE` Exp
final'
  where
    go :: (Deref, [Doc]) -> Q Exp
    go :: (Deref, [Doc]) -> Q Exp
go (Deref
d, [Doc]
docs) = do
        let d' :: Exp
d' = Scope -> Deref -> Exp
derefToExp ((Ident
specialOrIdent, Name -> Exp
VarE 'or)(Ident, Exp) -> Scope -> Scope
forall a. a -> [a] -> [a]
:Scope
scope) Deref
d
        Exp
docs' <- Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr Scope
scope [Doc]
docs
        Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
          ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
          [Exp
d', Exp
docs']
docToExp Env
env HamletRules
hr Scope
scope (DocCase Deref
deref [(Binding, [Doc])]
cases) = do
    let exp_ :: Exp
exp_ = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
deref
    [Match]
matches <- ((Binding, [Doc]) -> Q Match) -> [(Binding, [Doc])] -> Q [Match]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Binding, [Doc]) -> Q Match
toMatch [(Binding, [Doc])]
cases
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp -> [Match] -> Exp
CaseE Exp
exp_ [Match]
matches
  where
    toMatch :: (Binding, [Doc]) -> Q Match
    toMatch :: (Binding, [Doc]) -> Q Match
toMatch (Binding
idents, [Doc]
inside) = do
        (Pat
pat, Scope
extraScope) <- Binding -> Q (Pat, Scope)
bindingPattern Binding
idents
        let scope' :: Scope
scope' = Scope
extraScope Scope -> Scope -> Scope
forall a. [a] -> [a] -> [a]
++ Scope
scope
        Exp
insideExp <- Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr Scope
scope' [Doc]
inside
        Match -> Q Match
forall (m :: * -> *) a. Monad m => a -> m a
return (Match -> Q Match) -> Match -> Q Match
forall a b. (a -> b) -> a -> b
$ Pat -> Body -> [Dec] -> Match
Match Pat
pat (Exp -> Body
NormalB Exp
insideExp) []
docToExp Env
env HamletRules
hr Scope
v (DocContent Content
c) = Env -> HamletRules -> Scope -> Content -> Q Exp
contentToExp Env
env HamletRules
hr Scope
v Content
c

contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp
contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp
contentToExp Env
_ HamletRules
hr Scope
_ (ContentRaw String
s) = do
    Exp
os <- [|preEscapedText . pack|]
    let s' :: Exp
s' = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
s
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ HamletRules -> Exp
hrFromHtml HamletRules
hr Exp -> Exp -> Exp
`AppE` (Exp
os Exp -> Exp -> Exp
`AppE` Exp
s')
contentToExp Env
_ HamletRules
hr Scope
scope (ContentVar Deref
d) = do
    Exp
str <- [|toHtml|]
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ HamletRules -> Exp
hrFromHtml HamletRules
hr Exp -> Exp -> Exp
`AppE` (Exp
str Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp Scope
scope Deref
d)
contentToExp Env
env HamletRules
hr Scope
scope (ContentUrl Bool
hasParams Deref
d) =
    case Env -> Maybe ((Exp -> Q Exp) -> Q Exp)
urlRender Env
env of
        Maybe ((Exp -> Q Exp) -> Q Exp)
Nothing -> String -> Q Exp
forall a. HasCallStack => String -> a
error String
"URL interpolation used, but no URL renderer provided"
        Just (Exp -> Q Exp) -> Q Exp
wrender -> (Exp -> Q Exp) -> Q Exp
wrender ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Exp
render -> do
            let render' :: Q Exp
render' = Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
render
            Exp
ou <- if Bool
hasParams
                    then [|\(u, p) -> $(render') u p|]
                    else [|\u -> $(render') u []|]
            let d' :: Exp
d' = Scope -> Deref -> Exp
derefToExp Scope
scope Deref
d
            Exp
pet <- [|toHtml|]
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ HamletRules -> Exp
hrFromHtml HamletRules
hr Exp -> Exp -> Exp
`AppE` (Exp
pet Exp -> Exp -> Exp
`AppE` (Exp
ou Exp -> Exp -> Exp
`AppE` Exp
d'))
contentToExp Env
env HamletRules
hr Scope
scope (ContentEmbed Deref
d) = HamletRules -> Env -> Exp -> Q Exp
hrEmbed HamletRules
hr Env
env (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Scope -> Deref -> Exp
derefToExp Scope
scope Deref
d
contentToExp Env
env HamletRules
hr Scope
scope (ContentMsg Deref
d) =
    case Env -> Maybe ((Exp -> Q Exp) -> Q Exp)
msgRender Env
env of
        Maybe ((Exp -> Q Exp) -> Q Exp)
Nothing -> String -> Q Exp
forall a. HasCallStack => String -> a
error String
"Message interpolation used, but no message renderer provided"
        Just (Exp -> Q Exp) -> Q Exp
wrender -> (Exp -> Q Exp) -> Q Exp
wrender ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Exp
render ->
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ HamletRules -> Exp
hrFromHtml HamletRules
hr Exp -> Exp -> Exp
`AppE` (Exp
render Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp Scope
scope Deref
d)
contentToExp Env
_ HamletRules
hr Scope
scope (ContentAttrs Deref
d) = do
    Exp
html <- [|attrsToHtml . toAttributes|]
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ HamletRules -> Exp
hrFromHtml HamletRules
hr Exp -> Exp -> Exp
`AppE` (Exp
html Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp Scope
scope Deref
d)

-- | "Simple Hamlet" quasi-quoter. May only be used to generate expressions.
--
-- Generated expressions have type 'Html'.
--
-- @
-- >>> 'putStrLn' ('Text.Blaze.Html.Renderer.renderHtml' ['shamlet'|\<div\>Hello, world!|])
-- \<div\>Hello, world!\</div\>
-- @
shamlet :: QuasiQuoter
shamlet :: QuasiQuoter
shamlet = Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings Q HamletRules
htmlRules HamletSettings
defaultHamletSettings

-- | Like 'shamlet', but produces XHTML.
xshamlet :: QuasiQuoter
xshamlet :: QuasiQuoter
xshamlet = Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings Q HamletRules
htmlRules HamletSettings
xhtmlHamletSettings

htmlRules :: Q HamletRules
htmlRules :: Q HamletRules
htmlRules = do
    Exp
i <- [|id|]
    HamletRules -> Q HamletRules
forall (m :: * -> *) a. Monad m => a -> m a
return (HamletRules -> Q HamletRules) -> HamletRules -> Q HamletRules
forall a b. (a -> b) -> a -> b
$ Exp
-> ((Env -> Q Exp) -> Q Exp)
-> (Env -> Exp -> Q Exp)
-> HamletRules
HamletRules Exp
i ((Env -> Q Exp) -> Env -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Maybe ((Exp -> Q Exp) -> Q Exp)
-> Maybe ((Exp -> Q Exp) -> Q Exp) -> Env
Env Maybe ((Exp -> Q Exp) -> Q Exp)
forall a. Maybe a
Nothing Maybe ((Exp -> Q Exp) -> Q Exp)
forall a. Maybe a
Nothing)) (\Env
_ Exp
b -> Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
b)

-- | Hamlet quasi-quoter. May only be used to generate expressions.
--
-- Generated expression have type @'HtmlUrl' url@, for some @url@.
--
-- @
-- data MyRoute = Home
--
-- render :: 'Render' MyRoute
-- render Home _ = \"/home\"
--
-- >>> 'putStrLn' ('Text.Blaze.Html.Renderer.String.renderHtml' (['hamlet'|\<a href=@{Home}\>Home|] render))
-- \<a href="\/home"\>Home\<\/a\>
-- @
hamlet :: QuasiQuoter
hamlet :: QuasiQuoter
hamlet = Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings Q HamletRules
hamletRules HamletSettings
defaultHamletSettings

-- | Like 'hamlet', but produces XHTML.
xhamlet :: QuasiQuoter
xhamlet :: QuasiQuoter
xhamlet = Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings Q HamletRules
hamletRules HamletSettings
xhtmlHamletSettings

asHtmlUrl :: HtmlUrl url -> HtmlUrl url
asHtmlUrl :: HtmlUrl url -> HtmlUrl url
asHtmlUrl = HtmlUrl url -> HtmlUrl url
forall a. a -> a
id

hamletRules :: Q HamletRules
hamletRules :: Q HamletRules
hamletRules = do
    Exp
i <- [|id|]
    let ur :: (Env -> Q Exp) -> Q Exp
ur Env -> Q Exp
f = do
            Name
r <- String -> Q Name
newName String
"_render"
            let env :: Env
env = Env :: Maybe ((Exp -> Q Exp) -> Q Exp)
-> Maybe ((Exp -> Q Exp) -> Q Exp) -> Env
Env
                    { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
urlRender = ((Exp -> Q Exp) -> Q Exp) -> Maybe ((Exp -> Q Exp) -> Q Exp)
forall a. a -> Maybe a
Just ((Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Name -> Exp
VarE Name
r))
                    , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
msgRender = Maybe ((Exp -> Q Exp) -> Q Exp)
forall a. Maybe a
Nothing
                    }
            Exp
h <- Env -> Q Exp
f Env
env
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
r] Exp
h
    HamletRules -> Q HamletRules
forall (m :: * -> *) a. Monad m => a -> m a
return (HamletRules -> Q HamletRules) -> HamletRules -> Q HamletRules
forall a b. (a -> b) -> a -> b
$ Exp
-> ((Env -> Q Exp) -> Q Exp)
-> (Env -> Exp -> Q Exp)
-> HamletRules
HamletRules Exp
i (Env -> Q Exp) -> Q Exp
ur Env -> Exp -> Q Exp
em
  where
    em :: Env -> Exp -> Q Exp
em (Env (Just (Exp -> Q Exp) -> Q Exp
urender) Maybe ((Exp -> Q Exp) -> Q Exp)
Nothing) Exp
e = do
        Exp
asHtmlUrl' <- [|asHtmlUrl|]
        (Exp -> Q Exp) -> Q Exp
urender ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Exp
ur' -> Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return ((Exp
asHtmlUrl' Exp -> Exp -> Exp
`AppE` Exp
e) Exp -> Exp -> Exp
`AppE` Exp
ur')
    em Env
_ Exp
_ = String -> Q Exp
forall a. HasCallStack => String -> a
error String
"bad Env"

-- | Hamlet quasi-quoter with internationalization. May only be used to generate
-- expressions.
--
-- Generated expressions have type @'HtmlUrlI18n' msg url@, for some @msg@ and
-- @url@.
--
-- @
-- data MyMsg = Hi | Bye
--
-- data MyRoute = Home
--
-- renderEnglish :: 'Translate' MyMsg
-- renderEnglish Hi  = \"hi\"
-- renderEnglish Bye = \"bye\"
--
-- renderUrl :: 'Render' MyRoute
-- renderUrl Home _ = \"/home\"
--
-- >>> 'putStrLn' ('Text.Blaze.Html.Renderer.renderHtml' (['ihamlet'|@{Home} _{Hi} _{Bye}|] renderEnglish renderUrl))
-- \<div\>/home hi bye \<div\>
-- @
ihamlet :: QuasiQuoter
ihamlet :: QuasiQuoter
ihamlet = Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings Q HamletRules
ihamletRules HamletSettings
defaultHamletSettings

ihamletRules :: Q HamletRules
ihamletRules :: Q HamletRules
ihamletRules = do
    Exp
i <- [|id|]
    let ur :: (Env -> Q Exp) -> Q Exp
ur Env -> Q Exp
f = do
            Name
u <- String -> Q Name
newName String
"_urender"
            Name
m <- String -> Q Name
newName String
"_mrender"
            let env :: Env
env = Env :: Maybe ((Exp -> Q Exp) -> Q Exp)
-> Maybe ((Exp -> Q Exp) -> Q Exp) -> Env
Env
                    { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
urlRender = ((Exp -> Q Exp) -> Q Exp) -> Maybe ((Exp -> Q Exp) -> Q Exp)
forall a. a -> Maybe a
Just ((Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Name -> Exp
VarE Name
u))
                    , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
msgRender = ((Exp -> Q Exp) -> Q Exp) -> Maybe ((Exp -> Q Exp) -> Q Exp)
forall a. a -> Maybe a
Just ((Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Name -> Exp
VarE Name
m))
                    }
            Exp
h <- Env -> Q Exp
f Env
env
            Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
m, Name -> Pat
VarP Name
u] Exp
h
    HamletRules -> Q HamletRules
forall (m :: * -> *) a. Monad m => a -> m a
return (HamletRules -> Q HamletRules) -> HamletRules -> Q HamletRules
forall a b. (a -> b) -> a -> b
$ Exp
-> ((Env -> Q Exp) -> Q Exp)
-> (Env -> Exp -> Q Exp)
-> HamletRules
HamletRules Exp
i (Env -> Q Exp) -> Q Exp
ur Env -> Exp -> Q Exp
em
  where
    em :: Env -> Exp -> Q Exp
em (Env (Just (Exp -> Q Exp) -> Q Exp
urender) (Just (Exp -> Q Exp) -> Q Exp
mrender)) Exp
e =
          (Exp -> Q Exp) -> Q Exp
urender ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Exp
ur' -> (Exp -> Q Exp) -> Q Exp
mrender ((Exp -> Q Exp) -> Q Exp) -> (Exp -> Q Exp) -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Exp
mr -> Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
e Exp -> Exp -> Exp
`AppE` Exp
mr Exp -> Exp -> Exp
`AppE` Exp
ur')
    em Env
_ Exp
_ = String -> Q Exp
forall a. HasCallStack => String -> a
error String
"bad Env"

-- | Quasiquoter that follows XHTML serialization rules and supports i18n.
--
-- @since 2.0.10
ixhamlet :: QuasiQuoter
ixhamlet :: QuasiQuoter
ixhamlet = Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings Q HamletRules
ihamletRules HamletSettings
xhtmlHamletSettings

hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
hamletWithSettings Q HamletRules
hr HamletSettings
set =
    QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
        { quoteExp :: String -> Q Exp
quoteExp = Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFromString Q HamletRules
hr HamletSettings
set
        }

data HamletRules = HamletRules
    { HamletRules -> Exp
hrFromHtml :: Exp
    , HamletRules -> (Env -> Q Exp) -> Q Exp
hrWithEnv :: (Env -> Q Exp) -> Q Exp
    , HamletRules -> Env -> Exp -> Q Exp
hrEmbed :: Env -> Exp -> Q Exp
    }

data Env = Env
    { Env -> Maybe ((Exp -> Q Exp) -> Q Exp)
urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
    , Env -> Maybe ((Exp -> Q Exp) -> Q Exp)
msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
    }

hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFromString Q HamletRules
qhr HamletSettings
set String
s = do
    HamletRules
hr <- Q HamletRules
qhr
    HamletRules -> (Env -> Q Exp) -> Q Exp
hrWithEnv HamletRules
hr ((Env -> Q Exp) -> Q Exp) -> (Env -> Q Exp) -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Env
env -> Env -> HamletRules -> Scope -> [Doc] -> Q Exp
docsToExp Env
env HamletRules
hr [] ([Doc] -> Q Exp) -> [Doc] -> Q Exp
forall a b. (a -> b) -> a -> b
$ HamletSettings -> String -> [Doc]
docFromString HamletSettings
set String
s

docFromString :: HamletSettings -> String -> [Doc]
docFromString :: HamletSettings -> String -> [Doc]
docFromString HamletSettings
set String
s =
    case HamletSettings -> String -> Result (Maybe NewlineStyle, [Doc])
parseDoc HamletSettings
set String
s of
        Error String
s' -> String -> [Doc]
forall a. HasCallStack => String -> a
error String
s'
        Ok (Maybe NewlineStyle
_, [Doc]
d) -> [Doc]
d

hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
hamletFileWithSettings :: Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFileWithSettings Q HamletRules
qhr HamletSettings
set String
fp = do
    String
contents <- String -> Q String
readFileRecompileQ String
fp
    Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFromString Q HamletRules
qhr HamletSettings
set String
contents

-- | Like 'hamlet', but reads an external file at compile time.
--
-- @
-- $('hamletFile' \"foo.hamlet\") :: 'HtmlUrl' MyRoute
-- @
hamletFile :: FilePath -> Q Exp
hamletFile :: String -> Q Exp
hamletFile = Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFileWithSettings Q HamletRules
hamletRules HamletSettings
defaultHamletSettings

-- | Like 'hamletFile', but the external file is parsed at runtime. Allows for
-- more rapid development, but should not be used in production.
hamletFileReload :: FilePath -> Q Exp
hamletFileReload :: String -> Q Exp
hamletFileReload = HamletRuntimeRules -> HamletSettings -> String -> Q Exp
hamletFileReloadWithSettings HamletRuntimeRules
runtimeRules HamletSettings
defaultHamletSettings
  where runtimeRules :: HamletRuntimeRules
runtimeRules = HamletRuntimeRules :: Bool -> HamletRuntimeRules
HamletRuntimeRules { hrrI18n :: Bool
hrrI18n = Bool
False }

-- | Like 'ihamletFile', but the external file is parsed at runtime. Allows for
-- more rapid development, but should not be used in production.
ihamletFileReload :: FilePath -> Q Exp
ihamletFileReload :: String -> Q Exp
ihamletFileReload = HamletRuntimeRules -> HamletSettings -> String -> Q Exp
hamletFileReloadWithSettings HamletRuntimeRules
runtimeRules HamletSettings
defaultHamletSettings
  where runtimeRules :: HamletRuntimeRules
runtimeRules = HamletRuntimeRules :: Bool -> HamletRuntimeRules
HamletRuntimeRules { hrrI18n :: Bool
hrrI18n = Bool
True }

-- | Like 'hamletFile', but produces XHTML.
xhamletFile :: FilePath -> Q Exp
xhamletFile :: String -> Q Exp
xhamletFile = Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFileWithSettings Q HamletRules
hamletRules HamletSettings
xhtmlHamletSettings

-- | Like 'shamlet', but reads an external file at compile time.
--
-- @
-- $('shamletFile' \"foo.hamlet\") :: 'Html'
-- @
shamletFile :: FilePath -> Q Exp
shamletFile :: String -> Q Exp
shamletFile = Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFileWithSettings Q HamletRules
htmlRules HamletSettings
defaultHamletSettings

-- | Like 'shamletFile', but produces XHTML.
xshamletFile :: FilePath -> Q Exp
xshamletFile :: String -> Q Exp
xshamletFile = Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFileWithSettings Q HamletRules
htmlRules HamletSettings
xhtmlHamletSettings

-- | Like 'ihamlet', but reads an external file at compile time.
--
-- @
-- $('ihamletFile' \"foo.hamlet\") :: 'HtmlUrlI18n' MyMsg MyRoute
-- @
ihamletFile :: FilePath -> Q Exp
ihamletFile :: String -> Q Exp
ihamletFile = Q HamletRules -> HamletSettings -> String -> Q Exp
hamletFileWithSettings Q HamletRules
ihamletRules HamletSettings
defaultHamletSettings

varName :: Scope -> String -> Exp
varName :: Scope -> String -> Exp
varName Scope
_ String
"" = String -> Exp
forall a. HasCallStack => String -> a
error String
"Illegal empty varName"
varName Scope
scope v :: String
v@(Char
_:String
_) = Exp -> Maybe Exp -> Exp
forall a. a -> Maybe a -> a
fromMaybe (String -> Exp
strToExp String
v) (Maybe Exp -> Exp) -> Maybe Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Ident -> Scope -> Maybe Exp
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> Ident
Ident String
v) Scope
scope

strToExp :: String -> Exp
strToExp :: String -> Exp
strToExp s :: String
s@(Char
c:String
_)
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
s = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read String
s
    | Char -> Bool
isUpper Char
c = Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
s
    | Bool
otherwise = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
s
strToExp String
"" = String -> Exp
forall a. HasCallStack => String -> a
error String
"strToExp on empty string"

-- | Checks for truth in the left value in each pair in the first argument. If
-- a true exists, then the corresponding right action is performed. Only the
-- first is performed. In there are no true values, then the second argument is
-- performed, if supplied.
condH :: Monad m => [(Bool, m ())] -> Maybe (m ()) -> m ()
condH :: [(Bool, m ())] -> Maybe (m ()) -> m ()
condH [(Bool, m ())]
bms Maybe (m ())
mm = m () -> Maybe (m ()) -> m ()
forall a. a -> Maybe a -> a
fromMaybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Maybe (m ()) -> m ()) -> Maybe (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> [(Bool, m ())] -> Maybe (m ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Bool
True [(Bool, m ())]
bms Maybe (m ()) -> Maybe (m ()) -> Maybe (m ())
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (m ())
mm

-- | Runs the second argument with the value in the first, if available.
-- Otherwise, runs the third argument, if available.
maybeH :: Monad m => Maybe v -> (v -> m ()) -> Maybe (m ()) -> m ()
maybeH :: Maybe v -> (v -> m ()) -> Maybe (m ()) -> m ()
maybeH Maybe v
mv v -> m ()
f Maybe (m ())
mm = m () -> Maybe (m ()) -> m ()
forall a. a -> Maybe a -> a
fromMaybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Maybe (m ()) -> m ()) -> Maybe (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (v -> m ()) -> Maybe v -> Maybe (m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> m ()
f Maybe v
mv Maybe (m ()) -> Maybe (m ()) -> Maybe (m ())
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (m ())
mm


type MTime = UTCTime
data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin | VTMsg | VTAttrs

type QueryParameters = [(Text, Text)]
type RenderUrl url   = (url -> QueryParameters -> Text)
type Shakespeare url = RenderUrl url -> Html
data VarExp msg url  = EPlain Html
                     | EUrl url
                     | EUrlParam (url, QueryParameters)
                     | EMixin (HtmlUrl url)
                     | EMixinI18n (HtmlUrlI18n msg url)
                     | EMsg msg

instance Show (VarExp msg url) where
  show :: VarExp msg url -> String
show (EPlain Html
html) = String
"EPlain"
  show (EUrl url
url) = String
"EUrl"
  show (EUrlParam (url, [(Text, Text)])
url) = String
"EUrlParam"
  show (EMixin HtmlUrl url
url) = String
"EMixin"
  show (EMixinI18n HtmlUrlI18n msg url
msg_url) = String
"EMixinI18n"
  show (EMsg msg
msg) = String
"EMsg"

getVars :: Content -> [(Deref, VarType)]
getVars :: Content -> [(Deref, VarType)]
getVars ContentRaw{}     = []
getVars (ContentVar Deref
d)   = [(Deref
d, VarType
VTPlain)]
getVars (ContentUrl Bool
False Deref
d) = [(Deref
d, VarType
VTUrl)]
getVars (ContentUrl Bool
True Deref
d) = [(Deref
d, VarType
VTUrlParam)]
getVars (ContentEmbed Deref
d) = [(Deref
d, VarType
VTMixin)]
getVars (ContentMsg Deref
d)   = [(Deref
d, VarType
VTMsg)]
getVars (ContentAttrs Deref
d) = [(Deref
d, VarType
VTAttrs)]

hamletUsedIdentifiers :: HamletSettings -> String -> [(Deref, VarType)]
hamletUsedIdentifiers :: HamletSettings -> String -> [(Deref, VarType)]
hamletUsedIdentifiers HamletSettings
settings =
    (Content -> [(Deref, VarType)]) -> [Content] -> [(Deref, VarType)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Content -> [(Deref, VarType)]
getVars ([Content] -> [(Deref, VarType)])
-> (String -> [Content]) -> String -> [(Deref, VarType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HamletSettings -> String -> [Content]
contentFromString HamletSettings
settings


data HamletRuntimeRules = HamletRuntimeRules {
                            HamletRuntimeRules -> Bool
hrrI18n :: Bool
                          }

hamletFileReloadWithSettings :: HamletRuntimeRules
                             -> HamletSettings -> FilePath -> Q Exp
hamletFileReloadWithSettings :: HamletRuntimeRules -> HamletSettings -> String -> Q Exp
hamletFileReloadWithSettings HamletRuntimeRules
hrr HamletSettings
settings String
fp = do
    String
s <- String -> Q String
readFileQ String
fp
    let b :: [(Deref, VarType)]
b = HamletSettings -> String -> [(Deref, VarType)]
hamletUsedIdentifiers HamletSettings
settings String
s
    [Exp]
c <- ((Deref, VarType) -> Q Exp) -> [(Deref, VarType)] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Deref, VarType) -> Q Exp
vtToExp [(Deref, VarType)]
b
    Exp
rt <- if HamletRuntimeRules -> Bool
hrrI18n HamletRuntimeRules
hrr
      then [|hamletRuntimeMsg settings fp|]
      else [|hamletRuntime settings fp|]
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
rt Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
ListE [Exp]
c
  where
    vtToExp :: (Deref, VarType) -> Q Exp
    vtToExp :: (Deref, VarType) -> Q Exp
vtToExp (Deref
d, VarType
vt) = do
        Exp
d' <- Deref -> Q Exp
forall t. Lift t => t -> Q Exp
lift Deref
d
        Exp
c' <- VarType -> Q Exp
toExp VarType
vt
        Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
          ([Maybe Exp] -> Exp) -> [Maybe Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
          [Exp
d', Exp
c' Exp -> Exp -> Exp
`AppE` Scope -> Deref -> Exp
derefToExp [] Deref
d]
      where
        toExp :: VarType -> Q Exp
toExp = VarType -> Q Exp
c
          where
            c :: VarType -> Q Exp
            c :: VarType -> Q Exp
c VarType
VTAttrs = [|EPlain . attrsToHtml . toAttributes|]
            c VarType
VTPlain = [|EPlain . toHtml|]
            c VarType
VTUrl = [|EUrl|]
            c VarType
VTUrlParam = [|EUrlParam|]
            c VarType
VTMixin = [|\r -> EMixin $ \c -> r c|]
            c VarType
VTMsg = [|EMsg|]

{-# NOINLINE reloadMapRef #-}
reloadMapRef :: IORef (M.Map FilePath (MTime, [Content]))
reloadMapRef :: IORef (Map String (MTime, [Content]))
reloadMapRef = IO (IORef (Map String (MTime, [Content])))
-> IORef (Map String (MTime, [Content]))
forall a. IO a -> a
unsafePerformIO (IO (IORef (Map String (MTime, [Content])))
 -> IORef (Map String (MTime, [Content])))
-> IO (IORef (Map String (MTime, [Content])))
-> IORef (Map String (MTime, [Content]))
forall a b. (a -> b) -> a -> b
$ Map String (MTime, [Content])
-> IO (IORef (Map String (MTime, [Content])))
forall a. a -> IO (IORef a)
newIORef Map String (MTime, [Content])
forall k a. Map k a
M.empty

lookupReloadMap :: FilePath -> IO (Maybe (MTime, [Content]))
lookupReloadMap :: String -> IO (Maybe (MTime, [Content]))
lookupReloadMap String
fp = do
  Map String (MTime, [Content])
reloads <- IORef (Map String (MTime, [Content]))
-> IO (Map String (MTime, [Content]))
forall a. IORef a -> IO a
readIORef IORef (Map String (MTime, [Content]))
reloadMapRef
  Maybe (MTime, [Content]) -> IO (Maybe (MTime, [Content]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MTime, [Content]) -> IO (Maybe (MTime, [Content])))
-> Maybe (MTime, [Content]) -> IO (Maybe (MTime, [Content]))
forall a b. (a -> b) -> a -> b
$ String -> Map String (MTime, [Content]) -> Maybe (MTime, [Content])
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
fp Map String (MTime, [Content])
reloads

insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
insertReloadMap :: String -> (MTime, [Content]) -> IO [Content]
insertReloadMap String
fp (MTime
mt, [Content]
content) = IORef (Map String (MTime, [Content]))
-> (Map String (MTime, [Content])
    -> (Map String (MTime, [Content]), [Content]))
-> IO [Content]
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Map String (MTime, [Content]))
reloadMapRef
  (\Map String (MTime, [Content])
reloadMap -> (String
-> (MTime, [Content])
-> Map String (MTime, [Content])
-> Map String (MTime, [Content])
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
fp (MTime
mt, [Content]
content) Map String (MTime, [Content])
reloadMap, [Content]
content))

contentFromString :: HamletSettings -> String -> [Content]
contentFromString :: HamletSettings -> String -> [Content]
contentFromString HamletSettings
set = (Doc -> Content) -> [Doc] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Content
justContent ([Doc] -> [Content]) -> (String -> [Doc]) -> String -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HamletSettings -> String -> [Doc]
docFromString HamletSettings
set
  where
    unsupported :: String -> a
unsupported String
msg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"hamletFileReload does not support " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg

    justContent :: Doc -> Content
    justContent :: Doc -> Content
justContent (DocContent Content
c) = Content
c
    justContent DocForall{} = String -> Content
forall a. String -> a
unsupported String
"$forall"
    justContent DocWith{} = String -> Content
forall a. String -> a
unsupported String
"$with"
    justContent DocMaybe{} = String -> Content
forall a. String -> a
unsupported String
"$maybe"
    justContent DocCase{} = String -> Content
forall a. String -> a
unsupported String
"$case"
    justContent DocCond{} = String -> Content
forall a. String -> a
unsupported String
"attribute conditionals"


hamletRuntime :: HamletSettings
              -> FilePath
              -> [(Deref, VarExp msg url)]
              -> Shakespeare url
hamletRuntime :: HamletSettings
-> String -> [(Deref, VarExp msg url)] -> Shakespeare url
hamletRuntime HamletSettings
settings String
fp [(Deref, VarExp msg url)]
cd RenderUrl url
render = IO Html -> Html
forall a. IO a -> a
unsafePerformIO (IO Html -> Html) -> IO Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    MTime
mtime <- IO MTime -> IO MTime
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO MTime -> IO MTime) -> IO MTime -> IO MTime
forall a b. (a -> b) -> a -> b
$ String -> IO MTime
getModificationTime String
fp
    Maybe (MTime, [Content])
mdata <- String -> IO (Maybe (MTime, [Content]))
lookupReloadMap String
fp
    case Maybe (MTime, [Content])
mdata of
      Just (MTime
lastMtime, [Content]
lastContents) ->
        if MTime
mtime MTime -> MTime -> Bool
forall a. Eq a => a -> a -> Bool
== MTime
lastMtime then Html -> IO Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> IO Html) -> Html -> IO Html
forall a b. (a -> b) -> a -> b
$ [Content] -> Html
go' [Content]
lastContents
          else ([Content] -> Html) -> IO [Content] -> IO Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Html
go' (IO [Content] -> IO Html) -> IO [Content] -> IO Html
forall a b. (a -> b) -> a -> b
$ MTime -> IO [Content]
newContent MTime
mtime
      Maybe (MTime, [Content])
Nothing -> ([Content] -> Html) -> IO [Content] -> IO Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Html
go' (IO [Content] -> IO Html) -> IO [Content] -> IO Html
forall a b. (a -> b) -> a -> b
$ MTime -> IO [Content]
newContent MTime
mtime
  where
    newContent :: MTime -> IO [Content]
newContent MTime
mtime = do
        String
s <- String -> IO String
readUtf8FileString String
fp
        String -> (MTime, [Content]) -> IO [Content]
insertReloadMap String
fp (MTime
mtime, HamletSettings -> String -> [Content]
contentFromString HamletSettings
settings String
s)

    go' :: [Content] -> Html
go' = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Content] -> [Html]) -> [Content] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Html) -> [Content] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ([(Deref, VarExp msg url)]
-> RenderUrl url
-> Translate msg
-> (Deref -> Html)
-> Content
-> Html
forall msg url.
RuntimeVars msg url
-> Render url
-> Translate msg
-> (Deref -> Html)
-> Content
-> Html
runtimeContentToHtml [(Deref, VarExp msg url)]
cd RenderUrl url
render (String -> Translate msg
forall a. HasCallStack => String -> a
error String
"I18n embed IMPOSSIBLE") Deref -> Html
forall p a. p -> a
handleMsgEx)
    handleMsgEx :: p -> a
handleMsgEx p
_ = String -> a
forall a. HasCallStack => String -> a
error String
"i18n _{} encountered, but did not use ihamlet"

type RuntimeVars msg url = [(Deref, VarExp msg url)]
hamletRuntimeMsg :: HamletSettings
              -> FilePath
              -> RuntimeVars msg url
              -> HtmlUrlI18n msg url
hamletRuntimeMsg :: HamletSettings
-> String -> RuntimeVars msg url -> HtmlUrlI18n msg url
hamletRuntimeMsg HamletSettings
settings String
fp RuntimeVars msg url
cd Translate msg
i18nRender Render url
render = IO Html -> Html
forall a. IO a -> a
unsafePerformIO (IO Html -> Html) -> IO Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    MTime
mtime <- IO MTime -> IO MTime
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO MTime -> IO MTime) -> IO MTime -> IO MTime
forall a b. (a -> b) -> a -> b
$ String -> IO MTime
getModificationTime String
fp
    Maybe (MTime, [Content])
mdata <- String -> IO (Maybe (MTime, [Content]))
lookupReloadMap String
fp
    case Maybe (MTime, [Content])
mdata of
      Just (MTime
lastMtime, [Content]
lastContents) ->
        if MTime
mtime MTime -> MTime -> Bool
forall a. Eq a => a -> a -> Bool
== MTime
lastMtime then Html -> IO Html
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> IO Html) -> Html -> IO Html
forall a b. (a -> b) -> a -> b
$ [Content] -> Html
go' [Content]
lastContents
          else ([Content] -> Html) -> IO [Content] -> IO Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Html
go' (IO [Content] -> IO Html) -> IO [Content] -> IO Html
forall a b. (a -> b) -> a -> b
$ MTime -> IO [Content]
newContent MTime
mtime
      Maybe (MTime, [Content])
Nothing -> ([Content] -> Html) -> IO [Content] -> IO Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Content] -> Html
go' (IO [Content] -> IO Html) -> IO [Content] -> IO Html
forall a b. (a -> b) -> a -> b
$ MTime -> IO [Content]
newContent MTime
mtime
  where
    newContent :: MTime -> IO [Content]
newContent MTime
mtime = do
        String
s <- String -> IO String
readUtf8FileString String
fp
        String -> (MTime, [Content]) -> IO [Content]
insertReloadMap String
fp (MTime
mtime, HamletSettings -> String -> [Content]
contentFromString HamletSettings
settings String
s)

    go' :: [Content] -> Html
go' = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Content] -> [Html]) -> [Content] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Html) -> [Content] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (RuntimeVars msg url
-> Render url
-> Translate msg
-> (Deref -> Html)
-> Content
-> Html
forall msg url.
RuntimeVars msg url
-> Render url
-> Translate msg
-> (Deref -> Html)
-> Content
-> Html
runtimeContentToHtml RuntimeVars msg url
cd Render url
render Translate msg
i18nRender Deref -> Html
handleMsg)
    handleMsg :: Deref -> Html
handleMsg Deref
d = case Deref -> RuntimeVars msg url -> Maybe (VarExp msg url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d RuntimeVars msg url
cd of
            Just (EMsg msg
s) -> Translate msg
i18nRender msg
s
            Maybe (VarExp msg url)
_ -> String -> Deref -> Html
forall a b. Show a => String -> a -> b
nothingError String
"EMsg for ContentMsg" Deref
d

nothingError :: Show a => String -> a -> b
nothingError :: String -> a -> b
nothingError String
expected a
d = String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but got Nothing for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
d

runtimeContentToHtml :: RuntimeVars msg url -> Render url -> Translate msg -> (Deref -> Html) -> Content -> Html
runtimeContentToHtml :: RuntimeVars msg url
-> Render url
-> Translate msg
-> (Deref -> Html)
-> Content
-> Html
runtimeContentToHtml RuntimeVars msg url
cd Render url
render Translate msg
i18nRender Deref -> Html
handleMsg = Content -> Html
go
  where
    go :: Content -> Html
    go :: Content -> Html
go (ContentMsg Deref
d) = Deref -> Html
handleMsg Deref
d
    go (ContentRaw String
s) = String -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml String
s
    go (ContentAttrs Deref
d) =
        case Deref -> RuntimeVars msg url -> Maybe (VarExp msg url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d RuntimeVars msg url
cd of
            Just (EPlain Html
s) -> Html
s
            Maybe (VarExp msg url)
_ -> String -> Html
forall a. HasCallStack => String -> a
error (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ Deref -> String
forall a. Show a => a -> String
show Deref
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": expected EPlain for ContentAttrs"
    go (ContentVar Deref
d) =
        case Deref -> RuntimeVars msg url -> Maybe (VarExp msg url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d RuntimeVars msg url
cd of
            Just (EPlain Html
s) -> Html
s
            Maybe (VarExp msg url)
_ -> String -> Html
forall a. HasCallStack => String -> a
error (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ Deref -> String
forall a. Show a => a -> String
show Deref
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": expected EPlain for ContentVar"
    go (ContentUrl Bool
False Deref
d) =
        case Deref -> RuntimeVars msg url -> Maybe (VarExp msg url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d RuntimeVars msg url
cd of
            Just (EUrl url
u) -> Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Render url
render url
u []
            Just VarExp msg url
wrong -> String -> Html
forall a. HasCallStack => String -> a
error (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$  String
"expected EUrl but got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarExp msg url -> String
forall a. Show a => a -> String
show VarExp msg url
wrong String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nfor: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Deref -> String
forall a. Show a => a -> String
show Deref
d
            Maybe (VarExp msg url)
_ -> String -> Deref -> Html
forall a b. Show a => String -> a -> b
nothingError String
"EUrl" Deref
d
    go (ContentUrl Bool
True Deref
d) =
        case Deref -> RuntimeVars msg url -> Maybe (VarExp msg url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d RuntimeVars msg url
cd of
            Just (EUrlParam (url
u, [(Text, Text)]
p)) ->
                Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Render url
render url
u [(Text, Text)]
p
            Maybe (VarExp msg url)
_ -> String -> Html
forall a. HasCallStack => String -> a
error (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ Deref -> String
forall a. Show a => a -> String
show Deref
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": expected EUrlParam"
    go (ContentEmbed Deref
d) = case Deref -> RuntimeVars msg url -> Maybe (VarExp msg url)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Deref
d RuntimeVars msg url
cd of
        Just (EMixin HtmlUrl url
m) -> HtmlUrl url
m Render url
render
        Just (EMixinI18n HtmlUrlI18n msg url
m) -> HtmlUrlI18n msg url
m Translate msg
i18nRender Render url
render
        Maybe (VarExp msg url)
_ -> String -> Html
forall a. HasCallStack => String -> a
error (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ Deref -> String
forall a. Show a => a -> String
show Deref
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": expected EMixin"