diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/mustache.cabal b/mustache.cabal --- a/mustache.cabal +++ b/mustache.cabal @@ -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 diff --git a/src/lib/Text/Mustache.hs b/src/lib/Text/Mustache.hs --- a/src/lib/Text/Mustache.hs +++ b/src/lib/Text/Mustache.hs @@ -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 +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 diff --git a/src/lib/Text/Mustache/Compile.hs b/src/lib/Text/Mustache/Compile.hs --- a/src/lib/Text/Mustache/Compile.hs +++ b/src/lib/Text/Mustache/Compile.hs @@ -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' {-| diff --git a/src/lib/Text/Mustache/Internal.hs b/src/lib/Text/Mustache/Internal.hs --- a/src/lib/Text/Mustache/Internal.hs +++ b/src/lib/Text/Mustache/Internal.hs @@ -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 diff --git a/src/lib/Text/Mustache/Parser.hs b/src/lib/Text/Mustache/Parser.hs --- a/src/lib/Text/Mustache/Parser.hs +++ b/src/lib/Text/Mustache/Parser.hs @@ -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 diff --git a/src/lib/Text/Mustache/Render.hs b/src/lib/Text/Mustache/Render.hs --- a/src/lib/Text/Mustache/Render.hs +++ b/src/lib/Text/Mustache/Render.hs @@ -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) diff --git a/src/lib/Text/Mustache/Types.hs b/src/lib/Text/Mustache/Types.hs --- a/src/lib/Text/Mustache/Types.hs +++ b/src/lib/Text/Mustache/Types.hs @@ -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) diff --git a/test/integration/Language.hs b/test/integration/Language.hs new file mode 100644 --- /dev/null +++ b/test/integration/Language.hs @@ -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) diff --git a/test/unit/Spec.hs b/test/unit/Spec.hs --- a/test/unit/Spec.hs +++ b/test/unit/Spec.hs @@ -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}}{{=<< >>=}}<><>" `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" ~> ("" :: 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" ~> ("" :: T.Text)]) `shouldBe` "" @@ -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