{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Hakyll.Web.Template.Internal
    ( Template (..)
    , template
    , templateBodyCompiler
    , templateCompiler
    , applyTemplate
    , loadAndApplyTemplate
    , applyAsTemplate
    , readTemplate
    , compileTemplateItem
    , unsafeReadTemplateFile

    , module Hakyll.Web.Template.Internal.Element
    , module Hakyll.Web.Template.Internal.Trim
    ) where


--------------------------------------------------------------------------------
import           Control.Monad.Except                 (catchError)
import           Data.Binary                          (Binary)
import           Data.List                            (intercalate)
import qualified Data.List.NonEmpty                   as NonEmpty
import           Data.Typeable                        (Typeable)
import           GHC.Exts                             (IsString (..))
import           GHC.Generics                         (Generic)


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler
import           Hakyll.Core.Compiler.Internal
import           Hakyll.Core.Identifier
import           Hakyll.Core.Item
import           Hakyll.Core.Writable
import           Hakyll.Web.Template.Context
import           Hakyll.Web.Template.Internal.Element
import           Hakyll.Web.Template.Internal.Trim


--------------------------------------------------------------------------------
-- | Datatype used for template substitutions.
data Template = Template
    { Template -> [TemplateElement]
tplElements :: [TemplateElement]
    , Template -> FilePath
tplOrigin   :: FilePath  -- Only for error messages.
    } deriving (Int -> Template -> ShowS
[Template] -> ShowS
Template -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Template] -> ShowS
$cshowList :: [Template] -> ShowS
show :: Template -> FilePath
$cshow :: Template -> FilePath
showsPrec :: Int -> Template -> ShowS
$cshowsPrec :: Int -> Template -> ShowS
Show, Template -> Template -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Template -> Template -> Bool
$c/= :: Template -> Template -> Bool
== :: Template -> Template -> Bool
$c== :: Template -> Template -> Bool
Eq, forall x. Rep Template x -> Template
forall x. Template -> Rep Template x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Template x -> Template
$cfrom :: forall x. Template -> Rep Template x
Generic, Get Template
[Template] -> Put
Template -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Template] -> Put
$cputList :: [Template] -> Put
get :: Get Template
$cget :: Get Template
put :: Template -> Put
$cput :: Template -> Put
Binary, Typeable)


--------------------------------------------------------------------------------
instance Writable Template where
    -- Writing a template is impossible
    write :: FilePath -> Item Template -> IO ()
write FilePath
_ Item Template
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()


--------------------------------------------------------------------------------
instance IsString Template where
    fromString :: FilePath -> Template
fromString = FilePath -> Template
readTemplate


--------------------------------------------------------------------------------
-- | Wrap the constructor to ensure trim is called.
template :: FilePath -> [TemplateElement] -> Template
template :: FilePath -> [TemplateElement] -> Template
template FilePath
p = forall a b c. (a -> b -> c) -> b -> a -> c
flip [TemplateElement] -> FilePath -> Template
Template FilePath
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TemplateElement] -> [TemplateElement]
trim


--------------------------------------------------------------------------------
-- | Parse a string into a template.
-- You should prefer 'compileTemplateItem' over this.
readTemplate :: String -> Template
readTemplate :: FilePath -> Template
readTemplate = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => FilePath -> a
error (FilePath -> [TemplateElement] -> Template
template FilePath
origin) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Either FilePath [TemplateElement]
parseTemplateElemsFile FilePath
origin
  where
    origin :: FilePath
origin = FilePath
"{literal}"
{-# DEPRECATED readTemplate "Use templateCompiler instead" #-}

--------------------------------------------------------------------------------
-- | Parse an item body into a template.
-- Provides useful error messages in the 'Compiler' monad.
compileTemplateItem :: Item String -> Compiler Template
compileTemplateItem :: Item FilePath -> Compiler Template
compileTemplateItem Item FilePath
item = let file :: Identifier
file = forall a. Item a -> Identifier
itemIdentifier Item FilePath
item
                           in Identifier -> FilePath -> Compiler Template
compileTemplateFile Identifier
file (forall a. Item a -> a
itemBody Item FilePath
item)

--------------------------------------------------------------------------------
compileTemplateFile :: Identifier -> String -> Compiler Template
compileTemplateFile :: Identifier -> FilePath -> Compiler Template
compileTemplateFile Identifier
file = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [TemplateElement] -> Template
template FilePath
origin)
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Either FilePath [TemplateElement]
parseTemplateElemsFile FilePath
origin
  where
    origin :: FilePath
origin = forall a. Show a => a -> FilePath
show Identifier
file

--------------------------------------------------------------------------------
-- | Read a template, without metadata header
templateBodyCompiler :: Compiler (Item Template)
templateBodyCompiler :: Compiler (Item Template)
templateBodyCompiler = forall a.
(Binary a, Typeable a) =>
FilePath -> Compiler a -> Compiler a
cached FilePath
"Hakyll.Web.Template.templateBodyCompiler" forall a b. (a -> b) -> a -> b
$ do
    Item FilePath
item <- Compiler (Item FilePath)
getResourceBody
    Identifier
file <- Compiler Identifier
getUnderlying
    forall a b. (a -> Compiler b) -> Item a -> Compiler (Item b)
withItemBody (Identifier -> FilePath -> Compiler Template
compileTemplateFile Identifier
file) Item FilePath
item

--------------------------------------------------------------------------------
-- | Read complete file contents as a template
templateCompiler :: Compiler (Item Template)
templateCompiler :: Compiler (Item Template)
templateCompiler = forall a.
(Binary a, Typeable a) =>
FilePath -> Compiler a -> Compiler a
cached FilePath
"Hakyll.Web.Template.templateCompiler" forall a b. (a -> b) -> a -> b
$ do
    Item FilePath
item <- Compiler (Item FilePath)
getResourceString
    Identifier
file <- Compiler Identifier
getUnderlying
    forall a b. (a -> Compiler b) -> Item a -> Compiler (Item b)
withItemBody (Identifier -> FilePath -> Compiler Template
compileTemplateFile Identifier
file) Item FilePath
item


--------------------------------------------------------------------------------
-- | Interpolate template expressions from context values in a page
applyTemplate :: Template                -- ^ Template
              -> Context a               -- ^ Context
              -> Item a                  -- ^ Page
              -> Compiler (Item String)  -- ^ Resulting item
applyTemplate :: forall a.
Template -> Context a -> Item a -> Compiler (Item FilePath)
applyTemplate Template
tpl Context a
context Item a
item = do
    FilePath
body <- forall a.
[TemplateElement] -> Context a -> Item a -> Compiler FilePath
applyTemplate' (Template -> [TemplateElement]
tplElements Template
tpl) Context a
context Item a
item forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` forall {m :: * -> *} {a}. MonadFail m => [FilePath] -> m a
handler
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Item b -> Item a
itemSetBody FilePath
body Item a
item
  where
    tplName :: FilePath
tplName = Template -> FilePath
tplOrigin Template
tpl
    itemName :: FilePath
itemName = forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall a. Item a -> Identifier
itemIdentifier Item a
item
    handler :: [FilePath] -> m a
handler [FilePath]
es = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Hakyll.Web.Template.applyTemplate: Failed to " forall a. [a] -> [a] -> [a]
++
        (if FilePath
tplName forall a. Eq a => a -> a -> Bool
== FilePath
itemName
          then FilePath
"interpolate template in item " forall a. [a] -> [a] -> [a]
++ FilePath
itemName
          else FilePath
"apply template " forall a. [a] -> [a] -> [a]
++ FilePath
tplName forall a. [a] -> [a] -> [a]
++ FilePath
" to item " forall a. [a] -> [a] -> [a]
++ FilePath
itemName) forall a. [a] -> [a] -> [a]
++
        FilePath
":\n" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
",\n" [FilePath]
es



--------------------------------------------------------------------------------
applyTemplate'
    :: forall a.
       [TemplateElement] -- ^ Unwrapped Template
    -> Context a         -- ^ Context
    -> Item a            -- ^ Page
    -> Compiler String   -- ^ Resulting item
applyTemplate' :: forall a.
[TemplateElement] -> Context a -> Item a -> Compiler FilePath
applyTemplate' [TemplateElement]
tes Context a
context Item a
x = [TemplateElement] -> Compiler FilePath
go [TemplateElement]
tes
  where
    context' :: String -> [String] -> Item a -> Compiler ContextField
    context' :: FilePath -> [FilePath] -> Item a -> Compiler ContextField
context' = forall a.
Context a
-> FilePath -> [FilePath] -> Item a -> Compiler ContextField
unContext (Context a
context forall a. Monoid a => a -> a -> a
`mappend` forall a. Context a
missingField)

    go :: [TemplateElement] -> Compiler FilePath
go = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TemplateElement -> Compiler FilePath
applyElem

    ---------------------------------------------------------------------------

    applyElem :: TemplateElement -> Compiler String

    applyElem :: TemplateElement -> Compiler FilePath
applyElem TemplateElement
TrimL = forall {a}. Compiler a
trimError

    applyElem TemplateElement
TrimR = forall {a}. Compiler a
trimError

    applyElem (Chunk FilePath
c) = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
c

    applyElem (Expr TemplateExpr
e) = forall a. FilePath -> Compiler a -> Compiler a
withErrorMessage FilePath
evalMsg (FilePath -> TemplateExpr -> Compiler FilePath
applyStringExpr FilePath
typeMsg TemplateExpr
e)
      where
        evalMsg :: FilePath
evalMsg = FilePath
"In expr '$" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
"$'"
        typeMsg :: FilePath
typeMsg = FilePath
"expr '$" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
"$'"

    applyElem TemplateElement
Escaped = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"$"

    applyElem (If TemplateExpr
e [TemplateElement]
t Maybe [TemplateElement]
mf) = forall a.
Compiler a -> Compiler (Either (CompilerErrors FilePath) a)
compilerTry (TemplateExpr -> Compiler ContextField
applyExpr TemplateExpr
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b}. Either (CompilerErrors FilePath) b -> Compiler FilePath
handle
      where
        f :: Compiler FilePath
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"") [TemplateElement] -> Compiler FilePath
go Maybe [TemplateElement]
mf
        handle :: Either (CompilerErrors FilePath) b -> Compiler FilePath
handle (Right b
_)                      = [TemplateElement] -> Compiler FilePath
go [TemplateElement]
t
        handle (Left (CompilationNoResult [FilePath]
_)) = Compiler FilePath
f
        handle (Left (CompilationFailure NonEmpty FilePath
es)) = [FilePath] -> Compiler ()
debug (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty FilePath
es) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Compiler FilePath
f
        debug :: [FilePath] -> Compiler ()
debug = FilePath -> [FilePath] -> Compiler ()
compilerDebugEntries (FilePath
"Hakyll.Web.Template.applyTemplate: " forall a. [a] -> [a] -> [a]
++
            FilePath
"[ERROR] in 'if' condition on expr '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
"':")

    applyElem (For TemplateExpr
e [TemplateElement]
b Maybe [TemplateElement]
s) = forall a. FilePath -> Compiler a -> Compiler a
withErrorMessage FilePath
headMsg (TemplateExpr -> Compiler ContextField
applyExpr TemplateExpr
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ContextField
cf -> case ContextField
cf of
        ContextField
EmptyField     -> forall {m :: * -> *} {a}.
MonadFail m =>
FilePath -> FilePath -> FilePath -> m a
expected FilePath
"list" FilePath
"boolean" FilePath
typeMsg
        StringField FilePath
_  -> forall {m :: * -> *} {a}.
MonadFail m =>
FilePath -> FilePath -> FilePath -> m a
expected FilePath
"list" FilePath
"string" FilePath
typeMsg
        ListField Context a
c [Item a]
xs -> forall a. FilePath -> Compiler a -> Compiler a
withErrorMessage FilePath
bodyMsg forall a b. (a -> b) -> a -> b
$ do
            FilePath
sep <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"") [TemplateElement] -> Compiler FilePath
go Maybe [TemplateElement]
s
            [FilePath]
bs  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
[TemplateElement] -> Context a -> Item a -> Compiler FilePath
applyTemplate' [TemplateElement]
b Context a
c) [Item a]
xs
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
sep [FilePath]
bs
      where
        headMsg :: FilePath
headMsg = FilePath
"In expr '$for(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
")$'"
        typeMsg :: FilePath
typeMsg = FilePath
"loop expr '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
"'"
        bodyMsg :: FilePath
bodyMsg = FilePath
"In loop context of '$for(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
")$'"

    applyElem (Partial TemplateExpr
e) = forall a. FilePath -> Compiler a -> Compiler a
withErrorMessage FilePath
headMsg forall a b. (a -> b) -> a -> b
$
        FilePath -> TemplateExpr -> Compiler FilePath
applyStringExpr FilePath
typeMsg TemplateExpr
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
p ->
        forall a. FilePath -> Compiler a -> Compiler a
withErrorMessage FilePath
inclMsg forall a b. (a -> b) -> a -> b
$ do
            Template
tpl' <- forall a. (Binary a, Typeable a) => Identifier -> Compiler a
loadBody (FilePath -> Identifier
fromFilePath FilePath
p)
            forall a. Item a -> a
itemBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Template -> Context a -> Item a -> Compiler (Item FilePath)
applyTemplate Template
tpl' Context a
context Item a
x
      where
        headMsg :: FilePath
headMsg = FilePath
"In expr '$partial(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
")$'"
        typeMsg :: FilePath
typeMsg = FilePath
"partial expr '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
"'"
        inclMsg :: FilePath
inclMsg = FilePath
"In inclusion of '$partial(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show TemplateExpr
e forall a. [a] -> [a] -> [a]
++ FilePath
")$'"

    ---------------------------------------------------------------------------

    applyExpr :: TemplateExpr -> Compiler ContextField

    applyExpr :: TemplateExpr -> Compiler ContextField
applyExpr (Ident (TemplateKey FilePath
k)) = FilePath -> [FilePath] -> Item a -> Compiler ContextField
context' FilePath
k [] Item a
x

    applyExpr (Call (TemplateKey FilePath
k) [TemplateExpr]
args) = do
        [FilePath]
args' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\TemplateExpr
e -> FilePath -> TemplateExpr -> Compiler FilePath
applyStringExpr (forall a. Show a => a -> FilePath
typeMsg TemplateExpr
e) TemplateExpr
e) [TemplateExpr]
args
        FilePath -> [FilePath] -> Item a -> Compiler ContextField
context' FilePath
k [FilePath]
args' Item a
x
      where
        typeMsg :: a -> FilePath
typeMsg a
e = FilePath
"argument '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show a
e forall a. [a] -> [a] -> [a]
++ FilePath
"'"

    applyExpr (StringLiteral FilePath
s) = forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> ContextField
StringField FilePath
s)

    ----------------------------------------------------------------------------

    applyStringExpr :: String -> TemplateExpr -> Compiler String
    applyStringExpr :: FilePath -> TemplateExpr -> Compiler FilePath
applyStringExpr FilePath
msg TemplateExpr
expr =
        TemplateExpr -> Compiler ContextField
applyExpr TemplateExpr
expr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. MonadFail m => ContextField -> m FilePath
getString
      where
        getString :: ContextField -> m FilePath
getString ContextField
EmptyField      = forall {m :: * -> *} {a}.
MonadFail m =>
FilePath -> FilePath -> FilePath -> m a
expected FilePath
"string" FilePath
"boolean" FilePath
msg
        getString (StringField FilePath
s) = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s
        getString (ListField Context a
_ [Item a]
_) = forall {m :: * -> *} {a}.
MonadFail m =>
FilePath -> FilePath -> FilePath -> m a
expected FilePath
"string" FilePath
"list" FilePath
msg

    expected :: FilePath -> FilePath -> FilePath -> m a
expected FilePath
typ FilePath
act FilePath
expr = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Hakyll.Web.Template.applyTemplate:",
        FilePath
"expected", FilePath
typ, FilePath
"but got", FilePath
act, FilePath
"for", FilePath
expr]

    -- expected to never happen with all templates constructed by 'template'
    trimError :: Compiler a
trimError = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$
        FilePath
"Hakyll.Web.Template.applyTemplate: template not fully trimmed."


--------------------------------------------------------------------------------
-- | The following pattern is so common:
--
-- > tpl <- loadBody "templates/foo.html"
-- > someCompiler
-- >     >>= applyTemplate tpl context
--
-- That we have a single function which does this:
--
-- > someCompiler
-- >     >>= loadAndApplyTemplate "templates/foo.html" context
loadAndApplyTemplate :: Identifier              -- ^ Template identifier
                     -> Context a               -- ^ Context
                     -> Item a                  -- ^ Page
                     -> Compiler (Item String)  -- ^ Resulting item
loadAndApplyTemplate :: forall a.
Identifier -> Context a -> Item a -> Compiler (Item FilePath)
loadAndApplyTemplate Identifier
identifier Context a
context Item a
item = do
    Template
tpl <- forall a. (Binary a, Typeable a) => Identifier -> Compiler a
loadBody Identifier
identifier
    forall a.
Template -> Context a -> Item a -> Compiler (Item FilePath)
applyTemplate Template
tpl Context a
context Item a
item


--------------------------------------------------------------------------------
-- | It is also possible that you want to substitute @$key$@s within the body of
-- an item. This function does that by interpreting the item body as a template,
-- and then applying it to itself.
applyAsTemplate :: Context String          -- ^ Context
                -> Item String             -- ^ Item and template
                -> Compiler (Item String)  -- ^ Resulting item
applyAsTemplate :: Context FilePath -> Item FilePath -> Compiler (Item FilePath)
applyAsTemplate Context FilePath
context Item FilePath
item = do
    Template
tpl <- Item FilePath -> Compiler Template
compileTemplateItem Item FilePath
item
    forall a.
Template -> Context a -> Item a -> Compiler (Item FilePath)
applyTemplate Template
tpl Context FilePath
context Item FilePath
item


--------------------------------------------------------------------------------
unsafeReadTemplateFile :: FilePath -> Compiler Template
unsafeReadTemplateFile :: FilePath -> Compiler Template
unsafeReadTemplateFile FilePath
file = do
    FilePath
tpl <- forall a. IO a -> Compiler a
unsafeCompiler forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile FilePath
file
    Identifier -> FilePath -> Compiler Template
compileTemplateFile (FilePath -> Identifier
fromFilePath FilePath
file) FilePath
tpl
{-# DEPRECATED unsafeReadTemplateFile "Use templateCompiler" #-}