mustache (empty) → 0.1.0.0
raw patch · 12 files changed
+1208/−0 lines, 12 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, cmdargs, conversion, conversion-text, directory, either, filepath, hspec, mtl, mustache, parsec, scientific, tagsoup, text, uniplate, unordered-containers, vector, yaml
Files
- LICENSE +30/−0
- README.md +46/−0
- Setup.hs +2/−0
- mustache.cabal +87/−0
- src/bin/Main.hs +91/−0
- src/lib/Text/Mustache.hs +45/−0
- src/lib/Text/Mustache/Compile.hs +107/−0
- src/lib/Text/Mustache/Internal.hs +12/−0
- src/lib/Text/Mustache/Parser.hs +237/−0
- src/lib/Text/Mustache/Render.hs +133/−0
- src/lib/Text/Mustache/Types.hs +237/−0
- test/unit/Spec.hs +181/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Justus Adam++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Justus Adam nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,46 @@+# mustache [](https://travis-ci.org/JustusAdam/mustache)++Haskell implementation of [mustache templates][mustache-homepage].++[mustache-homepage]: https://mustache.github.io++## Motivation++The old Haskell implementation of mustache tempates [hastache][] seemed pretty abandoned to me. This implementation aims to be much easier to use and (fingers crossed) better maintained.++[hastache]: https://hackage.haskell.org/package/hastache++Since it is so easy to use and requires but a few files of code, I've also written a small executable that compiles and renders mustache templates with data input from json or yaml files.++## Usage++### Library++... Soon™++### Executable `haskell-mustache`++ $ haskell-mustache --help+ Simple mustache template substitution++ arguments [OPTIONS] TEMPLATE [DATA-FILES]++ Common flags:+ -t --templatedirs[=DIRECTORY] The directory in which to search for the+ templates+ -? --help Display help message+ -V --version Print version information++Currenty substitutes the `TEMPLATE` once with each `DATA-FILE`++## Roadmap++- [x] String parser for mustache templates+- [x] Template substitution+- [x] Standalone executable+- [x] Support for 'set delimiter'+- [x] More efficiency using `Text` rather than `String`+- [x] More efficient Text parsing+- [ ] Full unittest coverage (partially done)+- [x] Haddock documentation+- [ ] More instances for `ToMustache` typeclass
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mustache.cabal view
@@ -0,0 +1,87 @@+name: mustache+version: 0.1.0.0+synopsis: A mustache template parser library.+description:+ Allows parsing and rendering template files with mustache markup. See the+ mustache <http://mustache.github.io/mustache.5.html language reference>.+license: BSD3+license-file: LICENSE+author: Justus Adam+maintainer: dev@justus.science+-- copyright:+category: Development+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+tested-with: GHC >=7.8 && <= 7.10.2+++source-repository head+ type: git+ location: git://github.com/JustusAdam/mustache.git++source-repository this+ type: git+ branch: master+ location: git://github.com/JustusAdam/mustache.git+ tag: 0.1.0.0++++library+ exposed-modules: Text.Mustache,+ Text.Mustache.Types,+ Text.Mustache.Parser,+ Text.Mustache.Compile,+ Text.Mustache.Render+ other-modules: Text.Mustache.Internal+ other-extensions: NamedFieldPuns, OverloadedStrings, LambdaCase, TupleSections, CPP+ build-depends: base >=4.7 && <5,+ text >=1.2 && <1.3,+ parsec >=3.1 && <3.2,+ mtl >=2.2 && <2.3,+ either,+ aeson,+ uniplate,+ unordered-containers,+ vector,+ tagsoup,+ bytestring,+ hspec,+ directory,+ filepath,+ scientific,+ conversion >= 1.2,+ conversion-text+ hs-source-dirs: src/lib+ default-language: Haskell2010+ ghc-options:+ -Wall+ -optP-include+ -optPdist/build/autogen/cabal_macros.h+++executable haskell-mustache+ main-is: Main.hs+ build-depends: base >=4.7 && <5,+ mustache,+ bytestring,+ yaml,+ aeson,+ cmdargs,+ text,+ filepath+ default-language: Haskell2010+ hs-source-dirs: src/bin+++test-suite unit-tests+ main-is: Spec.hs+ type: exitcode-stdio-1.0+ build-depends: base >=4.7 && <5,+ hspec,+ text,+ mustache,+ aeson+ hs-source-dirs: test/unit+ default-language: Haskell2010
+ src/bin/Main.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE UnicodeSyntax #-}+module Main (main) where+++import Control.Applicative ((<|>))+import Data.Aeson (Value, eitherDecode)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BS+import Data.Char (toLower)+import Data.Maybe (fromMaybe)+import qualified Data.Text.IO as TIO+import qualified Data.Yaml as Y+import System.Console.CmdArgs.Implicit+import System.FilePath+import Text.Mustache+++data Arguments = Arguments+ { template ∷ FilePath+ , templateDirs ∷ [FilePath]+ , dataFile ∷ FilePath+ , outputFile ∷ Maybe FilePath+ , dataFormat ∷ Maybe String+ } deriving (Show, Data, Typeable)+++commandArgs ∷ Arguments+commandArgs = Arguments+ { template = def+ &= argPos 0+ &= typ "TEMPLATE"+ , dataFile = def+ &= argPos 1+ &= typ "DATAFILE"+ , outputFile = Nothing+ &= help "Name of the resulting file"+ &= typFile+ , templateDirs = ["."]+ &= help "The directories in which to search for the templates"+ &= typ "DIRECTORIES"+ , dataFormat = Nothing+ &= help "Format for input data"+ } &= summary "Simple mustache template subtitution"+++readJSON ∷ FilePath → IO (Either String Value)+readJSON = fmap eitherDecode . BS.readFile+++readYAML ∷ FilePath → IO (Either String Value)+readYAML = fmap Y.decodeEither . B.readFile+++readers ∷ [(String, FilePath → IO (Either String Value))]+readers =+ [ ("yaml", readYAML)+ , ("yml" , readYAML)+ , ("json", readJSON)+ ]+++getReader ∷ String → Maybe (FilePath → IO (Either String Value))+getReader = flip lookup readers . map toLower+++main ∷ IO ()+main = do+ a@(Arguments { dataFormat, template, templateDirs, dataFile, outputFile })+ ← cmdArgs commandArgs++ print a+ eitherTemplate ← compileTemplate templateDirs template++ case eitherTemplate of+ Left err → print err+ Right compiledTemplate → do++ let decode = fromMaybe readJSON $+ (dataFormat >>= getReader)+ <|> getReader (drop 1 $ takeExtension dataFile)++ let write = maybe TIO.putStrLn TIO.writeFile outputFile+ decoded ← decode dataFile++ either+ putStrLn+ write+ $ decoded >>=+ substitute compiledTemplate . toMustache
+ src/lib/Text/Mustache.hs view
@@ -0,0 +1,45 @@+{-|+Module : $Header$+Description : Basic functions for dealing with mustache templates.+Copyright : (c) Justus Adam, 2015+License : LGPL-3+Maintainer : development@justusadam.com+Stability : experimental+Portability : POSIX+-}+{-# LANGUAGE LambdaCase #-}+module Text.Mustache+ (+ -- * Compiling++ -- ** Automatic+ compileTemplate++ -- ** Manually+ , compileTemplateWithCache, parseTemplate, MustacheTemplate(..)++ -- * Rendering++ -- ** Generic++ , substitute++ -- ** Specialized++ , substituteValue++ -- ** Data Conversion+ , ToMustache, toMustache, object, (~>), (~=), (~~>), (~~=)++ -- * Util++ -- | These are functions used internally by the parser and renderer. Whether+ -- these will continue to be exposed is to be seen.+ , getFile , getPartials , getPartials', toString, search, Context(..)+ ) where++++import Text.Mustache.Compile+import Text.Mustache.Render+import Text.Mustache.Types
+ src/lib/Text/Mustache/Compile.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE UnicodeSyntax #-}+module Text.Mustache.Compile where+++import Control.Applicative+import Control.Monad+import Control.Monad.Except+import Control.Monad.Trans.Either+import Data.Bool+import Data.Foldable (fold)+import Data.List+import Data.Monoid+import Data.Text hiding (concat, find, map, uncons)+import qualified Data.Text.IO as TIO+import System.Directory+import System.FilePath+import Text.Mustache.Types+import Text.Mustache.Parser+import Text.Parsec.Error+import Text.Parsec.Pos+import Text.Printf+++{-|+ Compiles a mustache template provided by name including the mentioned partials.++ The same can be done manually using 'getFile', 'mustacheParser' and 'getPartials'.++ This function also ensures each partial is only compiled once even though it may+ be included by other partials including itself.++ A reference to the included template will be found in each including templates+ 'partials' section.+-}+compileTemplate ∷ [FilePath] → FilePath → IO (Either ParseError MustacheTemplate)+compileTemplate searchSpace = compileTemplateWithCache searchSpace mempty+++{-|+ Compile a mustache template providing a list of precompiled templates that do+ not have to be recompiled.+-}+compileTemplateWithCache ∷ [FilePath] → [MustacheTemplate] → FilePath → IO (Either ParseError MustacheTemplate)+compileTemplateWithCache searchSpace = (runEitherT .) . compile'+ where+ compile' templates name' =+ case find ((== name') . name) templates of+ Just template → return template+ Nothing → do+ rawSource ← getFile searchSpace name'+ compiled@(MustacheTemplate { ast = mast }) ←+ hoistEither $ parseTemplate name' rawSource++ foldM+ (\st@(MustacheTemplate { partials = p }) partialName →+ compile' (p <> templates) partialName >>=+ \nt → return (st { partials = nt : p })+ )+ compiled+ (getPartials mast)+++parseTemplate ∷ String → Text → Either ParseError MustacheTemplate+parseTemplate name' = fmap (flip (MustacheTemplate name') mempty) . parse name'+++{-|+ Find the names of all included partials in a mustache AST.++ Same as @join . fmap getPartials'@+-}+getPartials ∷ MustacheAST → [FilePath]+getPartials = join . fmap getPartials'+++{-|+ Find partials in a single MustacheNode+-}+getPartials' ∷ MustacheNode Text → [FilePath]+getPartials' (MustachePartial p) = return p+getPartials' (MustacheSection _ n) = getPartials n+getPartials' _ = mempty+++{-|+ @getFile searchSpace file@ iteratively searches all directories in+ @searchSpace@ for a @file@ returning it if found or raising an error if none+ of the directories contain the file.++ This trows 'ParseError's to be compatible with the internal Either Monad of+ 'compileTemplateWithCache'.+-}+getFile ∷ [FilePath] → FilePath → EitherT ParseError IO Text+getFile [] fp = throwError $ fileNotFound fp+getFile (templateDir : xs) fp =+ lift (doesFileExist filePath) >>=+ bool+ (getFile xs fp)+ (lift $ TIO.readFile filePath)+ where+ filePath = templateDir </> fp+++-- ERRORS++fileNotFound ∷ FilePath → ParseError+fileNotFound fp = newErrorMessage (Message $ printf "Template file '%s' not found" fp) (initialPos fp)
+ src/lib/Text/Mustache/Internal.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnicodeSyntax #-}+module Text.Mustache.Internal (uncons) where+++#if MIN_VERSION_base(4,8,0)+ import Data.List (uncons)+#else+ uncons ∷ [a] → Maybe (a, [a])+ uncons [] = Nothing+ uncons (x:xs) = return (x, xs)+#endif
+ src/lib/Text/Mustache/Parser.hs view
@@ -0,0 +1,237 @@+{-|+Module : $Header$+Description : Functions for parsing mustache templates+Copyright : (c) Justus Adam, 2015+License : LGPL-3+Maintainer : development@justusadam.com+Stability : experimental+Portability : POSIX+-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnicodeSyntax #-}+module Text.Mustache.Parser+ (+ -- * Generic parsing functions++ parse, parseWithConf++ -- * Configurations++ , MustacheConf, emptyConf, defaultConf++ -- * Parser++ , MustacheParser++ -- ** Components++ , genParseTag, parseSection, parseTag, parseVariable, parsePartial, parseText+ , parseInvertedSection, parseDelimiterChange, parseUnescapedVar, parseEnd++ -- * Mustache Constants++ , sectionBegin, sectionEnd, invertedSectionBegin, unescape2, unescape1+ , delimiterChange, nestingSeparator++ ) where+++import Control.Monad+import Data.Char (isAlphaNum, isSpace)+import Data.Foldable (fold)+import Data.Functor ((<$>))+import Data.List (nub)+import Data.Monoid (mempty, (<>))+import Data.Text as T+import Prelude as Prel+import Text.Mustache.Types+import Text.Parsec as P hiding (parse)+++data MustacheConf = MustacheConf+ { delimiters ∷ (String, String)+ }++-- | @#@+sectionBegin ∷ String+sectionBegin = "#"+-- | @/@+sectionEnd ∷ String+sectionEnd = "/"+-- | @>@+partialBegin ∷ String+partialBegin = ">"+-- | @^@+invertedSectionBegin ∷ String+invertedSectionBegin = "^"+-- | @{@ and @}@+unescape2 ∷ (String, String)+unescape2 = ("{", "}")+-- | @&@+unescape1 ∷ String+unescape1 = "&"+-- | @=@+delimiterChange ∷ String+delimiterChange = "="+-- | @.@+nestingSeparator ∷ String+nestingSeparator = "."+-- | Cannot be a letter, number or the nesting separation Character @.@+isAllowedDelimiterCharacter ∷ Char → Bool+isAllowedDelimiterCharacter =+ not . Prel.or . sequence+ [ isSpace, isAlphaNum, flip elem nestingSeparator ]+allowedDelimiterCharacter ∷ MustacheParser Char+allowedDelimiterCharacter =+ satisfy isAllowedDelimiterCharacter+++-- | Empty configuration+emptyConf ∷ MustacheConf+emptyConf = MustacheConf ("", "")+++-- | Default configuration (delimiters = ("{{", "}}"))+defaultConf ∷ MustacheConf+defaultConf = emptyConf { delimiters = ("{{", "}}") }+++type MustacheParser = Parsec Text MustacheConf+type MNodeParser = MustacheParser (MustacheNode Text)+++{-|+ Runs the parser for a mustache template, returning the syntax tree.+-}+parse ∷ FilePath → Text → Either ParseError MustacheAST+parse = parseWithConf defaultConf+++parseWithConf ∷ MustacheConf → FilePath → Text → Either ParseError MustacheAST+parseWithConf = P.runParser (parseText Nothing)+++parseText ∷ Maybe [Text] → MustacheParser MustacheAST+parseText+ tagName = do+ (MustacheConf { delimiters = ( start, _ )}) ← getState+ let endOfText = try (void $ string start) <|> try eof+ content ← pack <$> manyTill anyChar (lookAhead endOfText)+ others ← parseTag tagName+ return $ if T.null content+ then others+ else MustacheText content : others++++parseTag ∷ Maybe [Text] → MustacheParser MustacheAST+parseTag tagName = choice+ [ parseEnd tagName >> return []+ , parseSection >>= continue+ , parseInvertedSection >>= continue+ , parseUnescapedVar >>= continue+ , parseDelimiterChange >> parseText tagName+ , parsePartial >>= continue+ , parseVariable >>= continue+ , eof >> maybe (return []) (parserFail . ("Unclosed section " <>) . unpack . fold) tagName+ ]+ where+ continue val = (val :) <$> parseText tagName++parseSection ∷ MNodeParser+parseSection = do+ sectionName ← genParseTag sectionBegin mempty+ MustacheSection sectionName <$> parseText (return sectionName)+++parsePartial ∷ MNodeParser+parsePartial = do+ (MustacheConf { delimiters = ( start, end )}) <- getState+ let pStart = start <> partialBegin+ pEnd = end+ void $ try $ string pStart+ spaces+ MustachePartial <$>+ anyChar `manyTill` try (skipMany space >> string pEnd)+++parseDelimiterChange ∷ MustacheParser ()+parseDelimiterChange = do+ (MustacheConf { delimiters = ( start, end )}) <- getState+ void $ try $ string (start <> delimiterChange)+ delim1 ← allowedDelimiterCharacter `manyTill` space+ spaces+ delim2 ← allowedDelimiterCharacter `manyTill` try (string $ delimiterChange <> end)+ oldState ← getState+ putState $ oldState { delimiters = (delim1, delim2) }+++parseInvertedSection ∷ MNodeParser+parseInvertedSection = do+ sectionName ← genParseTag invertedSectionBegin mempty+ MustacheInvertedSection sectionName <$> parseText (return sectionName)+++parseUnescapedVar ∷ MNodeParser+parseUnescapedVar = MustacheVariable False <$>+ (try (uncurry genParseTag unescape2) <|> genParseTag unescape1 mempty)+++parseVariable ∷ MNodeParser+parseVariable = MustacheVariable True <$> genParseTag mempty mempty+++parseEnd ∷ Maybe [Text] -> MustacheParser ()+parseEnd tagName = do+ tag ← genParseTag sectionEnd mempty+ unless (isSameSection tag) $+ parserFail $+ maybe+ (unexpectedSection tag)+ (`unexpectedClosingSequence` tag)+ tagName+ where+ isSameSection = maybe (const True) (==) tagName+++genParseTag ∷ String → String → MustacheParser [Text]+genParseTag smod emod = do+ (MustacheConf { delimiters = ( start, end ) }) <- getState++ let nStart = start <> smod+ nEnd = emod <> end+ disallowed = nub $ nestingSeparator <> start <> end++ parseOne :: MustacheParser [Text]+ parseOne = do+ spaces++ one ← noneOf disallowed+ `manyTill` lookAhead+ (try (spaces >> void (string nEnd))+ <|> try (void $ string nestingSeparator))++ others ← (string nestingSeparator >> parseOne)+ <|> (const mempty <$> (spaces >> string nEnd))+ return $ pack one : others++ void $ try $ string nStart+ parseOne+++-- ERRORS++sectionToString ∷ [Text] → String+sectionToString = unpack . intercalate "."++unexpectedSection ∷ [Text] → String+unexpectedSection s = "No such section '" <> sectionToString s <> "'"+unexpectedClosingSequence ∷ [Text] → [Text] → String+unexpectedClosingSequence tag1 tag2 =+ "Expected closing sequence for section '"+ <> sectionToString tag1+ <> "' got '"+ <> sectionToString tag2+ <> "'"
+ src/lib/Text/Mustache/Render.hs view
@@ -0,0 +1,133 @@+{-|+Module : $Header$+Description : Functions for rendering mustache templates.+Copyright : (c) Justus Adam, 2015+License : LGPL-3+Maintainer : development@justusadam.com+Stability : experimental+Portability : POSIX+-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UnicodeSyntax #-}+module Text.Mustache.Render+ (+ -- * Substitution+ substitute, substituteValue+ -- * Working with Context+ , Context(..), search, innerSearch+ -- * Util+ , toString+ ) where++--+import Control.Applicative ((<|>), (<$>))+import Data.Foldable (fold, find)+import Data.HashMap.Strict as HM hiding (map)+import Data.Monoid (mempty, (<>))+import Data.Text hiding (concat, find, map, uncons)+import qualified Data.Text as T+import Data.Traversable (traverse)+import qualified Data.Vector as V+import Text.HTML.TagSoup (escapeHTML)+import Text.Mustache.Internal+import Text.Mustache.Types+import Text.Printf+++{-|+ Substitutes all mustache defined tokens (or tags) for values found in the+ provided data structure.++ Equivalent to @substituteValue . toMustache@.+-}+substitute ∷ ToMustache j ⇒ MustacheTemplate → j → Either String Text+substitute t = substituteValue t . toMustache+++{-|+ Substitutes all mustache defined tokens (or tags) for values found in the+ provided data structure.+-}+substituteValue ∷ MustacheTemplate → Value → Either String Text+substituteValue (MustacheTemplate { ast = cAst, partials = cPartials }) dataStruct =+ joinSubstituted (substitute' (Context mempty dataStruct)) cAst+ where+ joinSubstituted f = fmap fold . traverse f++ -- Main substitution function+ substitute' ∷ Context Value → MustacheNode Text → Either String Text++ -- subtituting text+ substitute' _ (MustacheText t) = return t++ -- substituting a whole section (entails a focus shift)+ substitute' context@(Context parents focus) (MustacheSection secName secAST) =+ case search context secName of+ Just arr@(Array arrCont) →+ if V.null arrCont+ then return mempty+ else flip joinSubstituted arrCont $ \focus' →+ let+ newContext = Context (arr:focus:parents) focus'+ in+ joinSubstituted (substitute' newContext) secAST+ Just (Bool b) | not b → return mempty+ Just (Lambda l) → l context secAST >>= joinSubstituted (substitute' context)+ Just focus' →+ let+ newContext = Context (focus:parents) focus'+ in+ joinSubstituted (substitute' newContext) secAST+ Nothing → return mempty++ -- substituting an inverted section+ substitute' context (MustacheInvertedSection invSecName invSecAST) =+ case search context invSecName of+ Just (Bool False) → contents+ Just (Array a) | V.null a → contents+ Nothing → contents+ _ → return mempty+ where+ contents = joinSubstituted (substitute' context) invSecAST++ -- substituting a variable+ substitute' context (MustacheVariable escaped varName) =+ return $ maybe+ mempty+ (if escaped then escapeHTML else id)+ $ toString <$> search context varName++ -- substituting a partial+ substitute' context (MustachePartial pName) =+ maybe+ (Left $ printf "Could not find partial '%s'" pName)+ (joinSubstituted (substitute' context) . ast)+ $ find ((== pName) . name) cPartials+++search ∷ Context Value → [T.Text] → Maybe Value+search _ [] = Nothing+search (Context parents focus) val@(x:xs) =+ (+ ( case focus of+ (Object o) → HM.lookup x o+ _ → Nothing+ )+ <|> (do+ (newFocus, newParents) <- uncons parents+ search (Context newParents newFocus) val+ )+ )+ >>= innerSearch xs++++innerSearch ∷ [T.Text] → Value → Maybe Value+innerSearch [] v = Just v+innerSearch (y:ys) (Object o) = HM.lookup y o >>= innerSearch ys+innerSearch _ _ = Nothing+++toString ∷ Value → Text+toString (String t) = t+toString e = pack $ show e
+ src/lib/Text/Mustache/Types.hs view
@@ -0,0 +1,237 @@+{-|+Module : $Header$+Description : Types and conversions+Copyright : (c) Justus Adam, 2015+License : LGPL-3+Maintainer : development@justusadam.com+Stability : experimental+Portability : POSIX+-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleContexts #-}+module Text.Mustache.Types+ (+ -- * Types for the Parser / Template+ MustacheAST+ , MustacheTemplate(..)+ , MustacheNode(..)+ -- * Types for the Substitution / Data+ , Value(..)+ -- ** Converting+ , object+ , (~>), (~=), (~~>), (~~=)+ , ToMustache, toMustache, toMustacheText, mFromJSON+ -- ** Representation+ , Array, Object+ , Context(..)+ ) where+++import qualified Data.Aeson as Aeson+import Data.Functor ((<$>))+import Data.HashMap.Strict as HM+import Data.Scientific+import Data.Text+import qualified Data.Text.Lazy as LT+import qualified Data.Vector as V+import Conversion+import Conversion.Text ()+++-- | Abstract syntax tree for a mustache template+type MustacheAST = [MustacheNode Text]+++-- | Basic values composing the AST+data MustacheNode a+ = MustacheText a+ | MustacheSection [Text] MustacheAST+ | MustacheInvertedSection [Text] MustacheAST+ | MustacheVariable Bool [Text]+ | MustachePartial FilePath+ deriving (Show, Eq)+++type Array = V.Vector Value+type Object = HM.HashMap Text Value+type KeyValuePair = (Text, Value)+++-- | Representation of stateful context for the substitution process+data Context a = Context [a] a+++-- | Internal value AST+data Value+ = Object Object+ | Array Array+ | Number Scientific+ | String Text+ | Lambda (Context Value → MustacheAST → Either String MustacheAST)+ | Bool Bool+ | Null+++instance Show Value where+ show (Lambda _) = "Lambda Context Value → MustacheAST → Either String MustacheAST"+ show (Object o) = show o+ show (Array a) = show a+ show (String s) = show s+ show (Number n) = show n+ show (Bool b) = show b+ show Null = "null"+++-- | Conversion class+class ToMustache a where+ toMustache ∷ a → Value+++instance ToMustache [Char] where+ toMustache = String . pack++instance ToMustache Bool where+ toMustache = Bool++instance ToMustache Char where+ toMustache = String . pack . return++instance ToMustache () where+ toMustache = const Null++instance ToMustache Text where+ toMustache = String++instance ToMustache LT.Text where+ toMustache = String . LT.toStrict++instance ToMustache Scientific where+ toMustache = Number++instance ToMustache Value where+ toMustache = id++instance ToMustache m ⇒ ToMustache [m] where+ toMustache = Array . V.fromList . fmap toMustache++instance ToMustache m ⇒ ToMustache (V.Vector m) where+ toMustache = Array . fmap toMustache++instance ToMustache m ⇒ ToMustache (HM.HashMap Text m) where+ toMustache = Object . fmap toMustache++instance ToMustache (Context Value → MustacheAST → Either String MustacheAST) where+ toMustache = Lambda++instance ToMustache (Context Value → MustacheAST → Either String Text) where+ toMustache f = Lambda wrapper+ where wrapper c lAST = return . MustacheText <$> f c lAST++instance ToMustache (Context Value → MustacheAST → MustacheAST) where+ toMustache f = Lambda wrapper+ where wrapper c = Right . f c++instance ToMustache (Context Value → MustacheAST → Text) where+ toMustache f = Lambda wrapper+ where wrapper c = Right . return . MustacheText . f c++instance ToMustache (Context Value → MustacheAST → String) where+ toMustache f = toMustache wrapper+ where wrapper c = pack . f c++instance ToMustache (MustacheAST → Either String MustacheAST) where+ toMustache f = Lambda $ const f++instance ToMustache (MustacheAST → Either String Text) where+ toMustache f = Lambda wrapper+ where wrapper _ = fmap (return . MustacheText) . f++instance ToMustache (MustacheAST → Either String String) where+ toMustache f = toMustache (fmap pack . f)++instance ToMustache (MustacheAST → Text) where+ toMustache f = toMustache (Right . f ∷ MustacheAST -> Either String Text)++instance ToMustache (MustacheAST → String) where+ toMustache f = toMustache (pack . f)++instance ToMustache Aeson.Value where+ toMustache (Aeson.Object o) = Object $ fmap toMustache o+ toMustache (Aeson.Array a) = Array $ fmap toMustache a+ toMustache (Aeson.Number n) = Number n+ toMustache (Aeson.String s) = String s+ toMustache (Aeson.Bool b) = Bool b+ toMustache (Aeson.Null) = Null+++-- | Convenience function for creating Object values.+--+-- This function is supposed to be used in conjuction with the '~>' and '~=' operators.+--+-- ==== __Examples__+--+-- @+-- data Address = Address { ... }+--+-- instance Address ToJSON where+-- ...+--+-- data Person = Person { name :: String, address :: Address }+--+-- instance ToMustache Person where+-- toMustache (Person { name, address }) = object+-- [ "name" ~> name+-- , "address" ~= address+-- ]+-- @+--+-- Here we can see that we can use the '~>' operator for values that have themselves+-- a 'ToMustache' instance, or alternatively if they lack such an instance but provide+-- an instance for the 'ToJSON' typeclass we can use the '~=' operator.+object ∷ [(Text, Value)] → Value+object = Object . HM.fromList+++-- | Map keys to values that provide a 'ToMustache' instance+--+-- Recommended in conjunction with the `OverloadedStrings` extension.+(~>) ∷ ToMustache m ⇒ Text → m → KeyValuePair+(~>) t = (t, ) . toMustache+++-- | Map keys to values that provide a 'ToJSON' instance+--+-- Recommended in conjunction with the `OverloadedStrings` extension.+(~=) ∷ Aeson.ToJSON j ⇒ Text → j → KeyValuePair+(~=) t = (t ~>) . Aeson.toJSON+++-- | Conceptually similar to '~>' but uses arbitrary String-likes as keys.+(~~>) ∷ (Conversion t Text, ToMustache m) ⇒ t → m → KeyValuePair+(~~>) = (~>) . convert+++-- | Conceptually similar to '~=' but uses arbitrary String-likes as keys.+(~~=) ∷ (Conversion t Text, Aeson.ToJSON j) ⇒ t → j → KeyValuePair+(~~=) = (~=) . convert+++-- | Converts arbitrary String-likes to Values+toMustacheText ∷ Conversion t Text ⇒ t → Value+toMustacheText = String . convert+++-- | Converts a value that can be represented as JSON to a Value.+mFromJSON ∷ Aeson.ToJSON j ⇒ j → Value+mFromJSON = toMustache . Aeson.toJSON+++{-|+ A compiled Template with metadata.+-}+data MustacheTemplate = MustacheTemplate { name ∷ String+ , ast ∷ MustacheAST+ , partials ∷ [MustacheTemplate]+ } deriving (Show)
+ test/unit/Spec.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where+++import Data.Either+import Data.Monoid (mempty)+import qualified Data.Text as T+import Test.Hspec+import Text.Mustache+import Text.Mustache.Types+import Text.Mustache.Parser+++parserSpec :: Spec+parserSpec =+ describe "mustacheParser" $ do+ let lparse = parse "testsuite"+ let returnedOne = return . return++ let text = "test12356p0--=-34{}jnv,\n"++ it "parses text" $+ lparse text `shouldBe` returnedOne (MustacheText text)++ it "parses a variable" $+ lparse "{{name}}" `shouldBe` returnedOne (MustacheVariable True ["name"])++ it "parses a variable with whitespace" $+ lparse "{{ name }}" `shouldBe` returnedOne (MustacheVariable True ["name"])++ it "allows '-' in variable names" $+ lparse "{{ name-name }}" `shouldBe`+ returnedOne (MustacheVariable True ["name-name"])++ it "allows '_' in variable names" $+ lparse "{{ name_name }}" `shouldBe`+ returnedOne (MustacheVariable True ["name_name"])++ it "parses a variable unescaped with {{{}}}" $+ lparse "{{{name}}}" `shouldBe` returnedOne (MustacheVariable False ["name"])++ it "parses a variable unescaped with {{{}}} with whitespace" $+ lparse "{{{ name }}}" `shouldBe`+ returnedOne (MustacheVariable False ["name"])++ it "parses a variable unescaped with &" $+ lparse "{{&name}}" `shouldBe` returnedOne (MustacheVariable False ["name"])++ it "parses a variable unescaped with & with whitespace" $+ lparse "{{& name }}" `shouldBe`+ returnedOne (MustacheVariable False ["name"])++ it "parses a partial" $+ lparse "{{>myPartial}}" `shouldBe`+ returnedOne (MustachePartial "myPartial")++ it "parses a partial with whitespace" $+ lparse "{{> myPartial }}" `shouldBe`+ returnedOne (MustachePartial "myPartial")++ it "parses the an empty section" $+ lparse "{{#section}}{{/section}}" `shouldBe`+ returnedOne (MustacheSection ["section"] mempty)++ it "parses the an empty section with whitespace" $+ lparse "{{# section }}{{/ section }}" `shouldBe`+ returnedOne (MustacheSection ["section"] mempty)++ it "parses a delimiter change" $+ lparse "{{=<< >>=}}<<var>>{{var}}" `shouldBe`+ return [MustacheVariable True ["var"], MustacheText "{{var}}"]++ it "parses a delimiter change with whitespace" $+ lparse "{{=<< >>=}}<< var >>{{var}}" `shouldBe`+ return [MustacheVariable True ["var"], MustacheText "{{var}}"]++ it "parses two subsequent delimiter changes" $+ lparse "{{=(( ))=}}(( var ))((=-- $-=))--#section$---/section$-" `shouldBe`+ return [MustacheVariable True ["var"], MustacheSection ["section"] []]++ it "propagates a delimiter change from a nested scope" $+ lparse "{{#section}}{{=<< >>=}}<</section>><<var>>" `shouldBe`+ return [MustacheSection ["section"] [], MustacheVariable True ["var"]]++ it "fails if the tag contains illegal characters" $+ lparse "{{#&}}" `shouldSatisfy` isLeft++ it "parses a nested variable" $+ lparse "{{ name.val }}" `shouldBe` returnedOne (MustacheVariable True ["name", "val"])++ it "parses a variable containing whitespace" $+ lparse "{{ val space }}" `shouldBe` returnedOne (MustacheVariable True ["val space"])+++substituteSpec :: Spec+substituteSpec =+ describe "substitute" $ do++ let toTemplate ast' = MustacheTemplate "testsuite" ast' []++ it "substitutes a html escaped value for a variable" $+ substitute+ (toTemplate [MustacheVariable True ["name"]])+ (object ["name" ~> ("<tag>" :: T.Text)])+ `shouldBe` return "<tag>"++ it "substitutes raw value for an unescaped variable" $+ substitute+ (toTemplate [MustacheVariable False ["name"]])+ (object ["name" ~> ("<tag>" :: T.Text)])+ `shouldBe` return "<tag>"++ it "substitutes a section when the key is present (and an empty object)" $+ substitute+ (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (object ["section" ~> object []])+ `shouldBe` return "t"++ it "substitutes a section when the key is present (and 'true')" $+ substitute+ (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (object ["section" ~> True])+ `shouldBe` return "t"++ it "substitutes a section once when the key is present and a singleton list" $+ substitute+ (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (object ["section" ~> ["True" :: T.Text]])+ `shouldBe` return "t"++ it "substitutes a section twice when the key is present and a list with two items" $+ substitute+ (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (object ["section" ~> (["True", "False"] :: [T.Text])])+ `shouldBe` return "tt"++ it "substitutes a section twice when the key is present and a list with two\+ \ objects, changing the scope to each object" $+ substitute+ (toTemplate [MustacheSection ["section"] [MustacheVariable True ["t"]]])+ (object+ [ "section" ~>+ [ object ["t" ~> ("var1" :: T.Text)]+ , object ["t" ~> ("var2" :: T.Text)]+ ]+ ])+ `shouldBe` return "var1var2"++ it "does not substitute a section when the key is not present" $+ substitute+ (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (object [])+ `shouldBe` return ""++ it "does not substitute a section when the key is present (and 'false')" $+ substitute+ (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (object ["section" ~> False])+ `shouldBe` return ""++ it "does not substitute a section when the key is present (and empty list)" $+ substitute+ (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (object ["section" ~> ([] :: [T.Text])])+ `shouldBe` return ""++ it "substitutes a nested section" $+ substitute+ (toTemplate [MustacheVariable True ["outer", "inner"]])+ (object+ [ "outer" ~> object ["inner" ~> ("success" :: T.Text)]+ , "inner" ~> ("error" :: T.Text)+ ]+ )+ `shouldBe` return "success"+++main :: IO ()+main = hspec $ do+ parserSpec+ substituteSpec