packages feed

simple-templates (empty) → 0.6.0

raw patch · 8 files changed

+860/−0 lines, 8 filesdep +HUnitdep +aesondep +attoparsecsetup-changed

Dependencies added: HUnit, aeson, attoparsec, base, bytestring, filepath, hspec, mime-types, simple, simple-templates, text, transformers, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,165 @@+                  GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++  This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++  0. Additional Definitions. ++  As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++  "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++  An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++  A "Combined Work" is a work produced by combining or linking an+Application with the Library.  The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++  The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++  The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++  1. Exception to Section 3 of the GNU GPL.++  You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++  2. Conveying Modified Versions.++  If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++   a) under this License, provided that you make a good faith effort to+   ensure that, in the event an Application does not supply the+   function or data, the facility still operates, and performs+   whatever part of its purpose remains meaningful, or++   b) under the GNU GPL, with none of the additional permissions of+   this License applicable to that copy.++  3. Object Code Incorporating Material from Library Header Files.++  The object code form of an Application may incorporate material from+a header file that is part of the Library.  You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++   a) Give prominent notice with each copy of the object code that the+   Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the object code with a copy of the GNU GPL and this license+   document.++  4. Combined Works.++  You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++   a) Give prominent notice with each copy of the Combined Work that+   the Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the Combined Work with a copy of the GNU GPL and this license+   document.++   c) For a Combined Work that displays copyright notices during+   execution, include the copyright notice for the Library among+   these notices, as well as a reference directing the user to the+   copies of the GNU GPL and this license document.++   d) Do one of the following:++       0) Convey the Minimal Corresponding Source under the terms of this+       License, and the Corresponding Application Code in a form+       suitable for, and under terms that permit, the user to+       recombine or relink the Application with a modified version of+       the Linked Version to produce a modified Combined Work, in the+       manner specified by section 6 of the GNU GPL for conveying+       Corresponding Source.++       1) Use a suitable shared library mechanism for linking with the+       Library.  A suitable mechanism is one that (a) uses at run time+       a copy of the Library already present on the user's computer+       system, and (b) will operate properly with a modified version+       of the Library that is interface-compatible with the Linked+       Version. ++   e) Provide Installation Information, but only if you would otherwise+   be required to provide such information under section 6 of the+   GNU GPL, and only to the extent that such information is+   necessary to install and execute a modified version of the+   Combined Work produced by recombining or relinking the+   Application with a modified version of the Linked Version. (If+   you use option 4d0, the Installation Information must accompany+   the Minimal Corresponding Source and Corresponding Application+   Code. If you use option 4d1, you must provide the Installation+   Information in the manner specified by section 6 of the GNU GPL+   for conveying Corresponding Source.)++  5. Combined Libraries.++  You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++   a) Accompany the combined library with a copy of the same work based+   on the Library, uncombined with any other library facilities,+   conveyed under the terms of this License.++   b) Give prominent notice with the combined library that part of it+   is a work based on the Library, and explaining where to find the+   accompanying uncombined form of the same work.++  6. Revised Versions of the GNU Lesser General Public License.++  The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++  Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++  If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ simple-templates.cabal view
@@ -0,0 +1,62 @@+-- Initial simple-session.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                simple-templates+version:             0.6.0+synopsis:            A basic template language for the Simple web framework+description:+  A basic template language for the Simple web framework. The language supports+  variable substitution, function invokation, loops and conditionals.+  .+  "Web.Simple.Templates" documents how to integrate into an app, while+  "Web.Simple.Templates.Language" documents the templating language syntax+  and semantics.+homepage:            http://simple.cx+license:             LGPL-3+license-file:        LICENSE+author:              Amit Aryeh Levy+maintainer:          amit@amitlevy.com+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs: src+  ghc-options: -Wall -fno-warn-unused-do-bind+  exposed-modules:+      Web.Simple.Templates+    , 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++test-suite test-simple-templates+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  build-depends:+      base < 6+    , aeson+    , attoparsec+    , HUnit+    , hspec+    , simple-templates+    , vector+  default-language: Haskell2010++source-repository head+  type: git+  location: anonymous@gitstar.com:alevy/simple.git+
+ src/Web/Simple/Templates.hs view
@@ -0,0 +1,105 @@+{-# 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
@@ -0,0 +1,281 @@+{-# LANGUAGE OverloadedStrings, Trustworthy #-}+{-|+A simple templating system with variable substitution, function invokation, for+loops and conditionals. Most callers should use 'compileTemplate' and invoke+the template with 'renderTemplate'. E.g.:++> let myTemplate = compileTemplate "Hello, $@$!"+> print $ renderTemplate myTemplate mempty "World"++-}+module Web.Simple.Templates.Language+  (+  -- * Language Description+  -- $lang_def++  -- ** Literals+  -- $literals++  -- ** Variable substitution+  -- $variables++  -- ** Function Invokation+  -- $functions++  -- ** Conditionals+  -- $conditionals++  -- ** For Loops+  -- $loops++  -- * Compilation+  compileTemplate, evaluate, evaluateAST+  -- * Helpers+  , valueToText, replaceVar+  ) where++import Control.Applicative+import qualified Data.HashMap.Strict as H+import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import Data.Aeson+import qualified Data.Vector as V+import qualified Data.Attoparsec.Text as A+import Web.Simple.Templates.Parser+import Web.Simple.Templates.Types++evaluateAST :: FunctionMap -- ^ Mapping of functions accessible to the template+            -> Value -- ^ The global 'Object' or 'Value'+            -> AST -> Value+evaluateAST fm global ast =+  case ast of+    ASTRoot asts -> foldl (\v iast ->+                            let val = evaluateAST fm global iast+                            in String $ valueToText v <> valueToText val)+                          (String "") asts++    ASTLiteral val -> val++    ASTFunc ident args ->+      case H.lookup ident fm of+        Nothing -> Null+        Just func ->+          let argVals = map (evaluateAST fm global) args+          in call func argVals++    ASTVar ident ->+      if ident == "@" then global else+        case global of+          Object obj -> fromMaybe Null $ H.lookup ident obj+          _ -> Null++    ASTIndex objAst idents ->+      foldl (\val ident -> +        case val of+          Object obj -> fromMaybe Null $ H.lookup ident obj+          _ -> Null) (evaluateAST fm global objAst) idents++    ASTArray asts -> Array $ V.map (evaluateAST fm global) asts++    ASTIf cond trueBranch mfalseBranch ->+      let condVal = evaluateAST fm global cond+          falseBranch = fromMaybe (ASTLiteral $ String "") mfalseBranch+      in if condVal == Null || condVal == Bool False then+           evaluateAST fm global falseBranch+           else evaluateAST fm global trueBranch++    ASTFor varName lst body msep -> astForLoop fm global varName lst body msep++astForLoop :: FunctionMap -> Value+           -> Identifier -> AST -> AST -> Maybe AST -> Value+astForLoop fm global varName 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+  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+              nv = evaluateAST fm scope body+          in accm <> valueToText nv+        go (v:x1:xs) accm =+          let scope = replaceVar global varName v+              nv = evaluateAST fm scope body+              accmN =+                accm <> valueToText nv <> valueToText sep+          in go (x1:xs) accmN++replaceVar :: Value -> Identifier -> Value -> Value+replaceVar (Object orig) varName newVal = Object $ H.insert varName newVal orig+replaceVar _ varName newVal = object [varName .= newVal]++evaluate :: AST -> Template+evaluate ast = Template $ \fm global ->+  valueToText $ evaluateAST fm global ast++valueToText :: Value -> Text+valueToText val =+  case val of+    String str -> str+    Number n -> T.pack $ show n+    Bool b -> T.pack $ show b+    Array _ -> "[array]"+    Object _ -> "[object]"+    Null -> "null"++compileTemplate :: Text -> Either String Template+compileTemplate tmpl = evaluate <$>+  A.parseOnly pAST tmpl++-- $lang_def+-- A template may contain plain-text, which is reproduced as is, as well as+-- blocks of code, escaped by surrounding with dollar-signs ($), for variable+-- expansion, function invokation, conditionals and loops. For example, given+-- a global variable \"answer\" with the value /42/,+--+-- > The answer to the universe is $answer$.+--+-- would expand to+--+-- > The answer to the universe is 42.+--+-- Since the dollar-sign is used to denote code sections, it must be escaped+-- in plaintext sections by typing two dollar-signs. For example, to reproduce+-- the lyrics for /Bonzo Goes to Bitburg/, by The Ramones:+--+-- > Shouldn't wish you happiness,+-- > wish her the very best.+-- > $$50,000 dress+-- > Shaking hands with your highness++-- $literals+-- 'Data.Aeson.Bool's, 'Number's, 'String's, 'Array's and 'Null' can be typed+-- as literals.+--+-- * 'Data.Aeson.Bool's are the lower-case \"true\" and \"false\"+--+-- * 'Number's are simply typed as decimals+--+-- > Pi is approximately $3.14159$+--+-- * 'String's are surrounded by double-quotes (\"). Double-quotes inside a+-- string can be escaped by proceeding it with a backslash (\\\"), however+-- backslashes themselves do not need to be escaped:+--+-- > And then, Dr. Evil said: $"Mini Me, stop humping the \"laser\"."$+--+-- * 'Array's are surrounded by square-brackets (\[ \]) and elements are comma+-- separated. Elements can be literals, variables or function invokations, and+-- do not have to be the same type:+--+-- > $["Foo", 42, ["bar", "baz"], length([1, 2, 3, 6])]$+--+-- * 'Null' is type as the literal /null/ (in lower case):+--+-- > $null$+--++-- $variables+-- Templates are evaluated with a single global variable called /@/. For+-- example, you can refernce the global in your template like so:+--+-- > The value in my global is $@$.+--+-- If the global is an 'Object', it can be indexed using dot-notation:+--+-- > The Sex Pistols' bassist was $@.bassist.name.first$+--+-- In this case, you may also discard the /@/ global reference and simply name+-- the field in the global object, for example:+--+-- > Field 'foo' is $foo$.+-- > Field 'bar.baz' is $bar.baz$.+--+-- 'String's, 'Number's and 'Data.Aeson.Bool's are meaningful when evaluated to+-- text in a template, while 'Object's, 'Array's and 'Null's simply render as+-- strings representing their types (e.g. \"[object]\"). However, all types can+-- be used as arguments to functions, or in conditionals and loops.++-- $functions+-- Functions are invoked with similar syntax to imperative languages:+--+-- > $myfunc(arg1, arg2, arg3)$+--+-- where arguments can be literals, variables or other function calls --+-- basically anything that can be evaluated can be an argument to a function.+-- Function names are in a separate namespace than variables, so there can be+-- a function and variable both named /foo/ and they are differentiated by+-- their use. For example:+--+-- > $mysymbol$+--+-- is a variable expansion, whereas+--+-- > $mysymbol()$+--+-- is a function invokation.+--++-- $conditionals+-- Branching is supported through the common /if/ statement with an optional+-- /else/ branch. Conditions can be any expression. /false/ and /null/ are+-- evaluated as /false/, while everything else is evaluated as /true/.+--+-- /if/ blocks are surround by an /if/-statement and and /endif/, each+-- surrounded separately by dollar signs. Optionally, the /else/ branch is+-- declared by with \"$else$\". The blocks themselves are templates and may+-- contain regular text as well as evaluable expressions.+--+-- > Should I stay or should I go?+-- > $if(go)$+-- > Trouble will be $trouble$.+-- > $else$+-- > Trouble will be $double(trouble)$+-- > $endif$+--++-- $loops+-- For loops iterate over collections, setting a variable name to one element+-- in the collection for each iteration of the loop. Collections are usually+-- 'Array's, however non-false expressions (e.g., 'String's and 'Number's) are+-- treated as collections with one element. A loop starts with a+-- /for/-statement surrounded by dollar-signs and end with an \"$endfor$\":+--+-- > <h1>The Clash</h1>+-- > <ul>+-- > $for(member in band)$+-- > <li>$member.name$ played the $member.instrument$</li>+-- > $endfor$+-- > </ul>+--+-- There is also an optional \"$sep$\" (for /separator/) clause, which is+-- rendered /between/ iterations. So if I have a collection with three items,+-- the /sep/ clause will be rendered after the first and second, but not third+-- elements:+--+-- > <h1>Grocery list</h1>+-- > <p>+-- > $for(item in groceries)$+-- > $item.quantity$ $item.name$(s).+-- > $sep$+-- > <br/>+-- > $endfor$+-- > </p>+--+-- Will render something like:+--+-- > <h1>Grocery list</h1>+-- > <p>+-- > 2 MC(s).+-- > <br/>+-- > 1 DJ(s)+-- > <br/>+-- > </p>+--+
+ src/Web/Simple/Templates/Parser.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings, Trustworthy #-}++{-| Language parser -}+module Web.Simple.Templates.Parser+  ( reservedWords+  , pAST+  , pRaw+  , pEscapedDollar+  , pEscapedExpr, pExpr+  , pIf, pFor+  , pFunc, pValue, pVar+  , pIndex, pIdentifier, pLiteral, pNull, pBoolean, pString, pNumber, pArray+  ) where++import Control.Applicative+import Control.Monad+import Data.Char (isAlphaNum)+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import Data.Aeson+import qualified Data.Attoparsec.Text as A+import Web.Simple.Templates.Types++-- | Reserved words: for, endfor, sep, if, else, endif, true, false+reservedWords :: [Text]+reservedWords =+  [ "for", "endfor", "sep"+  , "if", "else", "endif"+  , "true", "false"]++-- | Parse an AST+pAST :: A.Parser AST+pAST = ASTRoot <$> many (pRaw <|> pEscapedExpr)++pRaw :: A.Parser AST+pRaw = ASTLiteral . String . mconcat <$> (A.many1 $+  A.takeWhile1 (/= '$') <|> pEscapedDollar)++pEscapedDollar :: A.Parser Text+pEscapedDollar = A.string "$$" >> return "$"++pEscapedExpr :: A.Parser AST+pEscapedExpr = do+  A.char '$' *> pExpr <* A.char '$'++-- | Anything that can be evaluated: for, if or value+pExpr :: A.Parser AST+pExpr = pFor <|> pIf <|> pValue++pIf :: A.Parser AST+pIf = do+  A.string "if"+  brace <- A.satisfy (\c -> c == ' ' || c == '(')+  cond <- pValue+  when (brace == '(') $ A.char ')' >> return ()+  A.char '$'+  trueBranch <- pAST+  falseBranch <- A.option Nothing $ do+    A.string "$else$"+    Just <$> pAST+  A.string "$endif"+  return $ ASTIf cond trueBranch falseBranch++pFor :: A.Parser AST+pFor = do+  A.string "for"+  brace <- A.satisfy (\c -> c == ' ' || c == '(')+  varName <- pIdentifier+  A.string " in "+  lst <- pValue+  when (brace == '(') $ A.char ')' >> return ()+  A.char '$'+  loop <- pAST+  sep <- A.option Nothing $ do+    A.string "$sep$"+    Just <$> pAST+  A.string "$endfor"+  return $ ASTFor varName lst loop sep++-- | A variable, function call, literal, etc+pValue :: A.Parser AST+pValue = pFunc <|> pIndex <|> pVar <|> pLiteral++pFunc :: A.Parser AST+pFunc = do+  funcName <- pIdentifier+  A.char '('+  args <- pValue `A.sepBy` (A.skipSpace *> A.char ',' *> A.skipSpace)+  A.char ')'+  return $ ASTFunc funcName args++pVar :: A.Parser AST+pVar = ASTVar <$> pIdentifier++pIndex :: A.Parser AST+pIndex = do+  first <- pIdentifier <* A.char '.'+  rst <- pIdentifier `A.sepBy` A.char '.'+  return $ ASTIndex (ASTVar first) $ rst++pIdentifier :: A.Parser Identifier+pIdentifier = A.string "@" <|> do+  a <- T.singleton <$> A.letter+  rst <- A.takeWhile (\c -> isAlphaNum c || c == '_' || c == '-')+  let ident = a <> rst+  guard $ ident `notElem` reservedWords+  return ident ++-- Literals --++pLiteral :: A.Parser AST+pLiteral = pArray <|>+           pNumber <|>+           pString <|>+           pBoolean <|>+           pNull++pNull :: A.Parser AST+pNull = A.string "null" *> (return $ ASTLiteral Null)++pBoolean :: A.Parser AST+pBoolean = A.string "true" *> (return $ fromLiteral True) <|>+           A.string "false" *> (return $ fromLiteral False)++pString :: A.Parser AST+pString = ASTLiteral . String <$>+  (A.char '"' *> (T.pack <$> many escapedChar) <* A.char '"')+  where escapedChar = (A.char '\\' *> A.char '"') <|>+                      A.satisfy (/= '"')++pNumber :: A.Parser AST+pNumber = ASTLiteral . Number <$>+  A.number++pArray :: A.Parser AST+pArray = do+  A.char '['+  A.skipSpace+  vals <- pValue `A.sepBy` (A.skipSpace *> A.char ',' *> A.skipSpace)+  A.skipSpace+  A.char ']'+  return $ astListToArray vals+
+ src/Web/Simple/Templates/Types.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE FlexibleInstances, CPP, Trustworthy #-}+{- | Types and helpers to encode the language AST -}+module Web.Simple.Templates.Types where++import qualified Data.HashMap.Strict as H+import Data.Monoid+import Data.Text (Text)+import Data.Aeson+import qualified Data.Vector as V++-- | A funcation that's callable from inside a template+newtype Function = Function { call :: [Value] -> Value }++#define TypesConds(macro) \+  macro(a1 -> a2, \+        (FromJSON a1, FromJSON a2)); \+  macro(a1 -> a2 -> a3, \+        (FromJSON a1, FromJSON a2, FromJSON a3)); \+  macro(a1 -> a2 -> a3 -> a4, \+        (FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4)); \+  macro(a1 -> a2 -> a3 -> a4 -> a5, \+        (FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4, FromJSON a5)); \+  macro(a1 -> a2 -> a3 -> a4 -> a5 -> a6, \+        (FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4, FromJSON a5, FromJSON a6)); \+  macro(a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7, \+        (FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4, FromJSON a5, FromJSON a6, FromJSON a7)); \+  macro(a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8, \+    (FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4, FromJSON a5, FromJSON a6, FromJSON a7, FromJSON a8))++class ToFunction a where+  toFunction :: a -> Function++-- | Like 'fromJSON' but throws an error if there is a parse failure.+fromJSONStrict :: FromJSON a => Value -> a+fromJSONStrict val = case fromJSON val of+                  Error err -> error err+                  Success result -> result++#define TOFUNCTION(types, conds) \+instance (conds) => ToFunction (types -> Value) where { \+  toFunction f = Function $ \args -> \+    case args of { \+      [] -> call (toFunction (f $ fromJSONStrict Null)) [] ; \+      a:as -> call (toFunction (f $ fromJSONStrict a)) as} ; \+}+++instance (FromJSON a) => ToFunction (a -> Value) where+  toFunction f = Function $ \args ->+    case args of+      [] -> toJSON $ f $ fromJSONStrict Null+      a:_ -> toJSON $ f $ fromJSONStrict a++TypesConds(TOFUNCTION)++type FunctionMap = H.HashMap Identifier Function++-- | A compiled template is a function that takes a 'FunctionMap' and a global+-- aeson 'Value' and renders the template.+newtype Template = Template+  { renderTemplate :: FunctionMap -> Value -> Text }++instance Monoid Template where+  mempty = Template $ const $ const mempty+  tm1 `mappend` tm2 = Template $ \fm global ->+    renderTemplate tm1 fm global <> renderTemplate tm2 fm global++-- | A symbol identifier following the format [a-z][a-zA-Z0-9_-]*+type Identifier = Text++-- | 'AST's encode the various types of expressions in the language.+data AST = ASTRoot [AST] -- ^ A series of sub-ASTs+         | ASTLiteral Value -- ^ A literal that does not require evaluation+         | ASTFunc Identifier [AST] -- ^ A function call and list of arguments+         | ASTVar Identifier -- ^ Variable dereference+         | ASTIndex AST [Identifier] -- ^ Nested index into an object+         | ASTArray (V.Vector AST)+         -- ^ 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+  deriving (Show, Eq)++-- | Lift a 'ToJSON' to an 'ASTLiteral'+fromLiteral :: ToJSON a => a -> AST+fromLiteral = ASTLiteral . toJSON++astListToArray :: [AST] -> AST+astListToArray = ASTArray . V.fromList+
+ test/Spec.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Test.Hspec+import qualified Web.Simple.Templates.ParserSpec++main :: IO ()+main = hspec $ do+  Web.Simple.Templates.ParserSpec.spec+