diff options
Diffstat (limited to 'src/Hakyll/Web/Template/Internal/Element.hs')
| -rw-r--r-- | src/Hakyll/Web/Template/Internal/Element.hs | 298 |
1 files changed, 0 insertions, 298 deletions
diff --git a/src/Hakyll/Web/Template/Internal/Element.hs b/src/Hakyll/Web/Template/Internal/Element.hs deleted file mode 100644 index f564355..0000000 --- a/src/Hakyll/Web/Template/Internal/Element.hs +++ /dev/null @@ -1,298 +0,0 @@ --------------------------------------------------------------------------------- --- | 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) - |