content: --------------------------------------------------------------------------------
  -- | Module containing the elements used in a template.  A template is generally
  -- just a list of these elements.
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  module Hakyll.Web.Template.Internal.Element
      ( TemplateKey (..)
      , TemplateExpr (..)
      , TemplateElement (..)
      , templateElems
      , parseTemplateElemsFile
      ) where
  
  
  --------------------------------------------------------------------------------
  import           Control.Applicative     ((<|>))
  import           Control.Monad           (void)
  import           Control.Arrow           (left)
  import           Data.Binary             (Binary, get, getWord8, put, putWord8)
  import           Data.List               (intercalate)
  import           Data.Maybe              (isJust)
  import           Data.Typeable           (Typeable)
  import           GHC.Exts                (IsString (..))
  import qualified Text.Parsec             as P
  import qualified Text.Parsec.String      as P
  
  
  --------------------------------------------------------------------------------
  import           Hakyll.Core.Util.Parser
  
  
  --------------------------------------------------------------------------------
  newtype TemplateKey = TemplateKey String
      deriving (Binary, Show, Eq, Typeable)
  
  
  --------------------------------------------------------------------------------
  instance IsString TemplateKey where
      fromString = TemplateKey
  
  
  --------------------------------------------------------------------------------
  -- | Elements of a template.
  data TemplateElement
      = Chunk String
      | Expr TemplateExpr
      | Escaped
        -- expr, then, else
      | If TemplateExpr [TemplateElement] (Maybe [TemplateElement])
        -- expr, body, separator
      | For TemplateExpr [TemplateElement] (Maybe [TemplateElement])
        -- filename
      | Partial TemplateExpr
      | TrimL
      | TrimR
      deriving (Show, Eq, Typeable)
  
  
  --------------------------------------------------------------------------------
  instance Binary TemplateElement where
      put (Chunk string) = putWord8 0 >> put string
      put (Expr e)       = putWord8 1 >> put e
      put  Escaped       = putWord8 2
      put (If e t f)     = putWord8 3 >> put e >> put t >> put f
      put (For e b s)    = putWord8 4 >> put e >> put b >> put s
      put (Partial e)    = putWord8 5 >> put e
      put  TrimL         = putWord8 6
      put  TrimR         = putWord8 7
  
      get = getWord8 >>= \tag -> case tag of
          0 -> Chunk <$> get
          1 -> Expr <$> get
          2 -> pure Escaped
          3 -> If <$> get <*> get <*> get
          4 -> For <$> get <*> get <*> get
          5 -> Partial <$> get
          6 -> pure TrimL
          7 -> pure TrimR
          _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
  
  
  --------------------------------------------------------------------------------
  -- | Expression in a template
  data TemplateExpr
      = Ident TemplateKey
      | Call TemplateKey [TemplateExpr]
      | StringLiteral String
      deriving (Eq, Typeable)
  
  
  --------------------------------------------------------------------------------
  instance Show TemplateExpr where
      show (Ident (TemplateKey k))   = k
      show (Call (TemplateKey k) as) =
          k ++ "(" ++ intercalate ", " (map show as) ++ ")"
      show (StringLiteral s)         = show s
  
  
  --------------------------------------------------------------------------------
  instance Binary TemplateExpr where
      put (Ident k)         = putWord8 0 >> put k
      put (Call k as)       = putWord8 1 >> put k >> put as
      put (StringLiteral s) = putWord8 2 >> put s
  
      get = getWord8 >>= \tag -> case tag of
          0 -> Ident         <$> get
          1 -> Call          <$> get <*> get
          2 -> StringLiteral <$> get
          _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
  
  --------------------------------------------------------------------------------
  parseTemplateElemsFile :: FilePath -> String -> Either String [TemplateElement]
  parseTemplateElemsFile file = left (\e -> "Cannot parse template " ++ show e)
                              . P.parse (templateElems <* P.eof) file
  
  
  --------------------------------------------------------------------------------
  templateElems :: P.Parser [TemplateElement]
  templateElems = mconcat <$> P.many (P.choice [ lift chunk
                                               , lift escaped
                                               , conditional
                                               , for
                                               , partial
                                               , expr
                                               ])
      where lift = fmap (:[])
  
  
  --------------------------------------------------------------------------------
  chunk :: P.Parser TemplateElement
  chunk = Chunk <$> P.many1 (P.noneOf "$")
  
  
  --------------------------------------------------------------------------------
  expr :: P.Parser [TemplateElement]
  expr = P.try $ do
      trimLExpr <- trimOpen
      e <- expr'
      trimRExpr <- trimClose
      return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]
  
  
  --------------------------------------------------------------------------------
  expr' :: P.Parser TemplateExpr
  expr' = stringLiteral <|> call <|> ident
  
  
  --------------------------------------------------------------------------------
  escaped :: P.Parser TemplateElement
  escaped = Escaped <$ P.try (P.string "$$")
  
  
  --------------------------------------------------------------------------------
  trimOpen :: P.Parser Bool
  trimOpen = do
      void $ P.char '$'
      trimLIf <- P.optionMaybe $ P.try (P.char '-')
      pure $ isJust trimLIf
  
  
  --------------------------------------------------------------------------------
  trimClose :: P.Parser Bool
  trimClose = do
      trimIfR <- P.optionMaybe $ (P.char '-')
      void $ P.char '$'
      pure $ isJust trimIfR
  
  
  --------------------------------------------------------------------------------
  conditional :: P.Parser [TemplateElement]
  conditional = P.try $ do
      -- if
      trimLIf <- trimOpen
      void $ P.string "if("
      e <- expr'
      void $ P.char ')'
      trimRIf <- trimClose
      -- then
      thenBranch <- templateElems
      -- else
      elseParse <- opt "else"
      -- endif
      trimLEnd <- trimOpen
      void $ P.string "endif"
      trimREnd <- trimClose
  
      -- As else is optional we need to sort out where any Trim_s need to go.
      let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse
              where thenNoElse =
                        [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]
  
                    thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)
                        where thenB = [TrimR | trimRIf]
                                   ++ thenBranch
                                   ++ [TrimL | trimLElse]
  
                              elseB = Just $ [TrimR | trimRElse]
                                          ++ elseBranch
                                          ++ [TrimL | trimLEnd]
  
      pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]
  
  
  --------------------------------------------------------------------------------
  for :: P.Parser [TemplateElement]
  for = P.try $ do
      -- for
      trimLFor <- trimOpen
      void $ P.string "for("
      e <- expr'
      void $ P.char ')'
      trimRFor <- trimClose
      -- body
      bodyBranch <- templateElems
      -- sep
      sepParse <- opt "sep"
      -- endfor
      trimLEnd <- trimOpen
      void $ P.string "endfor"
      trimREnd <- trimClose
  
      -- As sep is optional we need to sort out where any Trim_s need to go.
      let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse
              where forNoSep =
                        [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]
  
                    forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)
                        where forB = [TrimR | trimRFor]
                                  ++ bodyBranch
                                  ++ [TrimL | trimLSep]
  
                              sepB = Just $ [TrimR | trimRSep]
                                         ++ sepBranch
                                         ++ [TrimL | trimLEnd]
  
      pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]
  
  
  --------------------------------------------------------------------------------
  partial :: P.Parser [TemplateElement]
  partial = P.try $ do
      trimLPart <- trimOpen
      void $ P.string "partial("
      e <- expr'
      void $ P.char ')'
      trimRPart <- trimClose
  
      pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]
  
  
  --------------------------------------------------------------------------------
  ident :: P.Parser TemplateExpr
  ident = P.try $ Ident <$> key
  
  
  --------------------------------------------------------------------------------
  call :: P.Parser TemplateExpr
  call = P.try $ do
      f <- key
      void $ P.char '('
      P.spaces
      as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)
      P.spaces
      void $ P.char ')'
      return $ Call f as
  
  
  --------------------------------------------------------------------------------
  stringLiteral :: P.Parser TemplateExpr
  stringLiteral = do
      void $ P.char '\"'
      str <- P.many $ do
          x <- P.noneOf "\""
          if x == '\\' then P.anyChar else return x
      void $ P.char '\"'
      return $ StringLiteral str
  
  
  --------------------------------------------------------------------------------
  key :: P.Parser TemplateKey
  key = TemplateKey <$> metadataKey
  
  
  --------------------------------------------------------------------------------
  opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))
  opt clause = P.optionMaybe $ P.try $ do
      trimL <- trimOpen
      void $ P.string clause
      trimR <- trimClose
      branch <- templateElems
      pure (trimL, branch, trimR)
  
  