summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web/Template/Internal/Element.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Web/Template/Internal/Element.hs')
-rw-r--r--src/Hakyll/Web/Template/Internal/Element.hs298
1 files changed, 298 insertions, 0 deletions
diff --git a/src/Hakyll/Web/Template/Internal/Element.hs b/src/Hakyll/Web/Template/Internal/Element.hs
new file mode 100644
index 0000000..f564355
--- /dev/null
+++ b/src/Hakyll/Web/Template/Internal/Element.hs
@@ -0,0 +1,298 @@
+--------------------------------------------------------------------------------
+-- | 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
+ , readTemplateElems
+ , readTemplateElemsFile
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Applicative ((<|>))
+import Control.Monad (void)
+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"
+
+
+--------------------------------------------------------------------------------
+readTemplateElems :: String -> [TemplateElement]
+readTemplateElems = readTemplateElemsFile "{literal}"
+
+
+--------------------------------------------------------------------------------
+readTemplateElemsFile :: FilePath -> String -> [TemplateElement]
+readTemplateElemsFile file input = case P.parse templateElems file input of
+ Left err -> error $ "Cannot parse template: " ++ show err
+ Right t -> t
+
+
+--------------------------------------------------------------------------------
+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.try (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)
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-07 03:44:07 +0000