simple-templates 0.6.0 → 0.7.0
raw patch · 5 files changed
+25/−127 lines, 5 filesdep −bytestringdep −filepathdep −mime-types
Dependencies removed: bytestring, filepath, mime-types, simple, transformers
Files
- simple-templates.cabal +2/−8
- src/Web/Simple/Templates.hs +0/−105
- src/Web/Simple/Templates/Language.hs +17/−10
- src/Web/Simple/Templates/Parser.hs +4/−2
- src/Web/Simple/Templates/Types.hs +2/−2
simple-templates.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: simple-templates-version: 0.6.0+version: 0.7.0 synopsis: A basic template language for the Simple web framework description: A basic template language for the Simple web framework. The language supports@@ -24,20 +24,14 @@ hs-source-dirs: src ghc-options: -Wall -fno-warn-unused-do-bind exposed-modules:- Web.Simple.Templates- , Web.Simple.Templates.Language+ Web.Simple.Templates.Language , Web.Simple.Templates.Parser , Web.Simple.Templates.Types build-depends: base < 6 , aeson- , bytestring , attoparsec- , filepath- , mime-types- , simple >= 0.6 , text- , transformers , unordered-containers , vector default-language: Haskell2010
− src/Web/Simple/Templates.hs
@@ -1,105 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Web.Simple.Templates- ( HasTemplates(..)- , defaultGetTemplate, defaultRender- , H.fromList- , Function(..), ToFunction(..), FunctionMap- ) where--import Control.Applicative-import Control.Monad.IO.Class-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified Data.HashMap.Strict as H-import qualified Data.Text as T-import Data.Text.Encoding-import Data.Aeson-import Network.Mime-import System.FilePath-import Web.Simple (Controller, ok, respond)-import Web.Simple.Templates.Language-import Web.Simple.Templates.Types--class HasTemplates hs where- -- | The layout to use by default. Layouts are just templates that embed- -- views. They are rendered with the a global object containing the rendered- -- view in the \"yield\" field, and the object the view was rendered with in- -- the \"page\" field. By default, no template is used.- defaultLayout :: Controller hs (Maybe Template)- defaultLayout = return Nothing-- -- | The directory to look for views passed to 'render'. This defaults to- -- \"views\", so- --- -- @- -- render \"index.html.tmpl\" ...- -- @- --- -- will look for a view template in \"views/index.html.tmpl\".- viewDirectory :: Controller hs FilePath- viewDirectory = return "views"-- -- | A map of pure functions that can be called from within a template. See- -- 'FunctionMap' and 'Function' for details.- functionMap :: Controller hs FunctionMap- functionMap = return H.empty-- -- | Function to use to get a template. By default, it looks in the- -- 'viewDirectory' for the given file name and compiles the file into a- -- template. This can be overriden to, for example, cache compiled templates- -- in memory.- getTemplate :: FilePath -> Controller hs Template- getTemplate = defaultGetTemplate-- -- | Renders a view template with the default layout and a global used to- -- evaluate variables in the template.- render :: ToJSON a => FilePath -> a -> Controller hs ()- render = defaultRender-- -- | Same as 'render' but without a template.- renderPlain :: ToJSON a => FilePath -> a -> Controller hs ()- renderPlain fp val = do- fm <- functionMap- dir <- viewDirectory- tmpl <- getTemplate (dir </> fp)- let pageContent =- L.fromChunks . (:[]) . encodeUtf8 $- renderTemplate tmpl fm $ toJSON val- let mime = defaultMimeLookup $ T.pack $ takeFileName fp- respond $ ok mime pageContent-- -- | Render a view using the layout named by the first argument.- renderLayout :: ToJSON a => FilePath -> FilePath -> a -> Controller hs ()- renderLayout lfp fp val = do- layout <- getTemplate lfp- renderLayout' layout fp val-- -- | Same as 'renderLayout' but uses an already compiled layout.- renderLayout' :: ToJSON a => Template -> FilePath -> a -> Controller hs ()- renderLayout' layout fp val = do- fm <- functionMap- dir <- viewDirectory- tmpl <- getTemplate (dir </> fp)- let pageContent =- L.fromChunks . (:[]) . encodeUtf8 $- renderTemplate tmpl fm $ toJSON val- let mime = defaultMimeLookup $ T.pack $ takeFileName fp- respond $ ok mime $ L.fromChunks . (:[]) . encodeUtf8 $- renderTemplate layout fm $ object ["yield" .= pageContent, "page" .= val]--defaultGetTemplate :: HasTemplates hs => FilePath -> Controller hs Template-defaultGetTemplate fp = do- eres <- compileTemplate . decodeUtf8 <$>- liftIO (S.readFile fp)- case eres of- Left str -> fail str- Right tmpl -> return tmpl--defaultRender :: (HasTemplates hs , ToJSON a)- => FilePath -> a -> Controller hs ()-defaultRender fp val = do- mlayout <- defaultLayout- case mlayout of- Nothing -> renderPlain fp val- Just layout -> renderLayout' layout fp val-
src/Web/Simple/Templates/Language.hs view
@@ -32,6 +32,7 @@ compileTemplate, evaluate, evaluateAST -- * Helpers , valueToText, replaceVar+ , module Web.Simple.Templates.Types ) where import Control.Applicative@@ -86,30 +87,36 @@ evaluateAST fm global falseBranch else evaluateAST fm global trueBranch - ASTFor varName lst body msep -> astForLoop fm global varName lst body msep+ ASTFor mkeyName valName lst body msep ->+ astForLoop fm global mkeyName valName lst body msep astForLoop :: FunctionMap -> Value- -> Identifier -> AST -> AST -> Maybe AST -> Value-astForLoop fm global varName lst body msep =+ -> Maybe Identifier -> Identifier+ -> AST -> AST -> Maybe AST -> Value+astForLoop fm global mkeyName valName lst body msep = case val of Null -> String "" Bool False -> String "" Array vec ->- String $ go (V.toList vec) mempty- v -> evaluateAST fm (replaceVar global varName v) body+ String $ go (zip [0..(V.length vec)] $ V.toList vec) mempty+ Object obj -> String $ go (H.toList obj) mempty+ v -> evaluateAST fm (replaceVar global valName v) body where sep = maybe (String "") (evaluateAST fm global) msep val = evaluateAST fm global lst go [] accm = accm- go (v:[]) accm =- let scope = replaceVar global varName v+ go ((k,v):[]) accm =+ let scope = replaceVar (mreplaceKey k) valName v nv = evaluateAST fm scope body in accm <> valueToText nv- go (v:x1:xs) accm =- let scope = replaceVar global varName v+ go ((k,v):x1:xs) accm =+ let scope = replaceVar (mreplaceKey k) valName v nv = evaluateAST fm scope body accmN = accm <> valueToText nv <> valueToText sep in go (x1:xs) accmN+ mreplaceKey :: ToJSON a => a -> Value+ mreplaceKey v =+ maybe global (\k -> replaceVar global k $ toJSON v) mkeyName replaceVar :: Value -> Identifier -> Value -> Value replaceVar (Object orig) varName newVal = Object $ H.insert varName newVal orig@@ -127,7 +134,7 @@ Bool b -> T.pack $ show b Array _ -> "[array]" Object _ -> "[object]"- Null -> "null"+ Null -> "" compileTemplate :: Text -> Either String Template compileTemplate tmpl = evaluate <$>
src/Web/Simple/Templates/Parser.hs view
@@ -10,6 +10,7 @@ , pIf, pFor , pFunc, pValue, pVar , pIndex, pIdentifier, pLiteral, pNull, pBoolean, pString, pNumber, pArray+ , module Web.Simple.Templates.Types ) where import Control.Applicative@@ -66,7 +67,8 @@ pFor = do A.string "for" brace <- A.satisfy (\c -> c == ' ' || c == '(')- varName <- pIdentifier+ mkeyName <- optional $ pIdentifier <* A.char ','+ valName <- pIdentifier A.string " in " lst <- pValue when (brace == '(') $ A.char ')' >> return ()@@ -76,7 +78,7 @@ A.string "$sep$" Just <$> pAST A.string "$endfor"- return $ ASTFor varName lst loop sep+ return $ ASTFor mkeyName valName lst loop sep -- | A variable, function call, literal, etc pValue :: A.Parser AST
src/Web/Simple/Templates/Types.hs view
@@ -78,8 +78,8 @@ -- ^ A literal array (may contain non-literals) | ASTIf AST AST (Maybe AST) -- ^ If - condition, true branch and optional false branch- | ASTFor Identifier AST AST (Maybe AST)- -- ^ for(i in expr) body separator+ | ASTFor (Maybe Identifier) Identifier AST AST (Maybe AST)+ -- ^ for([k,]v in expr) body separator deriving (Show, Eq) -- | Lift a 'ToJSON' to an 'ASTLiteral'