content: {-# 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
      { tplElements :: [TemplateElement]
      , tplOrigin   :: FilePath  -- Only for error messages.
      } deriving (Show, Eq, Generic, Binary, Typeable)
  
  
  --------------------------------------------------------------------------------
  instance Writable Template where
      -- Writing a template is impossible
      write _ _ = return ()
  
  
  --------------------------------------------------------------------------------
  instance IsString Template where
      fromString = readTemplate
  
  
  --------------------------------------------------------------------------------
  -- | Wrap the constructor to ensure trim is called.
  template :: FilePath -> [TemplateElement] -> Template
  template p = flip Template p . trim
  
  
  --------------------------------------------------------------------------------
  -- | Parse a string into a template.
  -- You should prefer 'compileTemplateItem' over this.
  readTemplate :: String -> Template
  readTemplate = either error (template origin) . parseTemplateElemsFile origin
    where
      origin = "{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 = let file = itemIdentifier item
                             in compileTemplateFile file (itemBody item)
  
  --------------------------------------------------------------------------------
  compileTemplateFile :: Identifier -> String -> Compiler Template
  compileTemplateFile file = either fail (return . template origin)
                           . parseTemplateElemsFile origin
    where
      origin = show file
  
  --------------------------------------------------------------------------------
  -- | Read a template, without metadata header
  templateBodyCompiler :: Compiler (Item Template)
  templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
      item <- getResourceBody
      file <- getUnderlying
      withItemBody (compileTemplateFile file) item
  
  --------------------------------------------------------------------------------
  -- | Read complete file contents as a template
  templateCompiler :: Compiler (Item Template)
  templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
      item <- getResourceString
      file <- getUnderlying
      withItemBody (compileTemplateFile file) 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 tpl context item = do
      body <- applyTemplate' (tplElements tpl) context item `catchError` handler
      return $ itemSetBody body item
    where
      tplName = tplOrigin tpl
      itemName = show $ itemIdentifier item
      handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++
          (if tplName == itemName
            then "interpolate template in item " ++ itemName
            else "apply template " ++ tplName ++ " to item " ++ itemName) ++
          ":\n" ++ intercalate ",\n" es
  
  
  
  --------------------------------------------------------------------------------
  applyTemplate'
      :: forall a.
         [TemplateElement] -- ^ Unwrapped Template
      -> Context a         -- ^ Context
      -> Item a            -- ^ Page
      -> Compiler String   -- ^ Resulting item
  applyTemplate' tes context x = go tes
    where
      context' :: String -> [String] -> Item a -> Compiler ContextField
      context' = unContext (context `mappend` missingField)
  
      go = fmap concat . mapM applyElem
  
      ---------------------------------------------------------------------------
  
      applyElem :: TemplateElement -> Compiler String
  
      applyElem TrimL = trimError
  
      applyElem TrimR = trimError
  
      applyElem (Chunk c) = return c
  
      applyElem (Expr e) = withErrorMessage evalMsg (applyStringExpr typeMsg e)
        where
          evalMsg = "In expr '$" ++ show e ++ "$'"
          typeMsg = "expr '$" ++ show e ++ "$'"
  
      applyElem Escaped = return "$"
  
      applyElem (If e t mf) = compilerTry (applyExpr e) >>= handle
        where
          f = maybe (return "") go mf
          handle (Right _)                      = go t
          handle (Left (CompilationNoResult _)) = f
          handle (Left (CompilationFailure es)) = debug (NonEmpty.toList es) >> f
          debug = compilerDebugEntries ("Hakyll.Web.Template.applyTemplate: " ++
              "[ERROR] in 'if' condition on expr '" ++ show e ++ "':")
  
      applyElem (For e b s) = withErrorMessage headMsg (applyExpr e) >>= \cf -> case cf of
          EmptyField     -> expected "list" "boolean" typeMsg
          StringField _  -> expected "list" "string" typeMsg
          ListField c xs -> withErrorMessage bodyMsg $ do
              sep <- maybe (return "") go s
              bs  <- mapM (applyTemplate' b c) xs
              return $ intercalate sep bs
        where
          headMsg = "In expr '$for(" ++ show e ++ ")$'"
          typeMsg = "loop expr '" ++ show e ++ "'"
          bodyMsg = "In loop context of '$for(" ++ show e ++ ")$'"
  
      applyElem (Partial e) = withErrorMessage headMsg $
          applyStringExpr typeMsg e >>= \p ->
          withErrorMessage inclMsg $ do
              tpl' <- loadBody (fromFilePath p)
              itemBody <$> applyTemplate tpl' context x
        where
          headMsg = "In expr '$partial(" ++ show e ++ ")$'"
          typeMsg = "partial expr '" ++ show e ++ "'"
          inclMsg = "In inclusion of '$partial(" ++ show e ++ ")$'"
  
      ---------------------------------------------------------------------------
  
      applyExpr :: TemplateExpr -> Compiler ContextField
  
      applyExpr (Ident (TemplateKey k)) = context' k [] x
  
      applyExpr (Call (TemplateKey k) args) = do
          args' <- mapM (\e -> applyStringExpr (typeMsg e) e) args
          context' k args' x
        where
          typeMsg e = "argument '" ++ show e ++ "'"
  
      applyExpr (StringLiteral s) = return (StringField s)
  
      ----------------------------------------------------------------------------
  
      applyStringExpr :: String -> TemplateExpr -> Compiler String
      applyStringExpr msg expr =
          applyExpr expr >>= getString
        where
          getString EmptyField      = expected "string" "boolean" msg
          getString (StringField s) = return s
          getString (ListField _ _) = expected "string" "list" msg
  
      expected typ act expr = fail $ unwords ["Hakyll.Web.Template.applyTemplate:",
          "expected", typ, "but got", act, "for", expr]
  
      -- expected to never happen with all templates constructed by 'template'
      trimError = fail $
          "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 identifier context item = do
      tpl <- loadBody identifier
      applyTemplate tpl context 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 item = do
      tpl <- compileTemplateItem item
      applyTemplate tpl context item
  
  
  --------------------------------------------------------------------------------
  unsafeReadTemplateFile :: FilePath -> Compiler Template
  unsafeReadTemplateFile file = do
      tpl <- unsafeCompiler $ readFile file
      compileTemplateFile (fromFilePath file) tpl
  {-# DEPRECATED unsafeReadTemplateFile "Use templateCompiler" #-}
  