mustache 1.0 → 1.0.1
raw patch · 15 files changed
+1330/−1325 lines, 15 files
Files
- app/Main.hs +72/−0
- mustache.cabal +5/−4
- src/Text/Mustache.hs +182/−0
- src/Text/Mustache/Compile.hs +149/−0
- src/Text/Mustache/Internal.hs +42/−0
- src/Text/Mustache/Parser.hs +315/−0
- src/Text/Mustache/Render.hs +184/−0
- src/Text/Mustache/Types.hs +381/−0
- src/bin/Main.hs +0/−72
- src/lib/Text/Mustache.hs +0/−182
- src/lib/Text/Mustache/Compile.hs +0/−149
- src/lib/Text/Mustache/Internal.hs +0/−42
- src/lib/Text/Mustache/Parser.hs +0/−315
- src/lib/Text/Mustache/Render.hs +0/−184
- src/lib/Text/Mustache/Types.hs +0/−377
+ app/Main.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE UnicodeSyntax #-}+module Main (main) where+++import Data.Aeson (Value, eitherDecode)+import qualified Data.ByteString as B (readFile)+import qualified Data.ByteString.Lazy as BS (readFile)+import Data.Foldable (for_)+import qualified Data.Text.IO as TIO (putStrLn)+import Data.Yaml (decodeEither)+import Prelude.Unicode+import System.Console.CmdArgs.Implicit (Data, Typeable, argPos, args,+ cmdArgs, def, help, summary,+ typ, (&=))+import System.FilePath (takeExtension)+import Text.Mustache (automaticCompile, substitute,+ toMustache)+++data Arguments = Arguments+ { template ∷ FilePath+ , templateDirs ∷ [FilePath]+ , dataFiles ∷ [FilePath]+ } deriving (Show, Data, Typeable)+++commandArgs ∷ Arguments+commandArgs = Arguments+ { template = def+ &= argPos 0+ &= typ "TEMPLATE"+ , dataFiles = def+ &= args+ &= typ "DATA-FILES"+ , templateDirs = ["."]+ &= help "The directories in which to search for the templates"+ &= typ "DIRECTORIES"+ } &= summary "Simple mustache template subtitution"+++readJSON ∷ FilePath → IO (Either String Value)+readJSON = fmap eitherDecode ∘ BS.readFile+++readYAML ∷ FilePath → IO (Either String Value)+readYAML = fmap decodeEither ∘ B.readFile+++main ∷ IO ()+main = do+ (Arguments { template, templateDirs, dataFiles }) ← cmdArgs commandArgs++ eitherTemplate ← automaticCompile templateDirs template++ case eitherTemplate of+ Left err → print err+ Right compiledTemplate →+ for_ dataFiles $ \file → do++ let decoder =+ case takeExtension file of+ ".yml" → readYAML+ ".yaml" → readYAML+ _ → readJSON+ decoded ← decoder file++ either+ putStrLn+ (TIO.putStrLn ∘ substitute compiledTemplate ∘ toMustache)+ decoded
mustache.cabal view
@@ -1,5 +1,5 @@ name: mustache-version: 1.0+version: 1.0.1 synopsis: A mustache template parser library. description: Allows parsing and rendering template files with mustache markup. See the@@ -30,7 +30,7 @@ type: git branch: master location: git://github.com/JustusAdam/mustache.git- tag: v1.0+ tag: v1.0.1 @@ -59,7 +59,7 @@ , scientific , base-unicode-symbols , containers- hs-source-dirs: src/lib+ hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -77,7 +77,8 @@ , filepath , base-unicode-symbols default-language: Haskell2010- hs-source-dirs: src/bin+ ghc-options: -threaded -Wall+ hs-source-dirs: app test-suite unit-tests
+ src/Text/Mustache.hs view
@@ -0,0 +1,182 @@+{-|+Module : $Header$+Description : Basic functions for dealing with mustache templates.+Copyright : (c) Justus Adam, 2015+License : BSD3+Maintainer : dev@justus.science+Stability : experimental+Portability : POSIX++= How to use this library++This module exposes some of the most convenient functions for dealing with mustache+templates.++== Compiling with automatic partial discovery++The easiest way of compiling a file and its potential includes (called partials)+is by using the 'automaticCompile' function.++@+main :: IO ()+main = do+ let searchSpace = [".", "./templates"]+ templateName = "main.mustache"++ compiled <- automaticCompile searchSpace templateName+ case compiled of+ Left err -> print err+ Right template -> return () -- this is where you can start using it+@++The @searchSpace@ encompasses all directories in which the compiler should+search for the template source files.+The search itself is conducted in order, from left to right.++Should your search space be only the current working directory, you can use+'localAutomaticCompile'.++The @templateName@ is the relative path of the template to any directory+of the search space.++'automaticCompile' not only finds and compiles the template for you, it also+recursively finds any partials included in the template as well,+compiles them and stores them in the 'partials' hash attached to the resulting+template.++The compiler will throw errors if either the template is malformed+or the source file for a partial or the template itself could not be found+in any of the directories in @searchSpace@.++== Substituting++In order to substitute data into the template it must be an instance of the 'ToMustache'+typeclass or be of type 'Value'.++This libray tries to imitate the API of <https://hackage.haskell.org/package/aeson aeson>+by allowing you to define conversions of your own custom data types into 'Value',+the type used internally by the substitutor via typeclass and a selection of+operators and convenience functions.++=== Example++@+ data Person = { age :: Int, name :: String }++ instance ToMustache Person where+ toMustache person = object+ [ "age" ~> age person+ , "name" ~> name person+ ]+@++The values to the left of the '~>' operator has to be of type 'Text', hence the+@OverloadedStrings@ can becomes very handy here.++Values to the right of the '~>' operator must be an instance of the 'ToMustache'+typeclass. Alternatively, if your value to the right of the '~>' operator is+not an instance of 'ToMustache' but an instance of 'ToJSON' you can use the+'~=' operator, which accepts 'ToJSON' values.++@+ data Person = { age :: Int, name :: String, address :: Address }++ data Address = ...++ instance ToJSON Address where+ ...++ instance ToMustache Person where+ toMustache person = object+ [ "age" ~> age person+ , "name" ~> name person+ , "address" ~= address person+ ]+@++All operators are also provided in a unicode form, for those that, like me, enjoy+unicode operators.++== Manual compiling++You can compile templates manually without requiring the IO monad at all, using+the 'compileTemplate' function. This is the same function internally used by+'automaticCompile' and does not check if required partial are present.++More functions for manual compilation can be found in the 'Text.Mustache.Compile'+module. Including helpers for finding lists of partials in templates.++Additionally the 'compileTemplateWithCache' function is exposed here which you+may use to automatically compile a template but avoid some of the compilation+overhead by providing already compiled partials as well.++== Fundamentals++This library builds on three important data structures/types.++['Value'] A data structure almost identical to Data.Aeson.Value extended with+lambda functions which represents the data the template is being filled with.++['ToMustache'] A typeclass for converting arbitrary types to 'Value', similar+to Data.Aeson.ToJSON but with support for lambdas.++['Template'] Contains the 'STree', the syntax tree, which is basically a+list of text blocks and mustache tags. The 'name' of the template and its+'partials' cache.++=== Compiling++During the compilation step the template file is located, read, then parsed in a single+pass ('compileTemplate'), resulting in a 'Template' with an empty 'partials' section.++Subsequenty the 'STree' of the template is scanned for included partials, any+present 'TemplateCache' is queried for the partial ('compileTemplateWithCache'),+if not found it will be searched for in the @searchSpache@, compiled and+inserted into the template's own cache as well as the global cache for the+compilation process.++Internally no partial is compiled twice, as long as the names stay consistent.++Once compiled templates may be used multiple times for substitution or as+partial for other templates.++Partials are not being embedded into the templates during compilation, but during+substitution, hence the 'partials' cache is vital to the template even after+compilation has been completed. Any non existent partial in the cache will+rsubstitute to an empty string.++=== Substituting++++-}+{-# LANGUAGE LambdaCase #-}+module Text.Mustache+ (+ -- * Compiling++ -- ** Automatic+ automaticCompile, localAutomaticCompile++ -- ** Manually+ , compileTemplateWithCache, compileTemplate, Template(..)++ -- * Rendering++ -- ** Generic++ , substitute++ -- ** Specialized++ , substituteValue++ -- ** Data Conversion+ , ToMustache, toMustache, object, (~>), (~=)+ ) where++++import Text.Mustache.Compile+import Text.Mustache.Render+import Text.Mustache.Types
+ src/Text/Mustache/Compile.hs view
@@ -0,0 +1,149 @@+{-|+Module : $Header$+Description : Basic functions for dealing with mustache templates.+Copyright : (c) Justus Adam, 2015+License : BSD3+Maintainer : dev@justus.science+Stability : experimental+Portability : POSIX+-}+{-# LANGUAGE UnicodeSyntax #-}+module Text.Mustache.Compile+ ( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache+ , compileTemplate, cacheFromList, getPartials, getFile+ ) where+++import Control.Arrow ((&&&))+import Control.Monad+import Control.Monad.Except+import Control.Monad.State+import Control.Monad.Trans.Either+import Control.Monad.Unicode+import Data.Bool+import Data.HashMap.Strict as HM+import Data.Monoid.Unicode ((∅))+import Data.Text hiding (concat, find, map, uncons)+import qualified Data.Text.IO as TIO+import Prelude.Unicode+import System.Directory+import System.FilePath+import Text.Mustache.Parser+import Text.Mustache.Types+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.+-}+automaticCompile ∷ [FilePath] → FilePath → IO (Either ParseError Template)+automaticCompile searchSpace = compileTemplateWithCache searchSpace (∅)+++-- | Compile the template with the search space set to only the current directory+localAutomaticCompile ∷ FilePath → IO (Either ParseError Template)+localAutomaticCompile = automaticCompile ["."]+++{-|+ Compile a mustache template providing a list of precompiled templates that do+ not have to be recompiled.+-}+compileTemplateWithCache ∷ [FilePath]+ → TemplateCache+ → FilePath+ → IO (Either ParseError Template)+compileTemplateWithCache searchSpace templates initName =+ runEitherT $ evalStateT (compile' initName) $ flattenPartials templates+ where+ compile' ∷ FilePath+ → StateT+ (HM.HashMap String Template)+ (EitherT ParseError IO)+ Template+ compile' name' = do+ templates' ← get+ case HM.lookup name' templates' of+ Just template → return template+ Nothing → do+ rawSource ← lift $ getFile searchSpace name'+ compiled@(Template { ast = mSTree }) ←+ lift $ hoistEither $ compileTemplate name' rawSource++ foldM+ (\st@(Template { partials = p }) partialName → do+ nt ← compile' partialName+ modify (HM.insert partialName nt)+ return (st { partials = HM.insert partialName nt p })+ )+ compiled+ (getPartials mSTree)+++-- | Flatten a list of Templates into a single 'TemplateChache'+cacheFromList ∷ [Template] → TemplateCache+cacheFromList = flattenPartials ∘ fromList ∘ fmap (name &&& id)+++-- | Compiles a 'Template' directly from 'Text' without checking for missing partials.+-- the result will be a 'Template' with an empty 'partials' cache.+compileTemplate ∷ String → Text → Either ParseError Template+compileTemplate name' = fmap (flip (Template name') (∅)) ∘ parse name'+++{-|+ Find the names of all included partials in a mustache STree.++ Same as @join . fmap getPartials'@+-}+getPartials ∷ STree → [FilePath]+getPartials = join ∘ fmap getPartials'+++{-|+ Find partials in a single Node+-}+getPartials' ∷ Node Text → [FilePath]+getPartials' (Partial _ p) = return p+getPartials' (Section _ n) = getPartials n+getPartials' (InvertedSection _ n) = getPartials n+getPartials' _ = (∅)+++flattenPartials ∷ TemplateCache → TemplateCache+flattenPartials m = foldrWithKey (insertWith (\_ b -> b)) m m+++{-|+ @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/Text/Mustache/Internal.hs view
@@ -0,0 +1,42 @@+{-|+Module : $Header$+Description : Types and conversions+Copyright : (c) Justus Adam, 2015+License : BSD3+Maintainer : dev@justus.science+Stability : experimental+Portability : POSIX++escapeXML and xmlEntities curtesy to the tagsoup library.+-}+{-# LANGUAGE UnicodeSyntax #-}+module Text.Mustache.Internal (uncons, escapeXMLText) where+++import Data.Char (ord)+import qualified Data.IntMap as IntMap+import qualified Data.Text as T+import Prelude.Unicode+++uncons ∷ [α] → Maybe (α, [α])+uncons [] = Nothing+uncons (x:xs) = return (x, xs)+++escapeXMLText :: T.Text -> T.Text+escapeXMLText = T.pack ∘ escapeXML ∘ T.unpack+++escapeXML :: String -> String+escapeXML = concatMap $ \x -> IntMap.findWithDefault [x] (ord x) mp+ where mp = IntMap.fromList [(ord b, "&"++a++";") | (a,[b]) <- xmlEntities]+++xmlEntities :: [(String, String)]+xmlEntities =+ [ ("quot", "\"")+ , ("amp" , "&")+ , ("lt" , "<")+ , ("gt" , ">")+ ]
+ src/Text/Mustache/Parser.hs view
@@ -0,0 +1,315 @@+{-|+Module : $Header$+Description : Basic functions for dealing with mustache templates.+Copyright : (c) Justus Adam, 2015+License : BSD3+Maintainer : dev@justus.science+Stability : experimental+Portability : POSIX+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnicodeSyntax #-}+module Text.Mustache.Parser+ (+ -- * Generic parsing functions++ parse, parseWithConf++ -- * Configurations++ , MustacheConf, defaultConf++ -- * Parser++ , Parser, MustacheState++ -- * Mustache Constants++ , sectionBegin, sectionEnd, invertedSectionBegin, unescape2, unescape1+ , delimiterChange, nestingSeparator++ ) where+++import Control.Monad+import Control.Monad.Unicode+import Data.Char (isAlphaNum, isSpace)+import Data.Functor ((<$>))+import Data.List (nub)+import Data.Monoid.Unicode ((∅), (⊕))+import Data.Text as T (Text, null, pack)+import Prelude as Prel+import Prelude.Unicode+import Text.Mustache.Types+import Text.Parsec as P hiding (endOfLine, parse)+++-- | Initial configuration for the parser+data MustacheConf = MustacheConf+ { delimiters ∷ (String, String)+ }+++-- | User state for the parser+data MustacheState = MustacheState+ { sDelimiters ∷ (String, String)+ , textStack ∷ Text+ , isBeginngingOfLine ∷ Bool+ , currentSectionName ∷ Maybe DataIdentifier+ }+++data ParseTagRes+ = SectionBegin Bool DataIdentifier+ | SectionEnd DataIdentifier+ | Tag (Node Text)+ | HandledTag+++-- | @#@+sectionBegin ∷ Char+sectionBegin = '#'+-- | @/@+sectionEnd ∷ Char+sectionEnd = '/'+-- | @>@+partialBegin ∷ Char+partialBegin = '>'+-- | @^@+invertedSectionBegin ∷ Char+invertedSectionBegin = '^'+-- | @{@ and @}@+unescape2 ∷ (Char, Char)+unescape2 = ('{', '}')+-- | @&@+unescape1 ∷ Char+unescape1 = '&'+-- | @=@+delimiterChange ∷ Char+delimiterChange = '='+-- | @.@+nestingSeparator ∷ Char+nestingSeparator = '.'+-- | @!@+comment ∷ Char+comment = '!'+-- | @.@+implicitIterator ∷ Char+implicitIterator = '.'+-- | Cannot be a letter, number or the nesting separation Character @.@+isAllowedDelimiterCharacter ∷ Char → Bool+isAllowedDelimiterCharacter =+ not ∘ Prel.or ∘ sequence+ [ isSpace, isAlphaNum, (≡ nestingSeparator) ]+allowedDelimiterCharacter ∷ Parser Char+allowedDelimiterCharacter =+ satisfy isAllowedDelimiterCharacter+++-- | Empty configuration+emptyState ∷ MustacheState+emptyState = MustacheState ("", "") (∅) True Nothing+++-- | Default configuration (delimiters = ("{{", "}}"))+defaultConf ∷ MustacheConf+defaultConf = MustacheConf ("{{", "}}")+++initState ∷ MustacheConf → MustacheState+initState (MustacheConf { delimiters }) = emptyState { sDelimiters = delimiters }+++setIsBeginning ∷ Bool → Parser ()+setIsBeginning b = modifyState (\s -> s { isBeginngingOfLine = b })+++-- | The parser monad in use+type Parser = Parsec Text MustacheState+++(<<) ∷ Monad m ⇒ m b → m a → m b+(<<) = flip (≫)+++endOfLine ∷ Parser String+endOfLine = do+ r ← optionMaybe $ char '\r'+ n ← char '\n'+ return $ maybe id (:) r [n]+++{-|+ Runs the parser for a mustache template, returning the syntax tree.+-}+parse ∷ FilePath → Text → Either ParseError STree+parse = parseWithConf defaultConf+++-- | Parse using a custom initial configuration+parseWithConf ∷ MustacheConf → FilePath → Text → Either ParseError STree+parseWithConf = P.runParser parseText ∘ initState+++parseText ∷ Parser STree+parseText = do+ (MustacheState { isBeginngingOfLine }) ← getState+ if isBeginngingOfLine+ then parseLine+ else continueLine+++appendStringStack ∷ String → Parser ()+appendStringStack t = modifyState (\s → s { textStack = textStack s ⊕ pack t})+++continueLine ∷ Parser STree+continueLine = do+ (MustacheState { sDelimiters = ( start@(x:_), _ )}) ← getState+ let forbidden = x : "\n\r"++ many (noneOf forbidden) ≫= appendStringStack++ (try endOfLine ≫= appendStringStack ≫ setIsBeginning True ≫ parseLine)+ <|> (try (string start) ≫ switchOnTag ≫= continueFromTag)+ <|> (try eof ≫ finishFile)+ <|> (anyChar ≫= appendStringStack . (:[]) ≫ continueLine)+++flushText ∷ Parser STree+flushText = do+ s@(MustacheState { textStack = text }) ← getState+ putState $ s { textStack = (∅) }+ return $ if T.null text+ then []+ else [TextBlock text]+++finishFile ∷ Parser STree+finishFile =+ getState ≫= \case+ (MustacheState {currentSectionName = Nothing}) → flushText+ (MustacheState {currentSectionName = Just name}) →+ parserFail $ "Unclosed section " ⊕ show name+++parseLine ∷ Parser STree+parseLine = do+ (MustacheState { sDelimiters = ( start, _ ) }) ← getState+ initialWhitespace ← many (oneOf " \t")+ let handleStandalone = do+ tag ← switchOnTag+ let continueNoStandalone = do+ appendStringStack initialWhitespace+ setIsBeginning False+ continueFromTag tag+ standaloneEnding = do+ try (skipMany (oneOf " \t") ≫ (eof <|> void endOfLine))+ setIsBeginning True+ case tag of+ Tag (Partial _ name) →+ ( standaloneEnding ≫+ continueFromTag (Tag (Partial (Just (pack initialWhitespace)) name))+ ) <|> continueNoStandalone+ Tag _ → continueNoStandalone+ _ →+ ( standaloneEnding ≫+ continueFromTag tag+ ) <|> continueNoStandalone+ (try (string start) ≫ handleStandalone)+ <|> (try eof ≫ appendStringStack initialWhitespace ≫ finishFile)+ <|> (appendStringStack initialWhitespace ≫ setIsBeginning False ≫ continueLine)+++continueFromTag ∷ ParseTagRes → Parser STree+continueFromTag (SectionBegin inverted name) = do+ textNodes ← flushText+ state@(MustacheState+ { currentSectionName = previousSection }) ← getState+ putState $ state { currentSectionName = return name }+ innerSectionContent ← parseText+ let sectionTag =+ if inverted+ then InvertedSection+ else Section+ modifyState $ \s → s { currentSectionName = previousSection }+ outerSectionContent ← parseText+ return (textNodes ⊕ [sectionTag name innerSectionContent] ⊕ outerSectionContent)+continueFromTag (SectionEnd name) = do+ (MustacheState+ { currentSectionName }) ← getState+ case currentSectionName of+ Just name' | name' ≡ name → flushText+ Just name' → parserFail $ "Expected closing sequence for \"" ⊕ show name ⊕ "\" got \"" ⊕ show name' ⊕ "\"."+ Nothing → parserFail $ "Encountered closing sequence for \"" ⊕ show name ⊕ "\" which has never been opened."+continueFromTag (Tag tag) = do+ textNodes ← flushText+ furtherNodes ← parseText+ return $ textNodes ⊕ return tag ⊕ furtherNodes+continueFromTag HandledTag = parseText+++switchOnTag ∷ Parser ParseTagRes+switchOnTag = do+ (MustacheState { sDelimiters = ( _, end )}) ← getState++ choice+ [ SectionBegin False <$> (try (char sectionBegin) ≫ genParseTagEnd (∅))+ , SectionEnd+ <$> (try (char sectionEnd) ≫ genParseTagEnd (∅))+ , Tag ∘ Variable False+ <$> (try (char unescape1) ≫ genParseTagEnd (∅))+ , Tag ∘ Variable False+ <$> (try (char (fst unescape2)) ≫ genParseTagEnd (return $ snd unescape2))+ , Tag ∘ Partial Nothing+ <$> (try (char partialBegin) ≫ spaces ≫ (noneOf (nub end) `manyTill` try (spaces ≫ string end)))+ , return HandledTag+ << (try (char delimiterChange) ≫ parseDelimChange)+ , SectionBegin True+ <$> (try (char invertedSectionBegin) ≫ genParseTagEnd (∅) ≫= \case+ n@(NamedData _) → return n+ _ → parserFail "Inverted Sections can not be implicit."+ )+ , return HandledTag << (try (char comment) ≫ manyTill anyChar (try $ string end))+ , Tag . Variable True+ <$> genParseTagEnd (∅)+ ]+ where+ parseDelimChange = do+ (MustacheState { sDelimiters = ( _, end )}) ← getState+ spaces+ delim1 ← allowedDelimiterCharacter `manyTill` space+ spaces+ delim2 ← allowedDelimiterCharacter `manyTill` try (spaces ≫ string (delimiterChange : end))+ when (delim1 ≡ (∅) ∨ delim2 ≡ (∅))+ $ parserFail "Tags must contain more than 0 characters"+ oldState ← getState+ putState $ oldState { sDelimiters = (delim1, delim2) }+++genParseTagEnd ∷ String → Parser DataIdentifier+genParseTagEnd emod = do+ (MustacheState { sDelimiters = ( start, end ) }) ← getState++ let nEnd = emod ⊕ end+ disallowed = nub $ nestingSeparator : start ⊕ end++ parseOne :: Parser [Text]+ parseOne = do++ one ← noneOf disallowed+ `manyTill` lookAhead+ (try (spaces ≫ void (string nEnd))+ <|> try (void $ char nestingSeparator))++ others ← (char nestingSeparator ≫ parseOne)+ <|> (const (∅) <$> (spaces ≫ string nEnd))+ return $ pack one : others+ spaces+ (try (char implicitIterator) ≫ spaces ≫ string nEnd ≫ return Implicit)+ <|> (NamedData <$> parseOne)
+ src/Text/Mustache/Render.hs view
@@ -0,0 +1,184 @@+{-|+Module : $Header$+Description : Functions for rendering mustache templates.+Copyright : (c) Justus Adam, 2015+License : BSD3+Maintainer : dev@justus.science+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 Control.Arrow (first)+import Control.Monad+import Control.Monad.Unicode+import Data.Foldable (fold)+import Data.HashMap.Strict as HM hiding (map)+import Data.Maybe (fromMaybe)+import Data.Monoid.Unicode+import Data.Scientific (floatingOrInteger)+import Data.Text as T (Text, isSuffixOf, null, pack,+ replace, stripSuffix)+import qualified Data.Vector as V+import Prelude hiding (length, lines, unlines)+import Prelude.Unicode+import Text.Mustache.Internal+import Text.Mustache.Types+++{-|+ Substitutes all mustache defined tokens (or tags) for values found in the+ provided data structure.++ Equivalent to @substituteValue . toMustache@.+-}+substitute ∷ ToMustache κ ⇒ Template → κ → Text+substitute t = substituteValue t ∘ toMustache+++{-|+ Substitutes all mustache defined tokens (or tags) for values found in the+ provided data structure.+-}+substituteValue ∷ Template → Value → Text+substituteValue (Template { ast = cAst, partials = cPartials }) dataStruct =+ joinSubstituted (substitute' (Context (∅) dataStruct)) cAst+ where+ joinSubstituted f = fold ∘ fmap f++ -- Main substitution function+ substitute' ∷ Context Value → Node Text → Text++ -- subtituting text+ substitute' _ (TextBlock t) = t++ -- substituting a whole section (entails a focus shift)+ substitute' (Context parents focus@(Array a)) (Section Implicit secSTree)+ | V.null a = (∅)+ | otherwise = flip joinSubstituted a $ \focus' →+ let+ newContext = Context (focus:parents) focus'+ in+ joinSubstituted (substitute' newContext) secSTree+ substitute' context@(Context _ (Object _)) (Section Implicit secSTree) =+ joinSubstituted (substitute' context) secSTree+ substitute' _ (Section Implicit _) = (∅)+ substitute' context@(Context parents focus) (Section (NamedData secName) secSTree) =+ case search context secName of+ Just arr@(Array arrCont) →+ if V.null arrCont+ then (∅)+ else flip joinSubstituted arrCont $ \focus' →+ let+ newContext = Context (arr:focus:parents) focus'+ in+ joinSubstituted (substitute' newContext) secSTree+ Just (Bool False) → (∅)+ Just (Lambda l) → joinSubstituted (substitute' context) (l context secSTree)+ Just focus' →+ let+ newContext = Context (focus:parents) focus'+ in+ joinSubstituted (substitute' newContext) secSTree+ Nothing → (∅)++ -- substituting an inverted section+ substitute' _ (InvertedSection Implicit _ ) = (∅)+ substitute' context (InvertedSection (NamedData secName) invSecSTree) =+ case search context secName of+ Just (Bool False) → contents+ Just (Array a) | V.null a → contents+ Nothing → contents+ _ → (∅)+ where+ contents = joinSubstituted (substitute' context) invSecSTree++ -- substituting a variable+ substitute' (Context _ current) (Variable _ Implicit) = toString current+ substitute' context (Variable escaped (NamedData varName)) =+ maybe+ (∅)+ (if escaped then escapeXMLText else id)+ $ toString <$> search context varName++ -- substituting a partial+ substitute' context (Partial indent pName) =+ maybe+ (∅)+ (joinSubstituted (substitute' context) ∘ handleIndent indent ∘ ast)+ $ HM.lookup pName cPartials+++handleIndent ∷ Maybe Text → STree → STree+handleIndent Nothing ast' = ast'+handleIndent (Just indentation) ast' = preface ⊕ content+ where+ preface = if T.null indentation then [] else [TextBlock indentation]+ content = if T.null indentation+ then ast'+ else+ let+ fullIndented = fmap (indentBy indentation) ast'+ dropper (TextBlock t) = TextBlock $+ if ("\n" ⊕ indentation) `isSuffixOf` t+ then fromMaybe t $ stripSuffix indentation t+ else t+ dropper a = a+ in+ reverse $ fromMaybe [] (uncurry (:) ∘ first dropper <$> uncons (reverse fullIndented))+++-- | Search for a key in the current context.+--+-- The search is conducted inside out mening the current focus+-- is searched first. If the key is not found the outer scopes are recursively+-- searched until the key is found, then 'innerSearch' is called on the result.+search ∷ Context Value → [Key] → Maybe Value+search _ [] = Nothing+search ctx keys@(_:nextKeys) = go ctx keys ≫= innerSearch nextKeys+ where+ go _ [] = Nothing+ go (Context parents focus) val@(x:_) =+ ( case focus of+ (Object o) → HM.lookup x o+ _ → Nothing+ )+ <|> ( do+ (newFocus, newParents) ← uncons parents+ go (Context newParents newFocus) val+ )++indentBy ∷ Text → Node Text → Node Text+indentBy indent p@(Partial (Just indent') name')+ | T.null indent = p+ | otherwise = Partial (Just (indent ⊕ indent')) name'+indentBy indent (Partial Nothing name') = Partial (Just indent) name'+indentBy indent (TextBlock t) = TextBlock $ replace "\n" ("\n" ⊕ indent) t+indentBy _ a = a+++-- | Searches nested scopes navigating inward. Fails if it encunters something+-- other than an object before the key is expended.+innerSearch ∷ [Key] → Value → Maybe Value+innerSearch [] v = Just v+innerSearch (y:ys) (Object o) = HM.lookup y o ≫= innerSearch ys+innerSearch _ _ = Nothing+++-- | Converts values to Text as required by the mustache standard+toString ∷ Value → Text+toString (String t) = t+toString (Number n) = either (pack ∘ show) (pack ∘ show) (floatingOrInteger n ∷ Either Double Integer)+toString e = pack $ show e
+ src/Text/Mustache/Types.hs view
@@ -0,0 +1,381 @@+{-|+Module : $Header$+Description : Types and conversions+Copyright : (c) Justus Adam, 2015+License : BSD3+Maintainer : dev@justus.science+Stability : experimental+Portability : POSIX+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE BangPatterns #-}+module Text.Mustache.Types+ (+ -- * Types for the Parser / Template+ STree+ , Template(..)+ , Node(..)+ , DataIdentifier(..)+ -- * Types for the Substitution / Data+ , Value(..)+ , Key+ -- ** Converting+ , object+ , (~>), (↝), (~=), (⥱)+ , ToMustache, toMustache, mFromJSON+ -- ** Representation+ , Array, Object, Pair+ , Context(..)+ , TemplateCache+ ) where+++import qualified Data.Aeson as Aeson+import Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import qualified Data.Map as Map+import Data.Scientific+import Data.Text+import qualified Data.Text.Lazy as LT+import qualified Data.Vector as V+import Prelude.Unicode++-- | Syntax tree for a mustache template+type STree = ASTree Text+++type ASTree α = [Node α] +++-- | Basic values composing the STree+data Node α+ = TextBlock α+ | Section DataIdentifier (ASTree α)+ | InvertedSection DataIdentifier (ASTree α)+ | Variable Bool DataIdentifier+ | Partial (Maybe α) FilePath+ deriving (Show, Eq)+++-- | Kinds of identifiers for Variables and sections+data DataIdentifier+ = NamedData [Key]+ | Implicit+ deriving (Show, Eq)+++-- | A list-like structure used in 'Value'+type Array = V.Vector Value+-- | A map-like structure used in 'Value'+type Object = HM.HashMap Text Value+-- | Source type for constructing 'Object's+type Pair = (Text, Value)+++-- | Representation of stateful context for the substitution process+data Context α = Context [α] α+ deriving (Eq, Show, Ord)++-- | Internal value representation+data Value+ = Object !Object+ | Array !Array+ | Number !Scientific+ | String !Text+ | Lambda (Context Value → STree → STree)+ | Bool !Bool+ | Null+++instance Show Value where+ show (Lambda _) = "Lambda function"+ 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 ω where+ toMustache ∷ ω → Value+ listToMustache ∷ [ω] → Value+ listToMustache = Array ∘ V.fromList ∘ fmap toMustache++instance ToMustache Float where+ toMustache = Number ∘ fromFloatDigits++instance ToMustache Double where+ toMustache = Number ∘ fromFloatDigits++instance ToMustache Integer where+ toMustache = Number ∘ fromInteger++instance ToMustache Int where+ toMustache = toMustache . toInteger++instance ToMustache Char where+ toMustache = toMustache ∘ (:[])+ listToMustache = String ∘ pack++instance ToMustache Value where+ toMustache = id++instance ToMustache Bool where+ toMustache = Bool++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 α ⇒ ToMustache [α] where+ toMustache = listToMustache++instance ToMustache ω ⇒ ToMustache (V.Vector ω) where+ toMustache = toMustache ∘ fmap toMustache++instance (ToMustache ω) ⇒ ToMustache (Map.Map Text ω) where+ toMustache = mapInstanceHelper id++instance (ToMustache ω) ⇒ ToMustache (Map.Map LT.Text ω) where+ toMustache = mapInstanceHelper LT.toStrict++instance (ToMustache ω) ⇒ ToMustache (Map.Map String ω) where+ toMustache = mapInstanceHelper pack++mapInstanceHelper :: ToMustache v => (a -> Text) -> Map.Map a v -> Value+mapInstanceHelper conv =+ toMustache+ ∘ Map.foldrWithKey+ (\k → HM.insert (conv k) ∘ toMustache)+ HM.empty++instance ToMustache ω ⇒ ToMustache (HM.HashMap Text ω) where+ toMustache = toMustache ∘ fmap toMustache++instance ToMustache ω ⇒ ToMustache (HM.HashMap LT.Text ω) where+ toMustache = hashMapInstanceHelper LT.toStrict++instance ToMustache ω ⇒ ToMustache (HM.HashMap String ω) where+ toMustache = hashMapInstanceHelper pack++hashMapInstanceHelper :: ToMustache v => (a -> Text) -> HM.HashMap a v -> Value+hashMapInstanceHelper conv =+ toMustache+ ∘ HM.foldrWithKey+ (\k → HM.insert (conv k) ∘ toMustache)+ HM.empty++instance ToMustache (Context Value → STree → STree) where+ toMustache = Lambda++instance ToMustache (Context Value → STree → Text) where+ toMustache = lambdaInstanceHelper id++instance ToMustache (Context Value → STree → LT.Text) where+ toMustache = lambdaInstanceHelper LT.toStrict++instance ToMustache (Context Value → STree → String) where+ toMustache = lambdaInstanceHelper pack++lambdaInstanceHelper :: (a -> Text) -> (Context Value -> STree -> a) -> Value+lambdaInstanceHelper conv f = Lambda wrapper+ where+ wrapper ∷ Context Value → STree → STree+ wrapper c lSTree = return ∘ TextBlock $ conv $ f c lSTree++instance ToMustache (STree → STree) where+ toMustache f = toMustache (const f ∷ Context Value → STree → STree)++instance ToMustache (STree → Text) where+ toMustache f = toMustache wrapper+ where+ wrapper ∷ Context Value → STree → STree+ wrapper _ = (return ∘ TextBlock) ∘ 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++instance ToMustache ω ⇒ ToMustache (HS.HashSet ω) where+ toMustache = toMustache ∘ HS.toList++instance (ToMustache α, ToMustache β) ⇒ ToMustache (α, β) where+ toMustache (a, b) = toMustache [toMustache a, toMustache b]++instance (ToMustache α, ToMustache β, ToMustache γ)+ ⇒ ToMustache (α, β, γ) where+ toMustache (a, b, c) = toMustache [toMustache a, toMustache b, toMustache c]++instance (ToMustache α, ToMustache β, ToMustache γ, ToMustache δ)+ ⇒ ToMustache (α, β, γ, δ) where+ toMustache (a, b, c, d) = toMustache+ [ toMustache a+ , toMustache b+ , toMustache c+ , toMustache d+ ]++instance ( ToMustache α+ , ToMustache β+ , ToMustache γ+ , ToMustache δ+ , ToMustache ε+ ) ⇒ ToMustache (α, β, γ, δ, ε) where+ toMustache (a, b, c, d, e) = toMustache+ [ toMustache a+ , toMustache b+ , toMustache c+ , toMustache d+ , toMustache e+ ]++instance ( ToMustache α+ , ToMustache β+ , ToMustache γ+ , ToMustache δ+ , ToMustache ε+ , ToMustache ζ+ ) ⇒ ToMustache (α, β, γ, δ, ε, ζ) where+ toMustache (a, b, c, d, e, f) = toMustache+ [ toMustache a+ , toMustache b+ , toMustache c+ , toMustache d+ , toMustache e+ , toMustache f+ ]++instance ( ToMustache α+ , ToMustache β+ , ToMustache γ+ , ToMustache δ+ , ToMustache ε+ , ToMustache ζ+ , ToMustache η+ ) ⇒ ToMustache (α, β, γ, δ, ε, ζ, η) where+ toMustache (a, b, c, d, e, f, g) = toMustache+ [ toMustache a+ , toMustache b+ , toMustache c+ , toMustache d+ , toMustache e+ , toMustache f+ , toMustache g+ ]++instance ( ToMustache α+ , ToMustache β+ , ToMustache γ+ , ToMustache δ+ , ToMustache ε+ , ToMustache ζ+ , ToMustache η+ , ToMustache θ+ ) ⇒ ToMustache (α, β, γ, δ, ε, ζ, η, θ) where+ toMustache (a, b, c, d, e, f, g, h) = toMustache+ [ toMustache a+ , toMustache b+ , toMustache c+ , toMustache d+ , toMustache e+ , toMustache f+ , toMustache g+ , toMustache h+ ]++-- | 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 ∷ [Pair] → Value+object = Object ∘ HM.fromList+++-- | Map keys to values that provide a 'ToMustache' instance+--+-- Recommended in conjunction with the `OverloadedStrings` extension.+(~>) ∷ ToMustache ω ⇒ Text → ω → Pair+(~>) t = (t, ) ∘ toMustache+{-# INLINEABLE (~>) #-}+infixr 8 ~>++-- | Unicode version of '~>'+(↝) ∷ ToMustache ω ⇒ Text → ω → Pair+(↝) = (~>)+{-# INLINEABLE (↝) #-}+infixr 8 ↝+++-- | Map keys to values that provide a 'ToJSON' instance+--+-- Recommended in conjunction with the `OverloadedStrings` extension.+(~=) ∷ Aeson.ToJSON ι ⇒ Text → ι → Pair+(~=) t = (t ~>) ∘ Aeson.toJSON+{-# INLINEABLE (~=) #-}+infixr 8 ~=+++-- | Unicode version of '~='+(⥱) ∷ Aeson.ToJSON ι ⇒ Text → ι → Pair+(⥱) = (~=)+{-# INLINEABLE (⥱) #-}+infixr 8 ⥱+++-- | Converts a value that can be represented as JSON to a Value.+mFromJSON ∷ Aeson.ToJSON ι ⇒ ι → Value+mFromJSON = toMustache ∘ Aeson.toJSON+++-- | A collection of templates with quick access via their hashed names+type TemplateCache = HM.HashMap String Template++-- | Type of key used for retrieving data from 'Value's+type Key = Text++{-|+ A compiled Template with metadata.+-}+data Template = Template+ { name ∷ String+ , ast ∷ STree+ , partials ∷ TemplateCache+ } deriving (Show)
− src/bin/Main.hs
@@ -1,72 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE UnicodeSyntax #-}-module Main (main) where---import Data.Aeson (Value, eitherDecode)-import qualified Data.ByteString as B (readFile)-import qualified Data.ByteString.Lazy as BS (readFile)-import Data.Foldable (for_)-import qualified Data.Text.IO as TIO (putStrLn)-import Data.Yaml (decodeEither)-import Prelude.Unicode-import System.Console.CmdArgs.Implicit (Data, Typeable, argPos, args,- cmdArgs, def, help, summary,- typ, (&=))-import System.FilePath (takeExtension)-import Text.Mustache (automaticCompile, substitute,- toMustache)---data Arguments = Arguments- { template ∷ FilePath- , templateDirs ∷ [FilePath]- , dataFiles ∷ [FilePath]- } deriving (Show, Data, Typeable)---commandArgs ∷ Arguments-commandArgs = Arguments- { template = def- &= argPos 0- &= typ "TEMPLATE"- , dataFiles = def- &= args- &= typ "DATA-FILES"- , templateDirs = ["."]- &= help "The directories in which to search for the templates"- &= typ "DIRECTORIES"- } &= summary "Simple mustache template subtitution"---readJSON ∷ FilePath → IO (Either String Value)-readJSON = fmap eitherDecode ∘ BS.readFile---readYAML ∷ FilePath → IO (Either String Value)-readYAML = fmap decodeEither ∘ B.readFile---main ∷ IO ()-main = do- (Arguments { template, templateDirs, dataFiles }) ← cmdArgs commandArgs-- eitherTemplate ← automaticCompile templateDirs template-- case eitherTemplate of- Left err → print err- Right compiledTemplate →- for_ dataFiles $ \file → do-- let decoder =- case takeExtension file of- ".yml" → readYAML- ".yaml" → readYAML- _ → readJSON- decoded ← decoder file-- either- putStrLn- (TIO.putStrLn ∘ substitute compiledTemplate ∘ toMustache)- decoded
− src/lib/Text/Mustache.hs
@@ -1,182 +0,0 @@-{-|-Module : $Header$-Description : Basic functions for dealing with mustache templates.-Copyright : (c) Justus Adam, 2015-License : LGPL-3-Maintainer : dev@justus.science-Stability : experimental-Portability : POSIX--= How to use this library--This module exposes some of the most convenient functions for dealing with mustache-templates.--== Compiling with automatic partial discovery--The easiest way of compiling a file and its potential includes (called partials)-is by using the 'automaticCompile' function.--@-main :: IO ()-main = do- let searchSpace = [".", "./templates"]- templateName = "main.mustache"-- compiled <- automaticCompile searchSpace templateName- case compiled of- Left err -> print err- Right template -> return () -- this is where you can start using it-@--The @searchSpace@ encompasses all directories in which the compiler should-search for the template source files.-The search itself is conducted in order, from left to right.--Should your search space be only the current working directory, you can use-'localAutomaticCompile'.--The @templateName@ is the relative path of the template to any directory-of the search space.--'automaticCompile' not only finds and compiles the template for you, it also-recursively finds any partials included in the template as well,-compiles them and stores them in the 'partials' hash attached to the resulting-template.--The compiler will throw errors if either the template is malformed-or the source file for a partial or the template itself could not be found-in any of the directories in @searchSpace@.--== Substituting--In order to substitute data into the template it must be an instance of the 'ToMustache'-typeclass or be of type 'Value'.--This libray tries to imitate the API of <https://hackage.haskell.org/package/aeson aeson>-by allowing you to define conversions of your own custom data types into 'Value',-the type used internally by the substitutor via typeclass and a selection of-operators and convenience functions.--=== Example--@- data Person = { age :: Int, name :: String }-- instance ToMustache Person where- toMustache person = object- [ "age" ~> age person- , "name" ~> name person- ]-@--The values to the left of the '~>' operator has to be of type 'Text', hence the-@OverloadedStrings@ can becomes very handy here.--Values to the right of the '~>' operator must be an instance of the 'ToMustache'-typeclass. Alternatively, if your value to the right of the '~>' operator is-not an instance of 'ToMustache' but an instance of 'ToJSON' you can use the-'~=' operator, which accepts 'ToJSON' values.--@- data Person = { age :: Int, name :: String, address :: Address }-- data Address = ...-- instance ToJSON Address where- ...-- instance ToMustache Person where- toMustache person = object- [ "age" ~> age person- , "name" ~> name person- , "address" ~= address person- ]-@--All operators are also provided in a unicode form, for those that, like me, enjoy-unicode operators.--== Manual compiling--You can compile templates manually without requiring the IO monad at all, using-the 'compileTemplate' function. This is the same function internally used by-'automaticCompile' and does not check if required partial are present.--More functions for manual compilation can be found in the 'Text.Mustache.Compile'-module. Including helpers for finding lists of partials in templates.--Additionally the 'compileTemplateWithCache' function is exposed here which you-may use to automatically compile a template but avoid some of the compilation-overhead by providing already compiled partials as well.--== Fundamentals--This library builds on three important data structures/types.--['Value'] A data structure almost identical to Data.Aeson.Value extended with-lambda functions which represents the data the template is being filled with.--['ToMustache'] A typeclass for converting arbitrary types to 'Value', similar-to Data.Aeson.ToJSON but with support for lambdas.--['Template'] Contains the 'STree', the syntax tree, which is basically a-list of text blocks and mustache tags. The 'name' of the template and its-'partials' cache.--=== Compiling--During the compilation step the template file is located, read, then parsed in a single-pass ('compileTemplate'), resulting in a 'Template' with an empty 'partials' section.--Subsequenty the 'STree' of the template is scanned for included partials, any-present 'TemplateCache' is queried for the partial ('compileTemplateWithCache'),-if not found it will be searched for in the @searchSpache@, compiled and-inserted into the template's own cache as well as the global cache for the-compilation process.--Internally no partial is compiled twice, as long as the names stay consistent.--Once compiled templates may be used multiple times for substitution or as-partial for other templates.--Partials are not being embedded into the templates during compilation, but during-substitution, hence the 'partials' cache is vital to the template even after-compilation has been completed. Any non existent partial in the cache will-rsubstitute to an empty string.--=== Substituting-----}-{-# LANGUAGE LambdaCase #-}-module Text.Mustache- (- -- * Compiling-- -- ** Automatic- automaticCompile, localAutomaticCompile-- -- ** Manually- , compileTemplateWithCache, compileTemplate, Template(..)-- -- * Rendering-- -- ** Generic-- , substitute-- -- ** Specialized-- , substituteValue-- -- ** Data Conversion- , ToMustache, toMustache, object, (~>), (~=)- ) where----import Text.Mustache.Compile-import Text.Mustache.Render-import Text.Mustache.Types
− src/lib/Text/Mustache/Compile.hs
@@ -1,149 +0,0 @@-{-|-Module : $Header$-Description : Basic functions for dealing with mustache templates.-Copyright : (c) Justus Adam, 2015-License : LGPL-3-Maintainer : dev@justus.science-Stability : experimental-Portability : POSIX--}-{-# LANGUAGE UnicodeSyntax #-}-module Text.Mustache.Compile- ( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache- , compileTemplate, cacheFromList, getPartials, getFile- ) where---import Control.Arrow ((&&&))-import Control.Monad-import Control.Monad.Except-import Control.Monad.State-import Control.Monad.Trans.Either-import Control.Monad.Unicode-import Data.Bool-import Data.HashMap.Strict as HM-import Data.Monoid.Unicode ((∅))-import Data.Text hiding (concat, find, map, uncons)-import qualified Data.Text.IO as TIO-import Prelude.Unicode-import System.Directory-import System.FilePath-import Text.Mustache.Parser-import Text.Mustache.Types-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.--}-automaticCompile ∷ [FilePath] → FilePath → IO (Either ParseError Template)-automaticCompile searchSpace = compileTemplateWithCache searchSpace (∅)----- | Compile the template with the search space set to only the current directory-localAutomaticCompile ∷ FilePath → IO (Either ParseError Template)-localAutomaticCompile = automaticCompile ["."]---{-|- Compile a mustache template providing a list of precompiled templates that do- not have to be recompiled.--}-compileTemplateWithCache ∷ [FilePath]- → TemplateCache- → FilePath- → IO (Either ParseError Template)-compileTemplateWithCache searchSpace templates initName =- runEitherT $ evalStateT (compile' initName) $ flattenPartials templates- where- compile' ∷ FilePath- → StateT- (HM.HashMap String Template)- (EitherT ParseError IO)- Template- compile' name' = do- templates' ← get- case HM.lookup name' templates' of- Just template → return template- Nothing → do- rawSource ← lift $ getFile searchSpace name'- compiled@(Template { ast = mSTree }) ←- lift $ hoistEither $ compileTemplate name' rawSource-- foldM- (\st@(Template { partials = p }) partialName → do- nt ← compile' partialName- modify (HM.insert partialName nt)- return (st { partials = HM.insert partialName nt p })- )- compiled- (getPartials mSTree)----- | Flatten a list of Templates into a single 'TemplateChache'-cacheFromList ∷ [Template] → TemplateCache-cacheFromList = flattenPartials ∘ fromList ∘ fmap (name &&& id)----- | Compiles a 'Template' directly from 'Text' without checking for missing partials.--- the result will be a 'Template' with an empty 'partials' cache.-compileTemplate ∷ String → Text → Either ParseError Template-compileTemplate name' = fmap (flip (Template name') (∅)) ∘ parse name'---{-|- Find the names of all included partials in a mustache STree.-- Same as @join . fmap getPartials'@--}-getPartials ∷ STree → [FilePath]-getPartials = join ∘ fmap getPartials'---{-|- Find partials in a single Node--}-getPartials' ∷ Node Text → [FilePath]-getPartials' (Partial _ p) = return p-getPartials' (Section _ n) = getPartials n-getPartials' (InvertedSection _ n) = getPartials n-getPartials' _ = (∅)---flattenPartials ∷ TemplateCache → TemplateCache-flattenPartials m = foldrWithKey (insertWith (\_ b -> b)) m m---{-|- @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
@@ -1,42 +0,0 @@-{-|-Module : $Header$-Description : Types and conversions-Copyright : (c) Justus Adam, 2015-License : LGPL-3-Maintainer : dev@justus.science-Stability : experimental-Portability : POSIX--escapeXML and xmlEntities curtesy to the tagsoup library.--}-{-# LANGUAGE UnicodeSyntax #-}-module Text.Mustache.Internal (uncons, escapeXMLText) where---import Data.Char (ord)-import qualified Data.IntMap as IntMap-import qualified Data.Text as T-import Prelude.Unicode---uncons ∷ [α] → Maybe (α, [α])-uncons [] = Nothing-uncons (x:xs) = return (x, xs)---escapeXMLText :: T.Text -> T.Text-escapeXMLText = T.pack ∘ escapeXML ∘ T.unpack---escapeXML :: String -> String-escapeXML = concatMap $ \x -> IntMap.findWithDefault [x] (ord x) mp- where mp = IntMap.fromList [(ord b, "&"++a++";") | (a,[b]) <- xmlEntities]---xmlEntities :: [(String, String)]-xmlEntities =- [ ("quot", "\"")- , ("amp" , "&")- , ("lt" , "<")- , ("gt" , ">")- ]
− src/lib/Text/Mustache/Parser.hs
@@ -1,315 +0,0 @@-{-|-Module : $Header$-Description : Basic functions for dealing with mustache templates.-Copyright : (c) Justus Adam, 2015-License : LGPL-3-Maintainer : dev@justus.science-Stability : experimental-Portability : POSIX--}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE UnicodeSyntax #-}-module Text.Mustache.Parser- (- -- * Generic parsing functions-- parse, parseWithConf-- -- * Configurations-- , MustacheConf, defaultConf-- -- * Parser-- , Parser, MustacheState-- -- * Mustache Constants-- , sectionBegin, sectionEnd, invertedSectionBegin, unescape2, unescape1- , delimiterChange, nestingSeparator-- ) where---import Control.Monad-import Control.Monad.Unicode-import Data.Char (isAlphaNum, isSpace)-import Data.Functor ((<$>))-import Data.List (nub)-import Data.Monoid.Unicode ((∅), (⊕))-import Data.Text as T (Text, null, pack)-import Prelude as Prel-import Prelude.Unicode-import Text.Mustache.Types-import Text.Parsec as P hiding (endOfLine, parse)----- | Initial configuration for the parser-data MustacheConf = MustacheConf- { delimiters ∷ (String, String)- }----- | User state for the parser-data MustacheState = MustacheState- { sDelimiters ∷ (String, String)- , textStack ∷ Text- , isBeginngingOfLine ∷ Bool- , currentSectionName ∷ Maybe DataIdentifier- }---data ParseTagRes- = SectionBegin Bool DataIdentifier- | SectionEnd DataIdentifier- | Tag (Node Text)- | HandledTag----- | @#@-sectionBegin ∷ Char-sectionBegin = '#'--- | @/@-sectionEnd ∷ Char-sectionEnd = '/'--- | @>@-partialBegin ∷ Char-partialBegin = '>'--- | @^@-invertedSectionBegin ∷ Char-invertedSectionBegin = '^'--- | @{@ and @}@-unescape2 ∷ (Char, Char)-unescape2 = ('{', '}')--- | @&@-unescape1 ∷ Char-unescape1 = '&'--- | @=@-delimiterChange ∷ Char-delimiterChange = '='--- | @.@-nestingSeparator ∷ Char-nestingSeparator = '.'--- | @!@-comment ∷ Char-comment = '!'--- | @.@-implicitIterator ∷ Char-implicitIterator = '.'--- | Cannot be a letter, number or the nesting separation Character @.@-isAllowedDelimiterCharacter ∷ Char → Bool-isAllowedDelimiterCharacter =- not ∘ Prel.or ∘ sequence- [ isSpace, isAlphaNum, (≡ nestingSeparator) ]-allowedDelimiterCharacter ∷ Parser Char-allowedDelimiterCharacter =- satisfy isAllowedDelimiterCharacter----- | Empty configuration-emptyState ∷ MustacheState-emptyState = MustacheState ("", "") (∅) True Nothing----- | Default configuration (delimiters = ("{{", "}}"))-defaultConf ∷ MustacheConf-defaultConf = MustacheConf ("{{", "}}")---initState ∷ MustacheConf → MustacheState-initState (MustacheConf { delimiters }) = emptyState { sDelimiters = delimiters }---setIsBeginning ∷ Bool → Parser ()-setIsBeginning b = modifyState (\s -> s { isBeginngingOfLine = b })----- | The parser monad in use-type Parser = Parsec Text MustacheState---(<<) ∷ Monad m ⇒ m b → m a → m b-(<<) = flip (≫)---endOfLine ∷ Parser String-endOfLine = do- r ← optionMaybe $ char '\r'- n ← char '\n'- return $ maybe id (:) r [n]---{-|- Runs the parser for a mustache template, returning the syntax tree.--}-parse ∷ FilePath → Text → Either ParseError STree-parse = parseWithConf defaultConf----- | Parse using a custom initial configuration-parseWithConf ∷ MustacheConf → FilePath → Text → Either ParseError STree-parseWithConf = P.runParser parseText ∘ initState---parseText ∷ Parser STree-parseText = do- (MustacheState { isBeginngingOfLine }) ← getState- if isBeginngingOfLine- then parseLine- else continueLine---appendStringStack ∷ String → Parser ()-appendStringStack t = modifyState (\s → s { textStack = textStack s ⊕ pack t})---continueLine ∷ Parser STree-continueLine = do- (MustacheState { sDelimiters = ( start@(x:_), _ )}) ← getState- let forbidden = x : "\n\r"-- many (noneOf forbidden) ≫= appendStringStack-- (try endOfLine ≫= appendStringStack ≫ setIsBeginning True ≫ parseLine)- <|> (try (string start) ≫ switchOnTag ≫= continueFromTag)- <|> (try eof ≫ finishFile)- <|> (anyChar ≫= appendStringStack . (:[]) ≫ continueLine)---flushText ∷ Parser STree-flushText = do- s@(MustacheState { textStack = text }) ← getState- putState $ s { textStack = (∅) }- return $ if T.null text- then []- else [TextBlock text]---finishFile ∷ Parser STree-finishFile =- getState ≫= \case- (MustacheState {currentSectionName = Nothing}) → flushText- (MustacheState {currentSectionName = Just name}) →- parserFail $ "Unclosed section " ⊕ show name---parseLine ∷ Parser STree-parseLine = do- (MustacheState { sDelimiters = ( start, _ ) }) ← getState- initialWhitespace ← many (oneOf " \t")- let handleStandalone = do- tag ← switchOnTag- let continueNoStandalone = do- appendStringStack initialWhitespace- setIsBeginning False- continueFromTag tag- standaloneEnding = do- try (skipMany (oneOf " \t") ≫ (eof <|> void endOfLine))- setIsBeginning True- case tag of- Tag (Partial _ name) →- ( standaloneEnding ≫- continueFromTag (Tag (Partial (Just (pack initialWhitespace)) name))- ) <|> continueNoStandalone- Tag _ → continueNoStandalone- _ →- ( standaloneEnding ≫- continueFromTag tag- ) <|> continueNoStandalone- (try (string start) ≫ handleStandalone)- <|> (try eof ≫ appendStringStack initialWhitespace ≫ finishFile)- <|> (appendStringStack initialWhitespace ≫ setIsBeginning False ≫ continueLine)---continueFromTag ∷ ParseTagRes → Parser STree-continueFromTag (SectionBegin inverted name) = do- textNodes ← flushText- state@(MustacheState- { currentSectionName = previousSection }) ← getState- putState $ state { currentSectionName = return name }- innerSectionContent ← parseText- let sectionTag =- if inverted- then InvertedSection- else Section- modifyState $ \s → s { currentSectionName = previousSection }- outerSectionContent ← parseText- return (textNodes ⊕ [sectionTag name innerSectionContent] ⊕ outerSectionContent)-continueFromTag (SectionEnd name) = do- (MustacheState- { currentSectionName }) ← getState- case currentSectionName of- Just name' | name' ≡ name → flushText- Just name' → parserFail $ "Expected closing sequence for \"" ⊕ show name ⊕ "\" got \"" ⊕ show name' ⊕ "\"."- Nothing → parserFail $ "Encountered closing sequence for \"" ⊕ show name ⊕ "\" which has never been opened."-continueFromTag (Tag tag) = do- textNodes ← flushText- furtherNodes ← parseText- return $ textNodes ⊕ return tag ⊕ furtherNodes-continueFromTag HandledTag = parseText---switchOnTag ∷ Parser ParseTagRes-switchOnTag = do- (MustacheState { sDelimiters = ( _, end )}) ← getState-- choice- [ SectionBegin False <$> (try (char sectionBegin) ≫ genParseTagEnd (∅))- , SectionEnd- <$> (try (char sectionEnd) ≫ genParseTagEnd (∅))- , Tag ∘ Variable False- <$> (try (char unescape1) ≫ genParseTagEnd (∅))- , Tag ∘ Variable False- <$> (try (char (fst unescape2)) ≫ genParseTagEnd (return $ snd unescape2))- , Tag ∘ Partial Nothing- <$> (try (char partialBegin) ≫ spaces ≫ (noneOf (nub end) `manyTill` try (spaces ≫ string end)))- , return HandledTag- << (try (char delimiterChange) ≫ parseDelimChange)- , SectionBegin True- <$> (try (char invertedSectionBegin) ≫ genParseTagEnd (∅) ≫= \case- n@(NamedData _) → return n- _ → parserFail "Inverted Sections can not be implicit."- )- , return HandledTag << (try (char comment) ≫ manyTill anyChar (try $ string end))- , Tag . Variable True- <$> genParseTagEnd (∅)- ]- where- parseDelimChange = do- (MustacheState { sDelimiters = ( _, end )}) ← getState- spaces- delim1 ← allowedDelimiterCharacter `manyTill` space- spaces- delim2 ← allowedDelimiterCharacter `manyTill` try (spaces ≫ string (delimiterChange : end))- when (delim1 ≡ (∅) ∨ delim2 ≡ (∅))- $ parserFail "Tags must contain more than 0 characters"- oldState ← getState- putState $ oldState { sDelimiters = (delim1, delim2) }---genParseTagEnd ∷ String → Parser DataIdentifier-genParseTagEnd emod = do- (MustacheState { sDelimiters = ( start, end ) }) ← getState-- let nEnd = emod ⊕ end- disallowed = nub $ nestingSeparator : start ⊕ end-- parseOne :: Parser [Text]- parseOne = do-- one ← noneOf disallowed- `manyTill` lookAhead- (try (spaces ≫ void (string nEnd))- <|> try (void $ char nestingSeparator))-- others ← (char nestingSeparator ≫ parseOne)- <|> (const (∅) <$> (spaces ≫ string nEnd))- return $ pack one : others- spaces- (try (char implicitIterator) ≫ spaces ≫ string nEnd ≫ return Implicit)- <|> (NamedData <$> parseOne)
− src/lib/Text/Mustache/Render.hs
@@ -1,184 +0,0 @@-{-|-Module : $Header$-Description : Functions for rendering mustache templates.-Copyright : (c) Justus Adam, 2015-License : LGPL-3-Maintainer : dev@justus.science-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 Control.Arrow (first)-import Control.Monad-import Control.Monad.Unicode-import Data.Foldable (fold)-import Data.HashMap.Strict as HM hiding (map)-import Data.Maybe (fromMaybe)-import Data.Monoid.Unicode-import Data.Scientific (floatingOrInteger)-import Data.Text as T (Text, isSuffixOf, null, pack,- replace, stripSuffix)-import qualified Data.Vector as V-import Prelude hiding (length, lines, unlines)-import Prelude.Unicode-import Text.Mustache.Internal-import Text.Mustache.Types---{-|- Substitutes all mustache defined tokens (or tags) for values found in the- provided data structure.-- Equivalent to @substituteValue . toMustache@.--}-substitute ∷ ToMustache κ ⇒ Template → κ → Text-substitute t = substituteValue t ∘ toMustache---{-|- Substitutes all mustache defined tokens (or tags) for values found in the- provided data structure.--}-substituteValue ∷ Template → Value → Text-substituteValue (Template { ast = cAst, partials = cPartials }) dataStruct =- joinSubstituted (substitute' (Context (∅) dataStruct)) cAst- where- joinSubstituted f = fold ∘ fmap f-- -- Main substitution function- substitute' ∷ Context Value → Node Text → Text-- -- subtituting text- substitute' _ (TextBlock t) = t-- -- substituting a whole section (entails a focus shift)- substitute' (Context parents focus@(Array a)) (Section Implicit secSTree)- | V.null a = (∅)- | otherwise = flip joinSubstituted a $ \focus' →- let- newContext = Context (focus:parents) focus'- in- joinSubstituted (substitute' newContext) secSTree- substitute' context@(Context _ (Object _)) (Section Implicit secSTree) =- joinSubstituted (substitute' context) secSTree- substitute' _ (Section Implicit _) = (∅)- substitute' context@(Context parents focus) (Section (NamedData secName) secSTree) =- case search context secName of- Just arr@(Array arrCont) →- if V.null arrCont- then (∅)- else flip joinSubstituted arrCont $ \focus' →- let- newContext = Context (arr:focus:parents) focus'- in- joinSubstituted (substitute' newContext) secSTree- Just (Bool False) → (∅)- Just (Lambda l) → joinSubstituted (substitute' context) (l context secSTree)- Just focus' →- let- newContext = Context (focus:parents) focus'- in- joinSubstituted (substitute' newContext) secSTree- Nothing → (∅)-- -- substituting an inverted section- substitute' _ (InvertedSection Implicit _ ) = (∅)- substitute' context (InvertedSection (NamedData secName) invSecSTree) =- case search context secName of- Just (Bool False) → contents- Just (Array a) | V.null a → contents- Nothing → contents- _ → (∅)- where- contents = joinSubstituted (substitute' context) invSecSTree-- -- substituting a variable- substitute' (Context _ current) (Variable _ Implicit) = toString current- substitute' context (Variable escaped (NamedData varName)) =- maybe- (∅)- (if escaped then escapeXMLText else id)- $ toString <$> search context varName-- -- substituting a partial- substitute' context (Partial indent pName) =- maybe- (∅)- (joinSubstituted (substitute' context) ∘ handleIndent indent ∘ ast)- $ HM.lookup pName cPartials---handleIndent ∷ Maybe Text → STree → STree-handleIndent Nothing ast' = ast'-handleIndent (Just indentation) ast' = preface ⊕ content- where- preface = if T.null indentation then [] else [TextBlock indentation]- content = if T.null indentation- then ast'- else- let- fullIndented = fmap (indentBy indentation) ast'- dropper (TextBlock t) = TextBlock $- if ("\n" ⊕ indentation) `isSuffixOf` t- then fromMaybe t $ stripSuffix indentation t- else t- dropper a = a- in- reverse $ fromMaybe [] (uncurry (:) ∘ first dropper <$> uncons (reverse fullIndented))----- | Search for a key in the current context.------ The search is conducted inside out mening the current focus--- is searched first. If the key is not found the outer scopes are recursively--- searched until the key is found, then 'innerSearch' is called on the result.-search ∷ Context Value → [Key] → Maybe Value-search _ [] = Nothing-search ctx keys@(_:nextKeys) = go ctx keys ≫= innerSearch nextKeys- where- go _ [] = Nothing- go (Context parents focus) val@(x:_) =- ( case focus of- (Object o) → HM.lookup x o- _ → Nothing- )- <|> ( do- (newFocus, newParents) ← uncons parents- go (Context newParents newFocus) val- )--indentBy ∷ Text → Node Text → Node Text-indentBy indent p@(Partial (Just indent') name')- | T.null indent = p- | otherwise = Partial (Just (indent ⊕ indent')) name'-indentBy indent (Partial Nothing name') = Partial (Just indent) name'-indentBy indent (TextBlock t) = TextBlock $ replace "\n" ("\n" ⊕ indent) t-indentBy _ a = a----- | Searches nested scopes navigating inward. Fails if it encunters something--- other than an object before the key is expended.-innerSearch ∷ [Key] → Value → Maybe Value-innerSearch [] v = Just v-innerSearch (y:ys) (Object o) = HM.lookup y o ≫= innerSearch ys-innerSearch _ _ = Nothing----- | Converts values to Text as required by the mustache standard-toString ∷ Value → Text-toString (String t) = t-toString (Number n) = either (pack ∘ show) (pack ∘ show) (floatingOrInteger n ∷ Either Double Integer)-toString e = pack $ show e
− src/lib/Text/Mustache/Types.hs
@@ -1,377 +0,0 @@-{-|-Module : $Header$-Description : Types and conversions-Copyright : (c) Justus Adam, 2015-License : LGPL-3-Maintainer : dev@justus.science-Stability : experimental-Portability : POSIX--}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE UnicodeSyntax #-}-module Text.Mustache.Types- (- -- * Types for the Parser / Template- STree- , Template(..)- , Node(..)- , DataIdentifier(..)- -- * Types for the Substitution / Data- , Value(..)- , Key- -- ** Converting- , object- , (~>), (↝), (~=), (⥱)- , ToMustache, toMustache, mFromJSON- -- ** Representation- , Array, Object, Pair- , Context(..)- , TemplateCache- ) where---import qualified Data.Aeson as Aeson-import Data.HashMap.Strict as HM-import qualified Data.HashSet as HS-import qualified Data.Map as Map-import Data.Scientific-import Data.Text-import qualified Data.Text.Lazy as LT-import qualified Data.Vector as V-import Prelude.Unicode---- | Syntax tree for a mustache template-type STree = [Node Text]----- | Basic values composing the STree-data Node α- = TextBlock α- | Section DataIdentifier STree- | InvertedSection DataIdentifier STree- | Variable Bool DataIdentifier- | Partial (Maybe α) FilePath- deriving (Show, Eq)----- | Kinds of identifiers for Variables and sections-data DataIdentifier- = NamedData [Key]- | Implicit- deriving (Show, Eq)----- | A list-like structure used in 'Value'-type Array = V.Vector Value--- | A map-like structure used in 'Value'-type Object = HM.HashMap Text Value--- | Source type for constructing 'Object's-type Pair = (Text, Value)----- | Representation of stateful context for the substitution process-data Context α = Context [α] α- deriving (Eq, Show, Ord)---- | Internal value representation-data Value- = Object Object- | Array Array- | Number Scientific- | String Text- | Lambda (Context Value → STree → STree)- | Bool Bool- | Null---instance Show Value where- show (Lambda _) = "Lambda function"- 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 ω where- toMustache ∷ ω → Value- listToMustache ∷ [ω] → Value- listToMustache = Array ∘ V.fromList ∘ fmap toMustache--instance ToMustache Float where- toMustache = Number ∘ fromFloatDigits--instance ToMustache Double where- toMustache = Number ∘ fromFloatDigits--instance ToMustache Integer where- toMustache = Number ∘ fromInteger--instance ToMustache Int where- toMustache = toMustache . toInteger--instance ToMustache Char where- toMustache = toMustache ∘ (:[])- listToMustache = String ∘ pack--instance ToMustache Value where- toMustache = id--instance ToMustache Bool where- toMustache = Bool--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 α ⇒ ToMustache [α] where- toMustache = listToMustache--instance ToMustache ω ⇒ ToMustache (V.Vector ω) where- toMustache = toMustache ∘ fmap toMustache--instance (ToMustache ω) ⇒ ToMustache (Map.Map Text ω) where- toMustache = mapInstanceHelper id--instance (ToMustache ω) ⇒ ToMustache (Map.Map LT.Text ω) where- toMustache = mapInstanceHelper LT.toStrict--instance (ToMustache ω) ⇒ ToMustache (Map.Map String ω) where- toMustache = mapInstanceHelper pack--mapInstanceHelper :: ToMustache v => (a -> Text) -> Map.Map a v -> Value-mapInstanceHelper conv =- toMustache- ∘ Map.foldrWithKey- (\k → HM.insert (conv k) ∘ toMustache)- HM.empty--instance ToMustache ω ⇒ ToMustache (HM.HashMap Text ω) where- toMustache = toMustache ∘ fmap toMustache--instance ToMustache ω ⇒ ToMustache (HM.HashMap LT.Text ω) where- toMustache = hashMapInstanceHelper LT.toStrict--instance ToMustache ω ⇒ ToMustache (HM.HashMap String ω) where- toMustache = hashMapInstanceHelper pack--hashMapInstanceHelper :: ToMustache v => (a -> Text) -> HM.HashMap a v -> Value-hashMapInstanceHelper conv =- toMustache- ∘ HM.foldrWithKey- (\k → HM.insert (conv k) ∘ toMustache)- HM.empty--instance ToMustache (Context Value → STree → STree) where- toMustache = Lambda--instance ToMustache (Context Value → STree → Text) where- toMustache = lambdaInstanceHelper id--instance ToMustache (Context Value → STree → LT.Text) where- toMustache = lambdaInstanceHelper LT.toStrict--instance ToMustache (Context Value → STree → String) where- toMustache = lambdaInstanceHelper pack--lambdaInstanceHelper :: (a -> Text) -> (Context Value -> STree -> a) -> Value-lambdaInstanceHelper conv f = Lambda wrapper- where- wrapper ∷ Context Value → STree → STree- wrapper c lSTree = return ∘ TextBlock $ conv $ f c lSTree--instance ToMustache (STree → STree) where- toMustache f = toMustache (const f ∷ Context Value → STree → STree)--instance ToMustache (STree → Text) where- toMustache f = toMustache wrapper- where- wrapper ∷ Context Value → STree → STree- wrapper _ = (return ∘ TextBlock) ∘ 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--instance ToMustache ω ⇒ ToMustache (HS.HashSet ω) where- toMustache = toMustache ∘ HS.toList--instance (ToMustache α, ToMustache β) ⇒ ToMustache (α, β) where- toMustache (a, b) = toMustache [toMustache a, toMustache b]--instance (ToMustache α, ToMustache β, ToMustache γ)- ⇒ ToMustache (α, β, γ) where- toMustache (a, b, c) = toMustache [toMustache a, toMustache b, toMustache c]--instance (ToMustache α, ToMustache β, ToMustache γ, ToMustache δ)- ⇒ ToMustache (α, β, γ, δ) where- toMustache (a, b, c, d) = toMustache- [ toMustache a- , toMustache b- , toMustache c- , toMustache d- ]--instance ( ToMustache α- , ToMustache β- , ToMustache γ- , ToMustache δ- , ToMustache ε- ) ⇒ ToMustache (α, β, γ, δ, ε) where- toMustache (a, b, c, d, e) = toMustache- [ toMustache a- , toMustache b- , toMustache c- , toMustache d- , toMustache e- ]--instance ( ToMustache α- , ToMustache β- , ToMustache γ- , ToMustache δ- , ToMustache ε- , ToMustache ζ- ) ⇒ ToMustache (α, β, γ, δ, ε, ζ) where- toMustache (a, b, c, d, e, f) = toMustache- [ toMustache a- , toMustache b- , toMustache c- , toMustache d- , toMustache e- , toMustache f- ]--instance ( ToMustache α- , ToMustache β- , ToMustache γ- , ToMustache δ- , ToMustache ε- , ToMustache ζ- , ToMustache η- ) ⇒ ToMustache (α, β, γ, δ, ε, ζ, η) where- toMustache (a, b, c, d, e, f, g) = toMustache- [ toMustache a- , toMustache b- , toMustache c- , toMustache d- , toMustache e- , toMustache f- , toMustache g- ]--instance ( ToMustache α- , ToMustache β- , ToMustache γ- , ToMustache δ- , ToMustache ε- , ToMustache ζ- , ToMustache η- , ToMustache θ- ) ⇒ ToMustache (α, β, γ, δ, ε, ζ, η, θ) where- toMustache (a, b, c, d, e, f, g, h) = toMustache- [ toMustache a- , toMustache b- , toMustache c- , toMustache d- , toMustache e- , toMustache f- , toMustache g- , toMustache h- ]---- | 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 ∷ [Pair] → Value-object = Object ∘ HM.fromList----- | Map keys to values that provide a 'ToMustache' instance------ Recommended in conjunction with the `OverloadedStrings` extension.-(~>) ∷ ToMustache ω ⇒ Text → ω → Pair-(~>) t = (t, ) ∘ toMustache-{-# INLINEABLE (~>) #-}-infixr 8 ~>---- | Unicode version of '~>'-(↝) ∷ ToMustache ω ⇒ Text → ω → Pair-(↝) = (~>)-{-# INLINEABLE (↝) #-}-infixr 8 ↝----- | Map keys to values that provide a 'ToJSON' instance------ Recommended in conjunction with the `OverloadedStrings` extension.-(~=) ∷ Aeson.ToJSON ι ⇒ Text → ι → Pair-(~=) t = (t ~>) ∘ Aeson.toJSON-{-# INLINEABLE (~=) #-}-infixr 8 ~=----- | Unicode version of '~='-(⥱) ∷ Aeson.ToJSON ι ⇒ Text → ι → Pair-(⥱) = (~=)-{-# INLINEABLE (⥱) #-}-infixr 8 ⥱----- | Converts a value that can be represented as JSON to a Value.-mFromJSON ∷ Aeson.ToJSON ι ⇒ ι → Value-mFromJSON = toMustache ∘ Aeson.toJSON----- | A collection of templates with quick access via their hashed names-type TemplateCache = HM.HashMap String Template---- | Type of key used for retrieving data from 'Value's-type Key = Text--{-|- A compiled Template with metadata.--}-data Template = Template- { name ∷ String- , ast ∷ STree- , partials ∷ TemplateCache- } deriving (Show)