mustache 0.2.0.0 → 0.3.0.0
raw patch · 10 files changed
+454/−198 lines, 10 filesdep +containersdep −uniplatedep ~aesondep ~text
Dependencies added: containers
Dependencies removed: uniplate
Dependency ranges changed: aeson, text
Files
- README.md +7/−3
- mustache.cabal +26/−8
- src/lib/Text/Mustache.hs +131/−16
- src/lib/Text/Mustache/Compile.hs +17/−7
- src/lib/Text/Mustache/Internal.hs +9/−5
- src/lib/Text/Mustache/Parser.hs +25/−11
- src/lib/Text/Mustache/Render.hs +17/−10
- src/lib/Text/Mustache/Types.hs +81/−22
- test/integration/Language.hs +122/−0
- test/unit/Spec.hs +19/−116
README.md view
@@ -4,6 +4,8 @@ [mustache-homepage]: https://mustache.github.io +Implements the official [specs version 1.1.3](https://github.com/mustache/spec/releases/tag/v1.1.3)+ ## Motivation 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.@@ -16,8 +18,10 @@ ### Library -... Soon™+Please refer to the [documentation][] on hackage. +[documentation]: https://hackage.haskell.org/package/mustache+ ### Executable `haskell-mustache` $ haskell-mustache --help@@ -31,7 +35,7 @@ -? --help Display help message -V --version Print version information -Currenty substitutes the `TEMPLATE` once with each `DATA-FILE`+Current implementation substitutes the `TEMPLATE` once with each `DATA-FILE` ## Roadmap @@ -41,6 +45,6 @@ - [x] Support for 'set delimiter' - [x] More efficiency using `Text` rather than `String` - [x] More efficient Text parsing-- [x] Test coverage by the official [specs](https://github.com/mustache/spec)+- [x] Test coverage provided via the official [specs](https://github.com/mustache/spec) - [x] Haddock documentation - [ ] More instances for `ToMustache` typeclass
mustache.cabal view
@@ -1,5 +1,5 @@ name: mustache-version: 0.2.0.0+version: 0.3.0.0 synopsis: A mustache template parser library. description: Allows parsing and rendering template files with mustache markup. See the@@ -10,6 +10,8 @@ license-file: LICENSE author: Justus Adam maintainer: dev@justus.science+homepage: https://github.com/JustusAdam/mustache+bug-reports: https://github.com/JustusAdam/mustache/issues -- copyright: category: Development build-type: Simple@@ -26,7 +28,7 @@ type: git branch: master location: git://github.com/JustusAdam/mustache.git- tag: v1.0.0.0rc-0+ tag: v0.3.0.0rc-1 @@ -37,32 +39,29 @@ Text.Mustache.Compile, Text.Mustache.Render other-modules: Text.Mustache.Internal- other-extensions: NamedFieldPuns, OverloadedStrings, LambdaCase, TupleSections, CPP+ other-extensions: NamedFieldPuns, OverloadedStrings, LambdaCase, TupleSections build-depends: base >=4.7 && <5, text >=1.2 && <1.3, parsec >=3.1 && <3.2, mtl >=2.2 && <2.3, either, aeson,- uniplate, unordered-containers, vector, tagsoup, bytestring,- hspec, directory, filepath, scientific, conversion >= 1.2, conversion-text, base-unicode-symbols,- ja-base-extra >= 0.2.1+ ja-base-extra >= 0.2.1,+ containers hs-source-dirs: src/lib default-language: Haskell2010 ghc-options: -Wall- -optP-include- -optPdist/build/autogen/cabal_macros.h executable haskell-mustache@@ -96,4 +95,23 @@ directory, base-unicode-symbols hs-source-dirs: test/unit+ default-language: Haskell2010+++test-suite language-specifications+ main-is: Language.hs+ type: exitcode-stdio-1.0+ build-depends: base >=4.7 && <5,+ hspec,+ text,+ mustache,+ aeson,+ unordered-containers,+ yaml,+ filepath,+ process,+ temporary,+ directory,+ base-unicode-symbols+ hs-source-dirs: test/integration default-language: Haskell2010
src/lib/Text/Mustache.hs view
@@ -3,38 +3,153 @@ Description : Basic functions for dealing with mustache templates. Copyright : (c) Justus Adam, 2015 License : LGPL-3-Maintainer : development@justusadam.com+Maintainer : dev@justus.science Stability : experimental Portability : POSIX -* How to use this library+= 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 'compileTemplate' function.+is by using the 'automaticCompile' 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.+main :: IO ()+main = do 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+ 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. Alternatively the '~~>' operator+can be used, which accepts an arbitrary string-like, converting it to text.++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 'AST', the abstract 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 'AST' 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@@ -45,7 +160,7 @@ automaticCompile, localAutomaticCompile -- ** Manually- , compileTemplateWithCache, parseTemplate, Template(..)+ , compileTemplateWithCache, compileTemplate, Template(..) -- * Rendering
src/lib/Text/Mustache/Compile.hs view
@@ -1,7 +1,16 @@+{-|+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- , parseTemplate, cacheFromList, getPartials+ , compileTemplate, cacheFromList, getPartials, getFile ) where @@ -27,9 +36,6 @@ import Text.Printf -type TemplateCache = HM.HashMap String Template-- {-| Compiles a mustache template provided by name including the mentioned partials. @@ -45,6 +51,7 @@ 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 ["."] @@ -72,7 +79,7 @@ Nothing → do rawSource ← lift $ getFile searchSpace name' compiled@(Template { ast = mAST }) ←- lift $ hoistEither $ parseTemplate name' rawSource+ lift $ hoistEither $ compileTemplate name' rawSource foldM (\st@(Template { partials = p }) partialName → do@@ -84,12 +91,15 @@ (getPartials mAST) +-- | Flatten a list of Templates into a single 'TemplateChache' cacheFromList ∷ [Template] → TemplateCache cacheFromList = flattenPartials ∘ fromList ∘ fmap (name &&& id) -parseTemplate ∷ String → Text → Either ParseError Template-parseTemplate name' = fmap (flip (Template name') (∅)) ∘ parse name'+-- | 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' {-|
src/lib/Text/Mustache/Internal.hs view
@@ -1,12 +1,16 @@-{-# LANGUAGE CPP #-}+{-|+Module : $Header$+Description : Types and conversions+Copyright : (c) Justus Adam, 2015+License : LGPL-3+Maintainer : dev@justus.science+Stability : experimental+Portability : POSIX+-} {-# LANGUAGE UnicodeSyntax #-} module Text.Mustache.Internal (uncons) where -#if MIN_VERSION_base(4,8,0)-import Data.List (uncons)-#else uncons ∷ [a] → Maybe (a, [a]) uncons [] = Nothing uncons (x:xs) = return (x, xs)-#endif
src/lib/Text/Mustache/Parser.hs view
@@ -1,3 +1,12 @@+{-|+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 #-}@@ -17,11 +26,7 @@ -- * Parser - , Parser-- -- ** Components-- , parseText+ , Parser, MustacheState -- * Mustache Constants @@ -46,11 +51,13 @@ 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@@ -58,6 +65,7 @@ , currentSectionName ∷ Maybe DataIdentifier } + data ParseTagRes = SectionBegin Bool DataIdentifier | SectionEnd DataIdentifier@@ -119,6 +127,11 @@ 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 @@ -140,6 +153,7 @@ parse = parseWithConf defaultConf +-- | Parse using a custom initial configuration parseWithConf ∷ MustacheConf → FilePath → Text → Either ParseError AST parseWithConf = P.runParser parseText ∘ initState @@ -158,12 +172,12 @@ continueLine ∷ Parser AST continueLine = do- (MustacheState { sDelimiters = ( start, _ )}) ← getState- let forbidden = head start : "\n\r"+ (MustacheState { sDelimiters = ( start@(x:_), _ )}) ← getState+ let forbidden = x : "\n\r" many (noneOf forbidden) ≫= appendTextStack - (try endOfLine ≫= appendTextStack ≫ modifyState (\s → s { isBeginngingOfLine = True }) ≫ parseLine)+ (try endOfLine ≫= appendTextStack ≫ setIsBeginning True ≫ parseLine) <|> (try (string start) ≫ switchOnTag ≫= continueFromTag) <|> (try eof ≫ finishFile) <|> (anyChar ≫= appendTextStack ≫ continueLine)@@ -194,11 +208,11 @@ tag ← switchOnTag let continueNoStandalone = do appendTextStack initialWhitespace- modifyState (\s → s { isBeginngingOfLine = False })+ setIsBeginning False continueFromTag tag standaloneEnding = do try (skipMany (oneOf " \t") ≫ (eof <|> void endOfLine))- modifyState (\s → s { isBeginngingOfLine = True })+ setIsBeginning True case tag of Tag (Partial _ name) → ( standaloneEnding ≫@@ -211,7 +225,7 @@ ) <|> continueNoStandalone (try (string start) ≫ handleStandalone) <|> (try eof ≫ appendTextStack initialWhitespace ≫ finishFile)- <|> (appendTextStack initialWhitespace ≫ modifyState (\s → s { isBeginngingOfLine = False }) ≫ continueLine)+ <|> (appendTextStack initialWhitespace ≫ setIsBeginning False ≫ continueLine) continueFromTag ∷ ParseTagRes → Parser AST
src/lib/Text/Mustache/Render.hs view
@@ -3,7 +3,7 @@ Description : Functions for rendering mustache templates. Copyright : (c) Justus Adam, 2015 License : LGPL-3-Maintainer : development@justusadam.com+Maintainer : dev@justus.science Stability : experimental Portability : POSIX -}@@ -45,7 +45,7 @@ Equivalent to @substituteValue . toMustache@. -}-substitute ∷ ToMustache j ⇒ Template → j → Text+substitute ∷ ToMustache κ ⇒ Template → κ → Text substitute t = substituteValue t ∘ toMustache @@ -141,22 +141,26 @@ reverse $ fromMaybe [] (uncurry (:) ∘ first dropper <$> uncons (reverse fullIndented)) -search ∷ Context Value → [Text] → Maybe Value+-- | 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 (Context parents focus) val@(x:xs) =- (+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- search (Context newParents newFocus) val+ go (Context newParents newFocus) val )- )- ≫= innerSearch xs - indentBy ∷ Text → Node Text → Node Text indentBy indent p@(Partial (Just indent') name') | T.null indent = p@@ -166,12 +170,15 @@ indentBy _ a = a -innerSearch ∷ [Text] → Value → Maybe Value+-- | 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)
src/lib/Text/Mustache/Types.hs view
@@ -3,7 +3,7 @@ Description : Types and conversions Copyright : (c) Justus Adam, 2015 License : LGPL-3-Maintainer : development@justusadam.com+Maintainer : dev@justus.science Stability : experimental Portability : POSIX -}@@ -21,13 +21,15 @@ , DataIdentifier(..) -- * Types for the Substitution / Data , Value(..)+ , Key -- ** Converting , object , (~>), (↝), (~=), (⥱), (~~>), (~↝), (~~=), (~⥱) , ToMustache, toMustache, toTextBlock, mFromJSON -- ** Representation- , Array, Object+ , Array, Object, Pair , Context(..)+ , TemplateCache ) where @@ -35,6 +37,8 @@ import Conversion.Text () 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@@ -55,20 +59,24 @@ deriving (Show, Eq) +-- | Kinds of identifiers for Variables and sections data DataIdentifier- = NamedData [Text]+ = 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 AST data Value@@ -82,7 +90,7 @@ instance Show Value where- show (Lambda _) = "Lambda Context Value → AST → Either String AST"+ show (Lambda _) = "Lambda function" show (Object o) = show o show (Array a) = show a show (String s) = show s@@ -92,6 +100,9 @@ -- | Conversion class+--+-- Note that some instances of this class overlap delierately to provide+-- maximum flexibility instances while preserving maximum efficiency. class ToMustache ω where toMustache ∷ ω → Value @@ -100,7 +111,7 @@ toMustache = id instance ToMustache [Char] where- toMustache = String ∘ pack+ toMustache = toMustache ∘ pack instance ToMustache Bool where toMustache = Bool@@ -123,32 +134,70 @@ instance ToMustache ω ⇒ ToMustache [ω] where toMustache = Array ∘ V.fromList ∘ fmap toMustache +-- TODO Add these back in when you find a way to do so on earlier GHC versions+-- or you drop support for GHC < 7.10+-- instance {-# OVERLAPPING #-} ToMustache (V.Vector Value) where+-- toMustache = Array+ instance ToMustache ω ⇒ ToMustache (V.Vector ω) where- toMustache = Array ∘ fmap toMustache+ toMustache = toMustache ∘ fmap toMustache +-- TODO Add these back in when you find a way to do so on earlier GHC versions+-- or you drop support for GHC < 7.10+-- instance {-# OVERLAPPING #-} ToMustache (HM.HashMap Text Value) where+-- toMustache = Object+++instance (Conversion θ Text, ToMustache ω) ⇒ ToMustache (Map.Map θ ω) where+ toMustache =+ toMustache+ ∘ Map.foldrWithKey+ (\k → HM.insert (convert k ∷ Text) ∘ toMustache)+ HM.empty+ instance ToMustache ω ⇒ ToMustache (HM.HashMap Text ω) where- toMustache = Object ∘ fmap toMustache+ toMustache = toMustache ∘ fmap toMustache + -- TODO Add these back in when you find a way to do so on earlier GHC versions+ -- or you drop support for GHC < 7.10+-- instance (Conversion θ Text, ToMustache ω) ⇒ ToMustache (HM.HashMap θ ω) where+-- toMustache =+-- toMustache+-- ∘ HM.foldrWithKey+-- (\k → HM.insert (convert k ∷ Text) ∘ toMustache)+-- HM.empty+ instance ToMustache (Context Value → AST → AST) where toMustache = Lambda instance ToMustache (Context Value → AST → Text) where- toMustache f = Lambda wrapper- where wrapper c lAST = return ∘ TextBlock $ f c lAST--instance ToMustache (Context Value → AST → String) where toMustache f = toMustache wrapper- where wrapper c = pack ∘ f c+ where+ wrapper ∷ Context Value → AST → AST+ wrapper c lAST = return ∘ TextBlock $ f c lAST +-- TODO Add these back in when you find a way to do so on earlier GHC versions+-- or you drop support for GHC < 7.10+-- instance {-# OVERLAPPABLE #-} Conversion θ Text+-- ⇒ ToMustache (Context Value → AST → θ) where+-- toMustache f = toMustache wrapper+-- where+-- wrapper :: Context Value → AST → Text+-- wrapper c = convert ∘ f c+ instance ToMustache (AST → AST) where- toMustache f = Lambda $ const f+ toMustache f = toMustache (const f ∷ Context Value → AST → AST) instance ToMustache (AST → Text) where- toMustache f = Lambda wrapper- where wrapper _ = (return ∘ TextBlock) ∘ f+ toMustache f = toMustache wrapper+ where+ wrapper ∷ Context Value → AST → AST+ wrapper _ = (return ∘ TextBlock) ∘ f -instance ToMustache (AST → String) where- toMustache f = toMustache (pack ∘ f)+-- TODO Add these back in when you find a way to do so on earlier GHC versions+-- or you drop support for GHC < 7.10+-- instance {-# OVERLAPPABLE #-} Conversion θ Text ⇒ ToMustache (AST → θ) where+-- toMustache f = toMustache (convert ∘ f ∷ AST → Text) instance ToMustache Aeson.Value where toMustache (Aeson.Object o) = Object $ fmap toMustache o@@ -158,6 +207,9 @@ 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] @@ -263,9 +315,10 @@ -- ] -- @ ----- 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.+-- 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 @@ -322,11 +375,17 @@ 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 ∷ AST- , partials ∷ HashMap String Template+ , partials ∷ TemplateCache } deriving (Show)
+ test/integration/Language.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE RecordWildCards #-}+module Main where++import Control.Applicative ((<$>), (<*>))+import Control.Monad+import Data.Either+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.Parser+import Text.Mustache.Types++-- langspecDir = "spec-1.1.3"+langspecDir = "andrewthad-spec-786e4ac"+specDir = "specs"+releaseFile = "langspec.tar.gz"+-- releaseURL = "https://codeload.github.com/mustache/spec/tar.gz/v1.1.3"+releaseURL = "https://codeload.github.com/andrewthad/spec/legacy.tar.gz/add_list_context_check"+++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 ($)+++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 compileTemplate testPartials+ template' <- compileTemplate 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 =+ void $+ withSystemTempDirectory+ "mustache-test-resources"+ $ \tempdir → do+ getOfficialSpecRelease tempdir+ hspec $+ testOfficialLangSpec (tempdir </> langspecDir </> specDir)
test/unit/Spec.hs view
@@ -1,75 +1,24 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UnicodeSyntax #-} module Main where import Control.Applicative ((<$>), (<*>))-import Control.Monad import Data.Either-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.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+import Data.Monoid -(&) ∷ a → (a → b) → b-(&) = flip ($)+escaped ∷ Bool+escaped = True+unescaped ∷ Bool+unescaped = False parserSpec :: Spec@@ -84,10 +33,10 @@ lparse text `shouldBe` returnedOne (TextBlock text) it "parses a variable" $- lparse "{{name}}" `shouldBe` returnedOne (Variable True (NamedData ["name"]))+ lparse "{{name}}" `shouldBe` returnedOne (Variable escaped (NamedData ["name"])) it "parses a variable with whitespace" $- lparse "{{ name }}" `shouldBe` returnedOne (Variable True (NamedData ["name"]))+ lparse "{{ name }}" `shouldBe` returnedOne (Variable escaped (NamedData ["name"])) it "allows '-' in variable names" $ lparse "{{ name-name }}" `shouldBe`@@ -98,14 +47,14 @@ returnedOne (Variable True (NamedData ["name_name"])) it "parses a variable unescaped with {{{}}}" $- lparse "{{{name}}}" `shouldBe` returnedOne (Variable False (NamedData ["name"]))+ lparse "{{{name}}}" `shouldBe` returnedOne (Variable unescaped (NamedData ["name"])) it "parses a variable unescaped with {{{}}} with whitespace" $ lparse "{{{ name }}}" `shouldBe` returnedOne (Variable False (NamedData ["name"])) it "parses a variable unescaped with &" $- lparse "{{&name}}" `shouldBe` returnedOne (Variable False (NamedData ["name"]))+ lparse "{{&name}}" `shouldBe` returnedOne (Variable unescaped (NamedData ["name"])) it "parses a variable unescaped with & with whitespace" $ lparse "{{& name }}" `shouldBe`@@ -141,16 +90,16 @@ it "propagates a delimiter change from a nested scope" $ lparse "{{#section}}{{=<< >>=}}<</section>><<var>>" `shouldBe`- return [Section (NamedData ["section"]) [], Variable True (NamedData ["var"])]+ return [Section (NamedData ["section"]) [], Variable escaped (NamedData ["var"])] it "fails if the tag contains illegal characters" $ lparse "{{#&}}" `shouldSatisfy` isLeft it "parses a nested variable" $- lparse "{{ name.val }}" `shouldBe` returnedOne (Variable True (NamedData ["name", "val"]))+ lparse "{{ name.val }}" `shouldBe` returnedOne (Variable escaped (NamedData ["name", "val"])) it "parses a variable containing whitespace" $- lparse "{{ val space }}" `shouldBe` returnedOne (Variable True (NamedData ["val space"]))+ lparse "{{ val space }}" `shouldBe` returnedOne (Variable escaped (NamedData ["val space"])) substituteSpec :: Spec@@ -161,13 +110,13 @@ it "substitutes a html escaped value for a variable" $ substitute- (toTemplate [Variable True (NamedData ["name"])])+ (toTemplate [Variable escaped (NamedData ["name"])]) (object ["name" ~> ("<tag>" :: T.Text)]) `shouldBe` "<tag>" it "substitutes raw value for an unescaped variable" $ substitute- (toTemplate [Variable False (NamedData ["name"])])+ (toTemplate [Variable unescaped (NamedData ["name"])]) (object ["name" ~> ("<tag>" :: T.Text)]) `shouldBe` "<tag>" @@ -198,7 +147,7 @@ it "substitutes a section twice when the key is present and a list with two\ \ objects, changing the scope to each object" $ substitute- (toTemplate [Section (NamedData ["section"]) [Variable True (NamedData ["t"])]])+ (toTemplate [Section (NamedData ["section"]) [Variable escaped (NamedData ["t"])]]) (object [ "section" ~> [ object ["t" ~> ("var1" :: T.Text)]@@ -227,7 +176,7 @@ it "substitutes a nested section" $ substitute- (toTemplate [Variable True (NamedData ["outer", "inner"])])+ (toTemplate [Variable escaped (NamedData ["outer", "inner"])]) (object [ "outer" ~> object ["inner" ~> ("success" :: T.Text)] , "inner" ~> ("error" :: T.Text)@@ -236,53 +185,7 @@ `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 =- void $- withSystemTempDirectory- "mustache-test-resources"- $ \tempdir → do- getOfficialSpecRelease tempdir- hspec $ do- parserSpec- substituteSpec- testOfficialLangSpec (tempdir </> langspecDir </> specDir)+main = hspec $ do+ parserSpec+ substituteSpec