mustache 0.1.0.0 → 0.2.0.0
raw patch · 11 files changed
+792/−430 lines, 11 filesdep +base-unicode-symbolsdep +ja-base-extradep +processsetup-changed
Dependencies added: base-unicode-symbols, ja-base-extra, process, temporary
Files
- README.md +3/−3
- Setup.hs +1/−1
- mustache.cabal +17/−5
- src/bin/Main.hs +33/−52
- src/lib/Text/Mustache.hs +31/−8
- src/lib/Text/Mustache/Compile.hs +62/−29
- src/lib/Text/Mustache/Internal.hs +4/−4
- src/lib/Text/Mustache/Parser.hs +213/−147
- src/lib/Text/Mustache/Render.hs +89/−44
- src/lib/Text/Mustache/Types.hs +185/−90
- test/unit/Spec.hs +154/−47
README.md view
@@ -1,4 +1,4 @@-# mustache [](https://travis-ci.org/JustusAdam/mustache)+# mustache [](https://travis-ci.org/JustusAdam/mustache) [](https://hackage.haskell.org/package/mustache) [](https://gitter.im/JustusAdam/mustache?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) Haskell implementation of [mustache templates][mustache-homepage]. @@ -6,7 +6,7 @@ ## 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.+The old Haskell implementation of mustache templates [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 @@ -41,6 +41,6 @@ - [x] Support for 'set delimiter' - [x] More efficiency using `Text` rather than `String` - [x] More efficient Text parsing-- [ ] Full unittest coverage (partially done)+- [x] Test coverage by the official [specs](https://github.com/mustache/spec) - [x] Haddock documentation - [ ] More instances for `ToMustache` typeclass
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple+import Distribution.Simple main = defaultMain
mustache.cabal view
@@ -1,9 +1,11 @@ name: mustache-version: 0.1.0.0+version: 0.2.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>.++ Implements the mustache spec version 1.1.3 license: BSD3 license-file: LICENSE author: Justus Adam@@ -24,7 +26,7 @@ type: git branch: master location: git://github.com/JustusAdam/mustache.git- tag: 0.1.0.0+ tag: v1.0.0.0rc-0 @@ -52,7 +54,9 @@ filepath, scientific, conversion >= 1.2,- conversion-text+ conversion-text,+ base-unicode-symbols,+ ja-base-extra >= 0.2.1 hs-source-dirs: src/lib default-language: Haskell2010 ghc-options:@@ -70,7 +74,8 @@ aeson, cmdargs, text,- filepath+ filepath,+ base-unicode-symbols default-language: Haskell2010 hs-source-dirs: src/bin @@ -82,6 +87,13 @@ hspec, text, mustache,- aeson+ aeson,+ unordered-containers,+ yaml,+ filepath,+ process,+ temporary,+ directory,+ base-unicode-symbols hs-source-dirs: test/unit default-language: Haskell2010
src/bin/Main.hs view
@@ -4,88 +4,69 @@ 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+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]- , dataFile ∷ FilePath- , outputFile ∷ Maybe FilePath- , dataFormat ∷ Maybe String+ , dataFiles ∷ [FilePath] } deriving (Show, Data, Typeable) commandArgs ∷ Arguments commandArgs = Arguments- { template = def+ { template = def &= argPos 0 &= typ "TEMPLATE"- , dataFile = def- &= argPos 1- &= typ "DATAFILE"- , outputFile = Nothing- &= help "Name of the resulting file"- &= typFile+ , dataFiles = def+ &= args+ &= typ "DATA-FILES" , 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+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+readYAML = fmap decodeEither ∘ B.readFile main ∷ IO () main = do- a@(Arguments { dataFormat, template, templateDirs, dataFile, outputFile })- ← cmdArgs commandArgs+ (Arguments { template, templateDirs, dataFiles }) ← cmdArgs commandArgs - print a- eitherTemplate ← compileTemplate templateDirs template+ eitherTemplate ← automaticCompile templateDirs template case eitherTemplate of Left err → print err- Right compiledTemplate → do-- let decode = fromMaybe readJSON $- (dataFormat >>= getReader)- <|> getReader (drop 1 $ takeExtension dataFile)+ Right compiledTemplate →+ for_ dataFiles $ \file → do - let write = maybe TIO.putStrLn TIO.writeFile outputFile- decoded ← decode dataFile+ let decoder =+ case takeExtension file of+ ".yml" → readYAML+ ".yaml" → readYAML+ _ → readJSON+ decoded ← decoder file - either- putStrLn- write- $ decoded >>=- substitute compiledTemplate . toMustache+ either+ putStrLn+ (TIO.putStrLn ∘ substitute compiledTemplate ∘ toMustache)+ decoded
src/lib/Text/Mustache.hs view
@@ -6,6 +6,35 @@ Maintainer : development@justusadam.com Stability : experimental Portability : POSIX++* How to use this library++This module exposes some of the most convenient functions for dealing with mustache+templates.++The easiest way of compiling a file and its potential includes (called partials)+is by using the 'compileTemplate' function.+@+ -- the search space encompasses all directories in which the compiler should+ -- search for the template source files+ --+ -- the search is conducted in order, from left to right.+ let searchSpace = [".", "./templates"]+ -- the templateName is the relative path of the template to any directory+ -- of the search space+ templateName = "main.mustache"++ compiled <- automaticCompile searchSpace templateName+ case compiled of+ -- the compiler will throw errors if either the template is malformed+ -- or the source file for a partial could not be found+ Left err -> print err+ Right template -> return () -- this is where you can start using it+@++Should your search space be only the current working directory, you can use+'localAutomaticCompile'.+ -} {-# LANGUAGE LambdaCase #-} module Text.Mustache@@ -13,10 +42,10 @@ -- * Compiling -- ** Automatic- compileTemplate+ automaticCompile, localAutomaticCompile -- ** Manually- , compileTemplateWithCache, parseTemplate, MustacheTemplate(..)+ , compileTemplateWithCache, parseTemplate, Template(..) -- * Rendering @@ -30,12 +59,6 @@ -- ** 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
src/lib/Text/Mustache/Compile.hs view
@@ -1,26 +1,35 @@ {-# LANGUAGE UnicodeSyntax #-}-module Text.Mustache.Compile where+module Text.Mustache.Compile+ ( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache+ , parseTemplate, cacheFromList, getPartials+ ) where -import Control.Applicative+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.Foldable (fold)-import Data.List-import Data.Monoid+import Data.Function.JAExtra+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.Types import Text.Mustache.Parser+import Text.Mustache.Types import Text.Parsec.Error import Text.Parsec.Pos import Text.Printf +type TemplateCache = HM.HashMap String Template++ {-| Compiles a mustache template provided by name including the mentioned partials. @@ -32,56 +41,80 @@ 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+automaticCompile ∷ [FilePath] → FilePath → IO (Either ParseError Template)+automaticCompile searchSpace = compileTemplateWithCache searchSpace (∅) +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] → [MustacheTemplate] → FilePath → IO (Either ParseError MustacheTemplate)-compileTemplateWithCache searchSpace = (runEitherT .) . compile'+compileTemplateWithCache ∷ [FilePath]+ → TemplateCache+ → FilePath+ → IO (Either ParseError Template)+compileTemplateWithCache searchSpace templates initName =+ runEitherT $ evalStateT (compile' initName) $ flattenPartials templates where- compile' templates name' =- case find ((== name') . name) templates of+ 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 ← getFile searchSpace name'- compiled@(MustacheTemplate { ast = mast }) ←- hoistEither $ parseTemplate name' rawSource+ rawSource ← lift $ getFile searchSpace name'+ compiled@(Template { ast = mAST }) ←+ lift $ hoistEither $ parseTemplate name' rawSource foldM- (\st@(MustacheTemplate { partials = p }) partialName →- compile' (p <> templates) partialName >>=- \nt → return (st { partials = nt : p })+ (\st@(Template { partials = p }) partialName → do+ nt ← compile' partialName+ modify (HM.insert partialName nt)+ return (st { partials = HM.insert partialName nt p }) ) compiled- (getPartials mast)+ (getPartials mAST) -parseTemplate ∷ String → Text → Either ParseError MustacheTemplate-parseTemplate name' = fmap (flip (MustacheTemplate name') mempty) . parse name'+cacheFromList ∷ [Template] → TemplateCache+cacheFromList = flattenPartials ∘ fromList ∘ fmap (name &&& id) +parseTemplate ∷ String → Text → Either ParseError Template+parseTemplate name' = fmap (flip (Template name') (∅)) ∘ 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'+getPartials ∷ AST → [FilePath]+getPartials = join ∘ fmap getPartials' {-|- Find partials in a single MustacheNode+ Find partials in a single Node -}-getPartials' ∷ MustacheNode Text → [FilePath]-getPartials' (MustachePartial p) = return p-getPartials' (MustacheSection _ n) = getPartials n-getPartials' _ = mempty+getPartials' ∷ Node Text → [FilePath]+getPartials' (Partial _ p) = return p+getPartials' (Section _ n) = getPartials n+getPartials' (InvertedSection _ n) = getPartials n+getPartials' _ = (∅) +flattenPartials ∷ TemplateCache → TemplateCache+flattenPartials = stuffWith $ foldrWithKey $ insertWith discard++ {-| @getFile searchSpace file@ iteratively searches all directories in @searchSpace@ for a @file@ returning it if found or raising an error if none@@ -93,7 +126,7 @@ getFile ∷ [FilePath] → FilePath → EitherT ParseError IO Text getFile [] fp = throwError $ fileNotFound fp getFile (templateDir : xs) fp =- lift (doesFileExist filePath) >>=+ lift (doesFileExist filePath) ≫= bool (getFile xs fp) (lift $ TIO.readFile filePath)
src/lib/Text/Mustache/Internal.hs view
@@ -4,9 +4,9 @@ #if MIN_VERSION_base(4,8,0)- import Data.List (uncons)+import Data.List (uncons) #else- uncons ∷ [a] → Maybe (a, [a])- uncons [] = Nothing- uncons (x:xs) = return (x, xs)+uncons ∷ [a] → Maybe (a, [a])+uncons [] = Nothing+uncons (x:xs) = return (x, xs) #endif
src/lib/Text/Mustache/Parser.hs view
@@ -1,16 +1,10 @@-{-|-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 #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnicodeSyntax #-} module Text.Mustache.Parser ( -- * Generic parsing functions@@ -19,16 +13,15 @@ -- * Configurations - , MustacheConf, emptyConf, defaultConf+ , MustacheConf, defaultConf -- * Parser - , MustacheParser+ , Parser -- ** Components - , genParseTag, parseSection, parseTag, parseVariable, parsePartial, parseText- , parseInvertedSection, parseDelimiterChange, parseUnescapedVar, parseEnd+ , parseText -- * Mustache Constants @@ -39,199 +32,272 @@ 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 Control.Monad.Unicode+import Conversion (Conversion, convert)+import Conversion.Text ()+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 (parse)+import Text.Parsec as P hiding (endOfLine, parse) data MustacheConf = MustacheConf { delimiters ∷ (String, String) } ++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 ∷ String-sectionBegin = "#"+sectionBegin ∷ Char+sectionBegin = '#' -- | @/@-sectionEnd ∷ String-sectionEnd = "/"+sectionEnd ∷ Char+sectionEnd = '/' -- | @>@-partialBegin ∷ String-partialBegin = ">"+partialBegin ∷ Char+partialBegin = '>' -- | @^@-invertedSectionBegin ∷ String-invertedSectionBegin = "^"+invertedSectionBegin ∷ Char+invertedSectionBegin = '^' -- | @{@ and @}@-unescape2 ∷ (String, String)-unescape2 = ("{", "}")+unescape2 ∷ (Char, Char)+unescape2 = ('{', '}') -- | @&@-unescape1 ∷ String-unescape1 = "&"+unescape1 ∷ Char+unescape1 = '&' -- | @=@-delimiterChange ∷ String-delimiterChange = "="+delimiterChange ∷ Char+delimiterChange = '=' -- | @.@-nestingSeparator ∷ String-nestingSeparator = "."+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, flip elem nestingSeparator ]-allowedDelimiterCharacter ∷ MustacheParser Char+ not ∘ Prel.or ∘ sequence+ [ isSpace, isAlphaNum, (≡ nestingSeparator) ]+allowedDelimiterCharacter ∷ Parser Char allowedDelimiterCharacter = satisfy isAllowedDelimiterCharacter -- | Empty configuration-emptyConf ∷ MustacheConf-emptyConf = MustacheConf ("", "")+emptyState ∷ MustacheState+emptyState = MustacheState ("", "") (∅) True Nothing -- | Default configuration (delimiters = ("{{", "}}")) defaultConf ∷ MustacheConf-defaultConf = emptyConf { delimiters = ("{{", "}}") }+defaultConf = MustacheConf ("{{", "}}") -type MustacheParser = Parsec Text MustacheConf-type MNodeParser = MustacheParser (MustacheNode Text)+initState ∷ MustacheConf → MustacheState+initState (MustacheConf { delimiters }) = emptyState { sDelimiters = delimiters } +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 MustacheAST+parse ∷ FilePath → Text → Either ParseError AST parse = parseWithConf defaultConf -parseWithConf ∷ MustacheConf → FilePath → Text → Either ParseError MustacheAST-parseWithConf = P.runParser (parseText Nothing)+parseWithConf ∷ MustacheConf → FilePath → Text → Either ParseError AST+parseWithConf = P.runParser parseText ∘ initState -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+parseText ∷ Parser AST+parseText = do+ (MustacheState { isBeginngingOfLine }) ← getState+ if isBeginngingOfLine+ then parseLine+ else continueLine +appendTextStack ∷ Conversion t Text ⇒ t → Parser ()+appendTextStack t = modifyState (\s → s { textStack = textStack s ⊕ convert t}) -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)+continueLine ∷ Parser AST+continueLine = do+ (MustacheState { sDelimiters = ( start, _ )}) ← getState+ let forbidden = head start : "\n\r" + many (noneOf forbidden) ≫= appendTextStack -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)+ (try endOfLine ≫= appendTextStack ≫ modifyState (\s → s { isBeginngingOfLine = True }) ≫ parseLine)+ <|> (try (string start) ≫ switchOnTag ≫= continueFromTag)+ <|> (try eof ≫ finishFile)+ <|> (anyChar ≫= appendTextStack ≫ continueLine) -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) }+flushText ∷ Parser AST+flushText = do+ s@(MustacheState { textStack = text }) ← getState+ putState $ s { textStack = (∅) }+ return $ if T.null text+ then []+ else [TextBlock text] -parseInvertedSection ∷ MNodeParser-parseInvertedSection = do- sectionName ← genParseTag invertedSectionBegin mempty- MustacheInvertedSection sectionName <$> parseText (return sectionName)+finishFile ∷ Parser AST+finishFile =+ getState ≫= \case+ (MustacheState {currentSectionName = Nothing}) → flushText+ (MustacheState {currentSectionName = Just name}) →+ parserFail $ "Unclosed section " ⊕ show name -parseUnescapedVar ∷ MNodeParser-parseUnescapedVar = MustacheVariable False <$>- (try (uncurry genParseTag unescape2) <|> genParseTag unescape1 mempty)+parseLine ∷ Parser AST+parseLine = do+ (MustacheState { sDelimiters = ( start, _ ) }) ← getState+ initialWhitespace ← many (oneOf " \t")+ let handleStandalone = do+ tag ← switchOnTag+ let continueNoStandalone = do+ appendTextStack initialWhitespace+ modifyState (\s → s { isBeginngingOfLine = False })+ continueFromTag tag+ standaloneEnding = do+ try (skipMany (oneOf " \t") ≫ (eof <|> void endOfLine))+ modifyState (\s → s { isBeginngingOfLine = 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 ≫ appendTextStack initialWhitespace ≫ finishFile)+ <|> (appendTextStack initialWhitespace ≫ modifyState (\s → s { isBeginngingOfLine = False }) ≫ continueLine) -parseVariable ∷ MNodeParser-parseVariable = MustacheVariable True <$> genParseTag mempty mempty+continueFromTag ∷ ParseTagRes → Parser AST+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 -parseEnd ∷ Maybe [Text] -> MustacheParser ()-parseEnd tagName = do- tag ← genParseTag sectionEnd mempty- unless (isSameSection tag) $- parserFail $- maybe- (unexpectedSection tag)- (`unexpectedClosingSequence` tag)- tagName+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- isSameSection = maybe (const True) (==) tagName+ 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) } -genParseTag ∷ String → String → MustacheParser [Text]-genParseTag smod emod = do- (MustacheConf { delimiters = ( start, end ) }) <- getState+genParseTagEnd ∷ String → Parser DataIdentifier+genParseTagEnd emod = do+ (MustacheState { sDelimiters = ( start, end ) }) ← getState - let nStart = start <> smod- nEnd = emod <> end- disallowed = nub $ nestingSeparator <> start <> end+ let nEnd = emod ⊕ end+ disallowed = nub $ nestingSeparator : start ⊕ end - parseOne :: MustacheParser [Text]+ parseOne :: Parser [Text] parseOne = do- spaces one ← noneOf disallowed `manyTill` lookAhead- (try (spaces >> void (string nEnd))- <|> try (void $ string nestingSeparator))+ (try (spaces ≫ void (string nEnd))+ <|> try (void $ char nestingSeparator)) - others ← (string nestingSeparator >> parseOne)- <|> (const mempty <$> (spaces >> string nEnd))+ others ← (char nestingSeparator ≫ parseOne)+ <|> (const (∅) <$> (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- <> "'"+ spaces+ (try (char implicitIterator) ≫ spaces ≫ string nEnd ≫ return Implicit)+ <|> (NamedData <$> parseOne)
src/lib/Text/Mustache/Render.hs view
@@ -19,19 +19,24 @@ , toString ) where ----import Control.Applicative ((<|>), (<$>))-import Data.Foldable (fold, find)++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.Monoid (mempty, (<>))-import Data.Text hiding (concat, find, map, uncons)-import qualified Data.Text as T-import Data.Traversable (traverse)+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.HTML.TagSoup (escapeHTML) import Text.Mustache.Internal import Text.Mustache.Types-import Text.Printf {-|@@ -40,94 +45,134 @@ Equivalent to @substituteValue . toMustache@. -}-substitute ∷ ToMustache j ⇒ MustacheTemplate → j → Either String Text-substitute t = substituteValue t . toMustache+substitute ∷ ToMustache j ⇒ Template → j → 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+substituteValue ∷ Template → Value → Text+substituteValue (Template { ast = cAst, partials = cPartials }) dataStruct =+ joinSubstituted (substitute' (Context (∅) dataStruct)) cAst where- joinSubstituted f = fmap fold . traverse f+ joinSubstituted f = fold ∘ fmap f -- Main substitution function- substitute' ∷ Context Value → MustacheNode Text → Either String Text+ substitute' ∷ Context Value → Node Text → Text -- subtituting text- substitute' _ (MustacheText t) = return t+ substitute' _ (TextBlock t) = t -- substituting a whole section (entails a focus shift)- substitute' context@(Context parents focus) (MustacheSection secName secAST) =+ substitute' (Context parents focus@(Array a)) (Section Implicit secAST)+ | V.null a = (∅)+ | otherwise = flip joinSubstituted a $ \focus' →+ let+ newContext = Context (focus:parents) focus'+ in+ joinSubstituted (substitute' newContext) secAST+ substitute' context@(Context _ (Object _)) (Section Implicit secAST) =+ joinSubstituted (substitute' context) secAST+ substitute' _ (Section Implicit _) = (∅)+ substitute' context@(Context parents focus) (Section (NamedData secName) secAST) = case search context secName of Just arr@(Array arrCont) → if V.null arrCont- then return mempty+ then (∅) 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' →+ Just (Bool False) → (∅)+ Just (Lambda l) → joinSubstituted (substitute' context) (l context secAST)+ Just focus' → let newContext = Context (focus:parents) focus' in joinSubstituted (substitute' newContext) secAST- Nothing → return mempty+ Nothing → (∅) -- substituting an inverted section- substitute' context (MustacheInvertedSection invSecName invSecAST) =- case search context invSecName of- Just (Bool False) → contents+ substitute' _ (InvertedSection Implicit _ ) = (∅)+ substitute' context (InvertedSection (NamedData secName) invSecAST) =+ case search context secName of+ Just (Bool False) → contents Just (Array a) | V.null a → contents- Nothing → contents- _ → return mempty+ Nothing → contents+ _ → (∅) where contents = joinSubstituted (substitute' context) invSecAST -- substituting a variable- substitute' context (MustacheVariable escaped varName) =- return $ maybe- mempty+ substitute' (Context _ current) (Variable _ Implicit) = toString current+ substitute' context (Variable escaped (NamedData varName)) =+ maybe+ (∅) (if escaped then escapeHTML else id) $ toString <$> search context varName -- substituting a partial- substitute' context (MustachePartial pName) =+ substitute' context (Partial indent pName) = maybe- (Left $ printf "Could not find partial '%s'" pName)- (joinSubstituted (substitute' context) . ast)- $ find ((== pName) . name) cPartials+ (∅)+ (joinSubstituted (substitute' context) ∘ handleIndent indent ∘ ast)+ $ HM.lookup pName cPartials -search ∷ Context Value → [T.Text] → Maybe Value+handleIndent ∷ Maybe Text → AST → AST+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 ∷ Context Value → [Text] → Maybe Value search _ [] = Nothing search (Context parents focus) val@(x:xs) = ( ( case focus of (Object o) → HM.lookup x o- _ → Nothing+ _ → Nothing )- <|> (do- (newFocus, newParents) <- uncons parents+ <|> ( do+ (newFocus, newParents) ← uncons parents search (Context newParents newFocus) val ) )- >>= innerSearch xs+ ≫= innerSearch xs +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 -innerSearch ∷ [T.Text] → Value → Maybe Value-innerSearch [] v = Just v-innerSearch (y:ys) (Object o) = HM.lookup y o >>= innerSearch ys-innerSearch _ _ = Nothing +innerSearch ∷ [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+toString (Number n) = either (pack ∘ show) (pack ∘ show) (floatingOrInteger n ∷ Either Double Integer)+toString e = pack $ show e
src/lib/Text/Mustache/Types.hs view
@@ -7,96 +7,106 @@ Stability : experimental Portability : POSIX -}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnicodeSyntax #-} module Text.Mustache.Types ( -- * Types for the Parser / Template- MustacheAST- , MustacheTemplate(..)- , MustacheNode(..)+ AST+ , Template(..)+ , Node(..)+ , DataIdentifier(..) -- * Types for the Substitution / Data , Value(..) -- ** Converting , object- , (~>), (~=), (~~>), (~~=)- , ToMustache, toMustache, toMustacheText, mFromJSON+ , (~>), (↝), (~=), (⥱), (~~>), (~↝), (~~=), (~⥱)+ , ToMustache, toMustache, toTextBlock, mFromJSON -- ** Representation , Array, Object , Context(..) ) where +import Conversion+import Conversion.Text () 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 ()-+import Prelude.Unicode -- | Abstract syntax tree for a mustache template-type MustacheAST = [MustacheNode Text]+type AST = [Node Text] -- | Basic values composing the AST-data MustacheNode a- = MustacheText a- | MustacheSection [Text] MustacheAST- | MustacheInvertedSection [Text] MustacheAST- | MustacheVariable Bool [Text]- | MustachePartial FilePath+data Node α+ = TextBlock α+ | Section DataIdentifier AST+ | InvertedSection DataIdentifier AST+ | Variable Bool DataIdentifier+ | Partial (Maybe α) FilePath deriving (Show, Eq) -type Array = V.Vector Value+data DataIdentifier+ = NamedData [Text]+ | Implicit+ deriving (Show, Eq)+++type Array = V.Vector Value type Object = HM.HashMap Text Value-type KeyValuePair = (Text, Value)+type Pair = (Text, Value) -- | Representation of stateful context for the substitution process-data Context a = Context [a] a+data Context α = Context [α] α -- | Internal value AST data Value = Object Object- | Array Array+ | Array Array | Number Scientific | String Text- | Lambda (Context Value → MustacheAST → Either String MustacheAST)- | Bool Bool+ | Lambda (Context Value → AST → AST)+ | 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"+ show (Lambda _) = "Lambda Context Value → AST → Either String AST"+ 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+class ToMustache ω where+ toMustache ∷ ω → Value +instance ToMustache Value where+ toMustache = id+ instance ToMustache [Char] where- toMustache = String . pack+ toMustache = String ∘ pack instance ToMustache Bool where toMustache = Bool instance ToMustache Char where- toMustache = String . pack . return+ toMustache = String ∘ pack ∘ return instance ToMustache () where toMustache = const Null@@ -105,57 +115,40 @@ toMustache = String instance ToMustache LT.Text where- toMustache = String . LT.toStrict+ 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 ω ⇒ ToMustache [ω] where+ toMustache = Array ∘ V.fromList ∘ fmap toMustache -instance ToMustache m ⇒ ToMustache (V.Vector m) where- toMustache = Array . fmap toMustache+instance ToMustache ω ⇒ ToMustache (V.Vector ω) where+ toMustache = Array ∘ fmap toMustache -instance ToMustache m ⇒ ToMustache (HM.HashMap Text m) where- toMustache = Object . fmap toMustache+instance ToMustache ω ⇒ ToMustache (HM.HashMap Text ω) where+ toMustache = Object ∘ fmap toMustache -instance ToMustache (Context Value → MustacheAST → Either String MustacheAST) where+instance ToMustache (Context Value → AST → AST) 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+instance ToMustache (Context Value → AST → Text) where toMustache f = Lambda wrapper- where wrapper c = Right . return . MustacheText . f c+ where wrapper c lAST = return ∘ TextBlock $ f c lAST -instance ToMustache (Context Value → MustacheAST → String) where+instance ToMustache (Context Value → AST → String) where toMustache f = toMustache wrapper- where wrapper c = pack . f c+ where wrapper c = pack ∘ f c -instance ToMustache (MustacheAST → Either String MustacheAST) where+instance ToMustache (AST → AST) where toMustache f = Lambda $ const f -instance ToMustache (MustacheAST → Either String Text) where+instance ToMustache (AST → 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)+ where wrapper _ = (return ∘ TextBlock) ∘ f -instance ToMustache (MustacheAST → String) where- toMustache f = toMustache (pack . f)+instance ToMustache (AST → String) where+ toMustache f = toMustache (pack ∘ f) instance ToMustache Aeson.Value where toMustache (Aeson.Object o) = Object $ fmap toMustache o@@ -163,9 +156,92 @@ toMustache (Aeson.Number n) = Number n toMustache (Aeson.String s) = String s toMustache (Aeson.Bool b) = Bool b- toMustache (Aeson.Null) = Null+ toMustache Aeson.Null = Null +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.@@ -190,48 +266,67 @@ -- 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+object ∷ [Pair] → 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+(~>) ∷ ToMustache ω ⇒ Text → ω → Pair+(~>) t = (t, ) ∘ toMustache +-- | Unicode version of '~>'+(↝) ∷ ToMustache ω ⇒ Text → ω → Pair+(↝) = (~>)++ -- | 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+(~=) ∷ Aeson.ToJSON ι ⇒ Text → ι → Pair+(~=) t = (t ~>) ∘ Aeson.toJSON +-- | Unicode version of '~='+(⥱) ∷ Aeson.ToJSON ι ⇒ Text → ι → Pair+(⥱) = (~=)+ -- | Conceptually similar to '~>' but uses arbitrary String-likes as keys.-(~~>) ∷ (Conversion t Text, ToMustache m) ⇒ t → m → KeyValuePair-(~~>) = (~>) . convert+(~~>) ∷ (Conversion ζ Text, ToMustache ω) ⇒ ζ → ω → Pair+(~~>) = (~>) ∘ convert +-- | Unicde version of '~~>'+(~↝) ∷ (Conversion ζ Text, ToMustache ω) ⇒ ζ → ω → Pair+(~↝) = (~~>)+ -- | Conceptually similar to '~=' but uses arbitrary String-likes as keys.-(~~=) ∷ (Conversion t Text, Aeson.ToJSON j) ⇒ t → j → KeyValuePair-(~~=) = (~=) . convert+(~~=) ∷ (Conversion ζ Text, Aeson.ToJSON ι) ⇒ ζ → ι → Pair+(~~=) = (~=) ∘ convert +-- | Unicode version of '~~='+(~⥱) ∷ (Conversion ζ Text, Aeson.ToJSON ι) ⇒ ζ → ι → Pair+(~⥱) = (~~=)++ -- | Converts arbitrary String-likes to Values-toMustacheText ∷ Conversion t Text ⇒ t → Value-toMustacheText = String . convert+toTextBlock ∷ Conversion ζ Text ⇒ ζ → Value+toTextBlock = String ∘ convert -- | Converts a value that can be represented as JSON to a Value.-mFromJSON ∷ Aeson.ToJSON j ⇒ j → Value-mFromJSON = toMustache . Aeson.toJSON+mFromJSON ∷ Aeson.ToJSON ι ⇒ ι → Value+mFromJSON = toMustache ∘ Aeson.toJSON {-| A compiled Template with metadata. -}-data MustacheTemplate = MustacheTemplate { name ∷ String- , ast ∷ MustacheAST- , partials ∷ [MustacheTemplate]- } deriving (Show)+data Template = Template+ { name ∷ String+ , ast ∷ AST+ , partials ∷ HashMap String Template+ } deriving (Show)
test/unit/Spec.hs view
@@ -1,16 +1,77 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UnicodeSyntax #-} module Main where +import Control.Applicative ((<$>), (<*>))+import Control.Monad import Data.Either-import Data.Monoid (mempty)+import Data.Foldable (for_)+import qualified Data.HashMap.Strict as HM (HashMap, elems, empty, lookup,+ traverseWithKey)+import Data.List+import Data.Monoid (mempty, (<>)) import qualified Data.Text as T+import Data.Yaml as Y (FromJSON, Value (..), decodeFile,+ parseJSON, (.!=), (.:), (.:?))+import Debug.Trace (traceShowId)+import System.Directory+import System.FilePath+import System.IO.Temp+import System.Process import Test.Hspec import Text.Mustache-import Text.Mustache.Types import Text.Mustache.Parser+import Text.Mustache.Types +langspecDir = "spec-1.1.3"+specDir = "specs"+releaseFile = "langspec.tar.gz"+releaseURL = "https://codeload.github.com/mustache/spec/tar.gz/v1.1.3"+++data LangSpecFile = LangSpecFile+ { overview :: String+ , tests :: [LangSpecTest]+ }+++data LangSpecTest = LangSpecTest+ { name :: String+ , specDescription :: String+ , specData :: Y.Value+ , template :: T.Text+ , expected :: T.Text+ , testPartials :: HM.HashMap String T.Text+ }+++instance FromJSON LangSpecFile where+ parseJSON (Y.Object o) = LangSpecFile+ <$> o .: "overview"+ <*> o .: "tests"+ parseJSON _ = mzero+++instance FromJSON LangSpecTest where+ parseJSON (Y.Object o) = LangSpecTest+ <$> o .: "name"+ <*> o .: "desc"+ <*> o .: "data"+ <*> o .: "template"+ <*> o .: "expected"+ <*> o .:? "partials" .!= HM.empty+ parseJSON _ = mzero+++(&) ∷ a → (a → b) → b+(&) = flip ($)++ parserSpec :: Spec parserSpec = describe "mustacheParser" $ do@@ -20,162 +81,208 @@ let text = "test12356p0--=-34{}jnv,\n" it "parses text" $- lparse text `shouldBe` returnedOne (MustacheText text)+ lparse text `shouldBe` returnedOne (TextBlock text) it "parses a variable" $- lparse "{{name}}" `shouldBe` returnedOne (MustacheVariable True ["name"])+ lparse "{{name}}" `shouldBe` returnedOne (Variable True (NamedData ["name"])) it "parses a variable with whitespace" $- lparse "{{ name }}" `shouldBe` returnedOne (MustacheVariable True ["name"])+ lparse "{{ name }}" `shouldBe` returnedOne (Variable True (NamedData ["name"])) it "allows '-' in variable names" $ lparse "{{ name-name }}" `shouldBe`- returnedOne (MustacheVariable True ["name-name"])+ returnedOne (Variable True (NamedData ["name-name"])) it "allows '_' in variable names" $ lparse "{{ name_name }}" `shouldBe`- returnedOne (MustacheVariable True ["name_name"])+ returnedOne (Variable True (NamedData ["name_name"])) it "parses a variable unescaped with {{{}}}" $- lparse "{{{name}}}" `shouldBe` returnedOne (MustacheVariable False ["name"])+ lparse "{{{name}}}" `shouldBe` returnedOne (Variable False (NamedData ["name"])) it "parses a variable unescaped with {{{}}} with whitespace" $ lparse "{{{ name }}}" `shouldBe`- returnedOne (MustacheVariable False ["name"])+ returnedOne (Variable False (NamedData ["name"])) it "parses a variable unescaped with &" $- lparse "{{&name}}" `shouldBe` returnedOne (MustacheVariable False ["name"])+ lparse "{{&name}}" `shouldBe` returnedOne (Variable False (NamedData ["name"])) it "parses a variable unescaped with & with whitespace" $ lparse "{{& name }}" `shouldBe`- returnedOne (MustacheVariable False ["name"])+ returnedOne (Variable False (NamedData ["name"])) it "parses a partial" $ lparse "{{>myPartial}}" `shouldBe`- returnedOne (MustachePartial "myPartial")+ returnedOne (Partial (Just "") "myPartial") it "parses a partial with whitespace" $ lparse "{{> myPartial }}" `shouldBe`- returnedOne (MustachePartial "myPartial")+ returnedOne (Partial (Just "") "myPartial") it "parses the an empty section" $ lparse "{{#section}}{{/section}}" `shouldBe`- returnedOne (MustacheSection ["section"] mempty)+ returnedOne (Section (NamedData ["section"]) mempty) it "parses the an empty section with whitespace" $ lparse "{{# section }}{{/ section }}" `shouldBe`- returnedOne (MustacheSection ["section"] mempty)+ returnedOne (Section (NamedData ["section"]) mempty) it "parses a delimiter change" $ lparse "{{=<< >>=}}<<var>>{{var}}" `shouldBe`- return [MustacheVariable True ["var"], MustacheText "{{var}}"]+ return [Variable True (NamedData ["var"]), TextBlock "{{var}}"] it "parses a delimiter change with whitespace" $ lparse "{{=<< >>=}}<< var >>{{var}}" `shouldBe`- return [MustacheVariable True ["var"], MustacheText "{{var}}"]+ return [Variable True (NamedData ["var"]), TextBlock "{{var}}"] it "parses two subsequent delimiter changes" $ lparse "{{=(( ))=}}(( var ))((=-- $-=))--#section$---/section$-" `shouldBe`- return [MustacheVariable True ["var"], MustacheSection ["section"] []]+ return [Variable True (NamedData ["var"]), Section (NamedData ["section"]) []] it "propagates a delimiter change from a nested scope" $ lparse "{{#section}}{{=<< >>=}}<</section>><<var>>" `shouldBe`- return [MustacheSection ["section"] [], MustacheVariable True ["var"]]+ return [Section (NamedData ["section"]) [], Variable True (NamedData ["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"])+ lparse "{{ name.val }}" `shouldBe` returnedOne (Variable True (NamedData ["name", "val"])) it "parses a variable containing whitespace" $- lparse "{{ val space }}" `shouldBe` returnedOne (MustacheVariable True ["val space"])+ lparse "{{ val space }}" `shouldBe` returnedOne (Variable True (NamedData ["val space"])) substituteSpec :: Spec substituteSpec = describe "substitute" $ do - let toTemplate ast' = MustacheTemplate "testsuite" ast' []+ let toTemplate ast' = Template "testsuite" ast' mempty it "substitutes a html escaped value for a variable" $ substitute- (toTemplate [MustacheVariable True ["name"]])+ (toTemplate [Variable True (NamedData ["name"])]) (object ["name" ~> ("<tag>" :: T.Text)])- `shouldBe` return "<tag>"+ `shouldBe` "<tag>" it "substitutes raw value for an unescaped variable" $ substitute- (toTemplate [MustacheVariable False ["name"]])+ (toTemplate [Variable False (NamedData ["name"])]) (object ["name" ~> ("<tag>" :: T.Text)])- `shouldBe` return "<tag>"+ `shouldBe` "<tag>" it "substitutes a section when the key is present (and an empty object)" $ substitute- (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> object []])- `shouldBe` return "t"+ `shouldBe` "t" it "substitutes a section when the key is present (and 'true')" $ substitute- (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> True])- `shouldBe` return "t"+ `shouldBe` "t" it "substitutes a section once when the key is present and a singleton list" $ substitute- (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> ["True" :: T.Text]])- `shouldBe` return "t"+ `shouldBe` "t" it "substitutes a section twice when the key is present and a list with two items" $ substitute- (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> (["True", "False"] :: [T.Text])])- `shouldBe` return "tt"+ `shouldBe` "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"]]])+ (toTemplate [Section (NamedData ["section"]) [Variable True (NamedData ["t"])]]) (object [ "section" ~> [ object ["t" ~> ("var1" :: T.Text)] , object ["t" ~> ("var2" :: T.Text)] ] ])- `shouldBe` return "var1var2"+ `shouldBe` "var1var2" it "does not substitute a section when the key is not present" $ substitute- (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object [])- `shouldBe` return ""+ `shouldBe` "" it "does not substitute a section when the key is present (and 'false')" $ substitute- (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> False])- `shouldBe` return ""+ `shouldBe` "" it "does not substitute a section when the key is present (and empty list)" $ substitute- (toTemplate [MustacheSection ["section"] [MustacheText "t"]])+ (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) (object ["section" ~> ([] :: [T.Text])])- `shouldBe` return ""+ `shouldBe` "" it "substitutes a nested section" $ substitute- (toTemplate [MustacheVariable True ["outer", "inner"]])+ (toTemplate [Variable True (NamedData ["outer", "inner"])]) (object [ "outer" ~> object ["inner" ~> ("success" :: T.Text)] , "inner" ~> ("error" :: T.Text) ] )- `shouldBe` return "success"+ `shouldBe` "success" +getOfficialSpecRelease ∷ FilePath → IO ()+getOfficialSpecRelease tempdir = do+ currentDirectory ← getCurrentDirectory+ setCurrentDirectory tempdir+ createDirectory langspecDir+ callProcess "curl" [releaseURL, "-o", releaseFile]+ callProcess "tar" ["-xf", releaseFile]+ getDirectoryContents "." >>= print+ setCurrentDirectory currentDirectory+++testOfficialLangSpec ∷ FilePath → Spec+testOfficialLangSpec dir = do+ allFiles ← runIO $ getDirectoryContents dir+ let testfiles = allFiles+ & filter ((`elem` [".yml", ".yaml"]) . takeExtension)+ -- Filters the lambda tests for now.+ & filter (not . ("~" `isPrefixOf`) . takeFileName)+ for_ testfiles $ \filename →+ runIO (decodeFile (dir </> filename)) >>= \case+ Nothing -> describe ("File: " <> takeFileName filename) $+ it "loads the data file" $+ expectationFailure "Data file could not be parsed"+ Just (LangSpecFile { tests }) →+ describe ("File: " <> takeFileName filename) $+ for_ tests $ \(LangSpecTest { .. }) →+ it ("Name: " <> name <> " Description: " <> specDescription) $+ let+ compiled = do+ partials' <- HM.traverseWithKey parseTemplate testPartials+ template' <- parseTemplate name template+ return $ template' { partials = partials' }+ in+ case compiled of+ Left m → expectationFailure $ show m+ Right tmp →+ substituteValue tmp (toMustache specData) `shouldBe` expected++ main :: IO ()-main = hspec $ do- parserSpec- substituteSpec+main =+ void $+ withSystemTempDirectory+ "mustache-test-resources"+ $ \tempdir → do+ getOfficialSpecRelease tempdir+ hspec $ do+ parserSpec+ substituteSpec+ testOfficialLangSpec (tempdir </> langspecDir </> specDir)