diff options
Diffstat (limited to 'mustache')
| -rw-r--r-- | mustache/CHANGELOG.md | 104 | ||||
| -rw-r--r-- | mustache/LICENSE | 30 | ||||
| -rw-r--r-- | mustache/README.md | 54 | ||||
| -rw-r--r-- | mustache/Setup.hs | 2 | ||||
| -rw-r--r-- | mustache/app/Main.hs | 72 | ||||
| -rw-r--r-- | mustache/mustache.cabal | 141 | ||||
| -rw-r--r-- | mustache/src/Text/Mustache.hs | 197 | ||||
| -rw-r--r-- | mustache/src/Text/Mustache/Compile.hs | 213 | ||||
| -rw-r--r-- | mustache/src/Text/Mustache/Internal.hs | 41 | ||||
| -rw-r--r-- | mustache/src/Text/Mustache/Internal/Types.hs | 412 | ||||
| -rw-r--r-- | mustache/src/Text/Mustache/Parser.hs | 311 | ||||
| -rw-r--r-- | mustache/src/Text/Mustache/Render.hs | 248 | ||||
| -rw-r--r-- | mustache/src/Text/Mustache/Types.hs | 110 | ||||
| -rw-r--r-- | mustache/test/integration/Language.hs | 110 | ||||
| -rw-r--r-- | mustache/test/unit/Spec.hs | 260 | ||||
| -rw-r--r-- | mustache/test/unit/examples/partials/test-partial.txt.mustache | 1 | ||||
| -rw-r--r-- | mustache/test/unit/examples/test-template-partials.txt.mustache | 1 | ||||
| -rw-r--r-- | mustache/test/unit/examples/test-template.txt.mustache | 1 |
18 files changed, 2308 insertions, 0 deletions
diff --git a/mustache/CHANGELOG.md b/mustache/CHANGELOG.md new file mode 100644 index 0000000..9ccacff --- /dev/null +++ b/mustache/CHANGELOG.md @@ -0,0 +1,104 @@ +# Mustache library changelog + +## v2.4.2 + +- Also treat Null as falsey in inverted sections + +## v2.4.1 +- Compatibility with `containers >= 0.2.17` + +## v2.4.0 + +- Support for aeson 2 + +## v2.3.2 + +- Added support for GHC 9.0.1 + +## v2.3.0 + +- Changed `EitherT` to `ExceptT` (deprecation) +- removed `getFile` from public API + +## v2.2.3 + +- Quick fix to prevent catchSubstitute from reporting substitutions to the renderer. + +## v2.2.2 + +- Added a function to catch a substitution result + +## v2.2.1 + +- Quickfix for an issue with resolving in context + +## v2.2 + +- changed substitution into a new monad + + easier usage in lambdas and lambdas can now do nested substitution + +## v2.1.4 + +- Treat Null as falsy in sections + +## v2.1.3 + +- Added excaping for the apostrophe "'" as per xml spec, courtesy to @tfausak + +## v2.1.2 + +- Fixed template cache again, as the spec requires access to the previous cache in partials as well + +## v2.1.1 + +- Fixed an error where the substitution of partials would not use the template cache of the new partial + +## v2.1 + +- Added API preserving checked substitution with 'checkedSubstitute' and 'checkedSubstituteValue' +- Better and more ToMustache instances. No longer are all sequences of characters serialised as strings + +## v2.0 + +- Added QuasiQuotes and template Haskell functions for compile time template embedding. + +## v1.0 + +- Stabilised API's + +## v0.5.1.0rc-7 + +- Removed dependency tagsoup +- Added ToMustache instances for some numbers + +## v0.5.0.0rc-6 + +- Removed any dependency on ghc 7.10-type OverlappingInstances +- Resolved String/List overlapping instances + +## v0.4.0.1rc-5 + +- Added a necessary OVERLAPPABLE pragma + +## v0.4.0.0rc-4 (current stable version) + +- Removed `conversion` and `conversion-text` dependency. +- Subsequently removed any dependency on overlapping instances +- Readded support for ghc version 7.8 +- Removed `Char -> Value` instance of `ToMustache` (because of overlap) +- Renamed `AST` + +## v0.3.1.0rc-3 + +- Added infix precedence to conversion operators +- Added `INLINEABLE` pragma to conversion functions + +## v0.3.0.1rc-2 + +Dropped GHC 7.8 support in favor of efficient and easy data conversion. + +## v0.3.0.0rc-1 + +- improved documentation +- fixed a bug with scope +- small interface changes diff --git a/mustache/LICENSE b/mustache/LICENSE new file mode 100644 index 0000000..d184d02 --- /dev/null +++ b/mustache/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, 2016 Justus Adam + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Justus Adam nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/mustache/README.md b/mustache/README.md new file mode 100644 index 0000000..340494b --- /dev/null +++ b/mustache/README.md @@ -0,0 +1,54 @@ +# 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]. + +[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. + +[hastache]: https://hackage.haskell.org/package/hastache + +Since it is so easy to use and requires but a few files of code, I've also written a small executable that compiles and renders mustache templates with data input from json or yaml files. + +## Usage + +### Library + +Please refer to the [documentation][] on hackage. + +[documentation]: https://hackage.haskell.org/package/mustache + +### Executable `haskell-mustache` + + $ haskell-mustache --help + Simple mustache template substitution + + arguments [OPTIONS] TEMPLATE [DATA-FILES] + + Common flags: + -t --templatedirs[=DIRECTORY] The directory in which to search for the + templates + -? --help Display help message + -V --version Print version information + +Current implementation substitutes the `TEMPLATE` once with each `DATA-FILE` + +#### Example + + $ haskell-mustache my-template-file data-file-1.json data-file-2.json data-file-3.json + +## Roadmap + +- [x] String parser for mustache templates +- [x] Template substitution +- [x] Standalone executable +- [x] Support for 'set delimiter' +- [x] More efficiency using `Text` rather than `String` +- [x] More efficient Text parsing +- [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/Setup.hs b/mustache/Setup.hs new file mode 100644 index 0000000..4467109 --- /dev/null +++ b/mustache/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/mustache/app/Main.hs b/mustache/app/Main.hs new file mode 100644 index 0000000..2f201e4 --- /dev/null +++ b/mustache/app/Main.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE NamedFieldPuns #-} +module Main (main) where + + +import Data.Aeson (Value, eitherDecode) +import Data.Bifunctor (first) +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 System.Console.CmdArgs.Implicit (Data, Typeable, argPos, args, + cmdArgs, def, help, summary, + typ, (&=)) +import System.FilePath (takeExtension) +import Text.Mustache (automaticCompile, substitute, + toMustache) + + +data Arguments = Arguments + { template :: FilePath + , templateDirs :: [FilePath] + , dataFiles :: [FilePath] + } deriving (Show, Data, Typeable) + + +commandArgs :: Arguments +commandArgs = Arguments + { template = def + &= argPos 0 + &= typ "TEMPLATE" + , dataFiles = def + &= args + &= typ "DATA-FILES" + , templateDirs = ["."] + &= help "The directories in which to search for the templates" + &= typ "DIRECTORIES" + } &= summary "Simple mustache template subtitution" + + +readJSON :: FilePath -> IO (Either String Value) +readJSON = fmap eitherDecode . BS.readFile + + +readYAML :: FilePath -> IO (Either String Value) +readYAML = fmap (first show . decodeEither') . B.readFile + + +main :: IO () +main = do + (Arguments { template, templateDirs, dataFiles }) <- cmdArgs commandArgs + + eitherTemplate <- automaticCompile templateDirs template + + case eitherTemplate of + Left err -> print err + Right compiledTemplate -> + for_ dataFiles $ \file -> do + + let decoder = + case takeExtension file of + ".yml" -> readYAML + ".yaml" -> readYAML + _ -> readJSON + decoded <- decoder file + + either + putStrLn + (TIO.putStrLn . substitute compiledTemplate . toMustache) + decoded diff --git a/mustache/mustache.cabal b/mustache/mustache.cabal new file mode 100644 index 0000000..707c27f --- /dev/null +++ b/mustache/mustache.cabal @@ -0,0 +1,141 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: mustache +version: 2.4.2 +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. + . + /Note/: Versions including and beyond 0.4 are compatible with ghc 7.8 again. +category: Development +homepage: https://github.com/JustusAdam/mustache +bug-reports: https://github.com/JustusAdam/mustache/issues +author: Justus Adam +maintainer: dev@justus.science +copyright: (c) 2015 - 2022 Justus Adam +license: BSD3 +license-file: LICENSE +build-type: Simple +tested-with: + GHC>=7.8 && <=7.10.2 +extra-source-files: + README.md + CHANGELOG.md + test/unit/examples/test-template-partials.txt.mustache + test/unit/examples/test-template.txt.mustache + test/unit/examples/partials/test-partial.txt.mustache + +source-repository head + type: git + location: git://github.com/JustusAdam/mustache.git + +library + exposed-modules: + Text.Mustache + Text.Mustache.Types + Text.Mustache.Parser + Text.Mustache.Compile + Text.Mustache.Render + other-modules: + Text.Mustache.Internal + Text.Mustache.Internal.Types + Paths_mustache + hs-source-dirs: + src + default-extensions: + LambdaCase + TupleSections + other-extensions: + NamedFieldPuns + OverloadedStrings + LambdaCase + TupleSections + TemplateHaskell + QuasiQuotes + ghc-options: -Wall + build-depends: + aeson + , base >=4.7 && <5 + , bytestring + , containers + , directory + , filepath + , mtl >=2.2.1 + , parsec + , scientific + , template-haskell + , text + , th-lift + , unordered-containers + , vector + default-language: Haskell2010 + +executable haskell-mustache + main-is: Main.hs + other-modules: + Paths_mustache + hs-source-dirs: + app + ghc-options: -threaded -Wall + build-depends: + aeson + , base >=4.7 && <5 + , bytestring + , cmdargs + , filepath + , mustache + , text + , yaml + default-language: Haskell2010 + +test-suite language-specifications + type: exitcode-stdio-1.0 + main-is: Language.hs + other-modules: + Paths_mustache + hs-source-dirs: + test/integration + build-depends: + aeson + , base >=4.7 && <5 + , base-unicode-symbols + , bytestring + , filepath + , hspec + , lens + , mustache + , tar + , text + , unordered-containers + , wreq + , yaml + , zlib + default-language: Haskell2010 + +test-suite unit-tests + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_mustache + hs-source-dirs: + test/unit + build-depends: + aeson + , base >=4.7 && <5 + , bytestring + , directory + , filepath + , hspec + , mustache + , process + , temporary + , text + , unordered-containers + , yaml + default-language: Haskell2010 diff --git a/mustache/src/Text/Mustache.hs b/mustache/src/Text/Mustache.hs new file mode 100644 index 0000000..cf3027f --- /dev/null +++ b/mustache/src/Text/Mustache.hs @@ -0,0 +1,197 @@ +{-| +Module : $Header$ +Description : Basic functions for dealing with mustache templates. +Copyright : (c) Justus Adam, 2015 +License : BSD3 +Maintainer : dev@justus.science +Stability : experimental +Portability : POSIX + += How to use this library + +This module exposes some of the most convenient functions for dealing with mustache +templates. + +== Compiling with automatic partial discovery + +The easiest way of compiling a file and its potential includes (called partials) +is by using the 'automaticCompile' function. + +@ +main :: IO () +main = do + let searchSpace = [".", "./templates"] + templateName = "main.mustache" + + compiled <- automaticCompile searchSpace templateName + case compiled of + Left err -> print err + Right template -> return () -- this is where you can start using it +@ + +The @searchSpace@ encompasses all directories in which the compiler should +search for the template source files. +The search itself is conducted in order, from left to right. + +Should your search space be only the current working directory, you can use +'localAutomaticCompile'. + +The @templateName@ is the relative path of the template to any directory +of the search space. + +'automaticCompile' not only finds and compiles the template for you, it also +recursively finds any partials included in the template as well, +compiles them and stores them in the 'partials' hash attached to the resulting +template. + +The compiler will throw errors if either the template is malformed +or the source file for a partial or the template itself could not be found +in any of the directories in @searchSpace@. + +== Substituting + +In order to substitute data into the template it must be an instance of the 'ToMustache' +typeclass or be of type 'Value'. + +This libray tries to imitate the API of <https://hackage.haskell.org/package/aeson aeson> +by allowing you to define conversions of your own custom data types into 'Value', +the type used internally by the substitutor via typeclass and a selection of +operators and convenience functions. + +=== Example + +@ + data Person = { age :: Int, name :: String } + + instance ToMustache Person where + toMustache person = object + [ "age" ~> age person + , "name" ~> name person + ] +@ + +The values to the left of the '~>' operator has to be of type 'Text', hence the +@OverloadedStrings@ can becomes very handy here. + +Values to the right of the '~>' operator must be an instance of the 'ToMustache' +typeclass. Alternatively, if your value to the right of the '~>' operator is +not an instance of 'ToMustache' but an instance of 'ToJSON' you can use the +'~=' operator, which accepts 'ToJSON' values. + +@ + data Person = { age :: Int, name :: String, address :: Address } + + data Address = ... + + instance ToJSON Address where + ... + + instance ToMustache Person where + toMustache person = object + [ "age" ~> age person + , "name" ~> name person + , "address" ~= address person + ] +@ + +All operators are also provided in a unicode form, for those that, like me, enjoy +unicode operators. + +== Manual compiling + +You can compile templates manually without requiring the IO monad at all, using +the 'compileTemplate' function. This is the same function internally used by +'automaticCompile' and does not check if required partial are present. + +More functions for manual compilation can be found in the 'Text.Mustache.Compile' +module. Including helpers for finding lists of partials in templates. + +Additionally the 'compileTemplateWithCache' function is exposed here which you +may use to automatically compile a template but avoid some of the compilation +overhead by providing already compiled partials as well. + +== Fundamentals + +This library builds on three important data structures/types. + +['Value'] A data structure almost identical to Data.Aeson.Value extended with +lambda functions which represents the data the template is being filled with. + +['ToMustache'] A typeclass for converting arbitrary types to 'Value', similar +to Data.Aeson.ToJSON but with support for lambdas. + +['Template'] Contains the 'STree', the syntax tree, which is basically a +list of text blocks and mustache tags. The 'name' of the template and its +'partials' cache. + +=== Compiling + +During the compilation step the template file is located, read, then parsed in a single +pass ('compileTemplate'), resulting in a 'Template' with an empty 'partials' section. + +Subsequenty the 'STree' of the template is scanned for included partials, any +present 'TemplateCache' is queried for the partial ('compileTemplateWithCache'), +if not found it will be searched for in the @searchSpace@, compiled and +inserted into the template's own cache as well as the global cache for the +compilation process. + +Internally no partial is compiled twice, as long as the names stay consistent. + +Once compiled templates may be used multiple times for substitution or as +partial for other templates. + +Partials are not being embedded into the templates during compilation, but during +substitution, hence the 'partials' cache is vital to the template even after +compilation has been completed. Any non existent partial in the cache will +rsubstitute to an empty string. + +=== Substituting + + + +-} +{-# LANGUAGE LambdaCase #-} +module Text.Mustache + ( + -- * Compiling + + -- ** Automatic + automaticCompile, localAutomaticCompile + + -- ** Manually + , compileTemplateWithCache, compileTemplate, Template(..) + + -- * Rendering + + -- ** Generic + + , substitute, checkedSubstitute + + -- ** Specialized + + , substituteValue, checkedSubstituteValue + + -- ** In Lambdas + + , substituteNode, substituteAST, catchSubstitute + + -- * Data Conversion + , ToMustache, toMustache, integralToMustache, object, (~>), (~=) + + -- ** Utilities for lambdas + + , overText + + ) where + + + +import Text.Mustache.Compile +import Text.Mustache.Render +import Text.Mustache.Types +import qualified Data.Text as T + + +-- | Creates a 'Lambda' which first renders the contained section and then applies the supplied function +overText :: (T.Text -> T.Text) -> Value +overText f = toMustache $ fmap (f . snd) . catchSubstitute . substituteAST diff --git a/mustache/src/Text/Mustache/Compile.hs b/mustache/src/Text/Mustache/Compile.hs new file mode 100644 index 0000000..8079d6c --- /dev/null +++ b/mustache/src/Text/Mustache/Compile.hs @@ -0,0 +1,213 @@ +{-| +Module : $Header$ +Description : Basic functions for dealing with mustache templates. +Copyright : (c) Justus Adam, 2015 +License : BSD3 +Maintainer : dev@justus.science +Stability : experimental +Portability : POSIX +-} +{-# OPTIONS_GHC -fno-warn-missing-fields #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +module Text.Mustache.Compile + ( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache + , compileTemplate, cacheFromList, getPartials, mustache, embedTemplate, embedSingleTemplate + ) where + + +import Control.Arrow ((&&&)) +import Control.Monad +import Control.Monad.Except +import Control.Monad.State +import Data.Bool +import Data.HashMap.Strict as HM +import Data.Text hiding (concat, find, map, uncons) +import qualified Data.Text.IO as TIO +import Language.Haskell.TH (Exp, Loc, Q, loc_filename, + loc_start, location) +import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter), + quoteExp) +import qualified Language.Haskell.TH.Syntax as THS +import System.Directory +import System.FilePath +import Text.Mustache.Parser +import Text.Mustache.Types +import Text.Parsec.Error +import Text.Parsec.Pos +import Text.Printf + +{-| + Compiles a mustache template provided by name including the mentioned partials. + + The same can be done manually using 'getFile', 'mustacheParser' and 'getPartials'. + + This function also ensures each partial is only compiled once even though it may + be included by other partials including itself. + + A reference to the included template will be found in each including templates + 'partials' section. +-} +automaticCompile :: [FilePath] -> FilePath -> IO (Either ParseError Template) +automaticCompile searchSpace = compileTemplateWithCache searchSpace mempty + + +-- | Compile the template with the search space set to only the current directory +localAutomaticCompile :: FilePath -> IO (Either ParseError Template) +localAutomaticCompile = automaticCompile ["."] + + +{-| + Compile a mustache template providing a list of precompiled templates that do + not have to be recompiled. +-} +compileTemplateWithCache :: [FilePath] + -> TemplateCache + -> FilePath + -> IO (Either ParseError Template) +compileTemplateWithCache searchSpace templates initName = + runExceptT $ evalStateT (compile' initName) $ flattenPartials templates + where + compile' :: FilePath + -> StateT + (HM.HashMap String Template) + (ExceptT ParseError IO) + Template + compile' name' = do + templates' <- get + case HM.lookup name' templates' of + Just template -> return template + Nothing -> do + rawSource <- lift $ getFile searchSpace name' + compiled@(Template { ast = mSTree }) <- + lift $ ExceptT . pure $ compileTemplate name' rawSource + + foldM + (\st@(Template { partials = p }) partialName -> do + nt <- compile' partialName + modify (HM.insert partialName nt) + return (st { partials = HM.insert partialName nt p }) + ) + compiled + (getPartials mSTree) + + +-- | Flatten a list of Templates into a single 'TemplateCache' +cacheFromList :: [Template] -> TemplateCache +cacheFromList = flattenPartials . fromList . fmap (name &&& id) + + +-- | Compiles a 'Template' directly from 'Text' without checking for missing partials. +-- the result will be a 'Template' with an empty 'partials' cache. +compileTemplate :: String -> Text -> Either ParseError Template +compileTemplate name' = fmap (flip (Template name') mempty) . parse name' + + +{-| + Find the names of all included partials in a mustache STree. + + Same as @join . fmap getPartials'@ +-} +getPartials :: STree -> [FilePath] +getPartials = join . fmap getPartials' + + +{-| + Find partials in a single Node +-} +getPartials' :: Node Text -> [FilePath] +getPartials' (Partial _ p) = return p +getPartials' (Section _ n) = getPartials n +getPartials' (InvertedSection _ n) = getPartials n +getPartials' _ = mempty + + +flattenPartials :: TemplateCache -> TemplateCache +flattenPartials m = foldrWithKey (insertWith (\_ b -> b)) m m + + +{-| + @getFile searchSpace file@ iteratively searches all directories in + @searchSpace@ for a @file@ returning it if found or raising an error if none + of the directories contain the file. + + This trows 'ParseError's to be compatible with the internal Either Monad of + 'compileTemplateWithCache'. +-} +getFile :: [FilePath] -> FilePath -> ExceptT ParseError IO Text +getFile [] fp = throwError $ fileNotFound fp +getFile (templateDir : xs) fp = + lift (doesFileExist filePath) >>= + bool + (getFile xs fp) + (lift $ TIO.readFile filePath) + where + filePath = templateDir </> fp + + +-- | +-- Compile a mustache 'Template' at compile time. Usage: +-- +-- > {-# LANGUAGE QuasiQuotes #-} +-- > import Text.Mustache.Compile (mustache) +-- > +-- > foo :: Template +-- > foo = [mustache|This is my inline {{ template }} created at compile time|] +-- +-- Partials are not supported in the QuasiQuoter + +mustache :: QuasiQuoter +mustache = QuasiQuoter {quoteExp = \unprocessedTemplate -> do + l <- location + compileTemplateTH (fileAndLine l) unprocessedTemplate } + +-- | +-- Compile a mustache 'Template' at compile time providing a search space for any partials. Usage: +-- +-- > {-# LANGUAGE TemplateHaskell #-} +-- > import Text.Mustache.Compile (embedTemplate) +-- > +-- > foo :: Template +-- > foo = $(embedTemplate ["dir", "dir/partials"] "file.mustache") +-- + +embedTemplate :: [FilePath] -> FilePath -> Q Exp +embedTemplate searchSpace filename = do + template <- either (fail . ("Parse error in mustache template: " ++) . show) pure =<< THS.runIO (automaticCompile searchSpace filename) + let possiblePaths = do + fname <- (filename:) . HM.keys . partials $ template + path <- searchSpace + pure $ path </> fname + mapM_ addDependentRelativeFile =<< THS.runIO (filterM doesFileExist possiblePaths) + THS.lift template + +-- | +-- Compile a mustache 'Template' at compile time. Usage: +-- +-- > {-# LANGUAGE TemplateHaskell #-} +-- > import Text.Mustache.Compile (embedSingleTemplate) +-- > +-- > foo :: Template +-- > foo = $(embedSingleTemplate "dir/file.mustache") +-- +-- Partials are not supported in embedSingleTemplate + +embedSingleTemplate :: FilePath -> Q Exp +embedSingleTemplate filePath = do + addDependentRelativeFile filePath + compileTemplateTH filePath =<< THS.runIO (readFile filePath) + +fileAndLine :: Loc -> String +fileAndLine loc = loc_filename loc ++ ":" ++ (show . fst . loc_start $ loc) + +compileTemplateTH :: String -> String -> Q Exp +compileTemplateTH filename unprocessed = + either (fail . ("Parse error in mustache template: " ++) . show) THS.lift $ compileTemplate filename (pack unprocessed) + +addDependentRelativeFile :: FilePath -> Q () +addDependentRelativeFile = THS.qAddDependentFile <=< THS.runIO . makeAbsolute + +-- ERRORS + +fileNotFound :: FilePath -> ParseError +fileNotFound fp = newErrorMessage (Message $ printf "Template file '%s' not found" fp) (initialPos fp) diff --git a/mustache/src/Text/Mustache/Internal.hs b/mustache/src/Text/Mustache/Internal.hs new file mode 100644 index 0000000..c1bf8b7 --- /dev/null +++ b/mustache/src/Text/Mustache/Internal.hs @@ -0,0 +1,41 @@ +{-| +Module : $Header$ +Description : Types and conversions +Copyright : (c) Justus Adam, 2015 +License : BSD3 +Maintainer : dev@justus.science +Stability : experimental +Portability : POSIX + +escapeXML and xmlEntities curtesy to the tagsoup library. +-} +module Text.Mustache.Internal (uncons, escapeXMLText) where + + +import Data.Char (ord) +import qualified Data.IntMap as IntMap +import qualified Data.Text as T + + +uncons :: [α] -> Maybe (α, [α]) +uncons [] = Nothing +uncons (x:xs) = return (x, xs) + + +escapeXMLText :: T.Text -> T.Text +escapeXMLText = T.pack . escapeXML . T.unpack + + +escapeXML :: String -> String +escapeXML = concatMap $ \x -> IntMap.findWithDefault [x] (ord x) mp + where mp = IntMap.fromList [(ord b, "&"++a++";") | (a,[b]) <- xmlEntities] + + +xmlEntities :: [(String, String)] +xmlEntities = + [ ("quot", "\"") + , ("#39", "'") + , ("amp" , "&") + , ("lt" , "<") + , ("gt" , ">") + ] diff --git a/mustache/src/Text/Mustache/Internal/Types.hs b/mustache/src/Text/Mustache/Internal/Types.hs new file mode 100644 index 0000000..d499ba3 --- /dev/null +++ b/mustache/src/Text/Mustache/Internal/Types.hs @@ -0,0 +1,412 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +module Text.Mustache.Internal.Types where + + +import Control.Arrow +import Control.Monad.RWS hiding (lift) +import qualified Data.Aeson as Aeson +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.KeyMap as KM +#endif +import Data.Int (Int8, Int16, Int32, Int64) +import Data.Foldable (toList) +import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS +import qualified Data.Map as Map +import Data.Scientific +import qualified Data.Sequence as Seq +import qualified Data.Set as Set +import Data.Text +import qualified Data.Text.Lazy as LT +import qualified Data.Vector as V +import Data.Word (Word8, Word16, Word32, Word64) +import Language.Haskell.TH.Lift (deriveLift) +import Language.Haskell.TH.Syntax +import Numeric.Natural (Natural) + + +-- | Type of errors we may encounter during substitution. +data SubstitutionError + = VariableNotFound [Key] -- ^ The template contained a variable for which there was no data counterpart in the current context + | InvalidImplicitSectionContextType String -- ^ When substituting an implicit section the current context had an unsubstitutable type + | InvertedImplicitSection -- ^ Inverted implicit sections should never occur + | SectionTargetNotFound [Key] -- ^ The template contained a section for which there was no data counterpart in the current context + | PartialNotFound FilePath -- ^ The template contained a partial for which there was no data counterpart in the current context + | DirectlyRenderedValue Value -- ^ A complex value such as an Object or Array was directly rendered into the template (warning) + deriving (Show) + + +tellError :: SubstitutionError -> SubM () +tellError e = SubM $ tell ([e], []) + + +tellSuccess :: Text -> SubM () +tellSuccess s = SubM $ tell ([], [s]) + + +newtype SubM a = SubM { runSubM' :: RWS (Context Value, TemplateCache) ([SubstitutionError], [Text]) () a } deriving (Monad, Functor, Applicative, MonadReader (Context Value, TemplateCache)) + +runSubM :: SubM a -> Context Value -> TemplateCache -> ([SubstitutionError], [Text]) +runSubM comp ctx cache = snd $ evalRWS (runSubM' comp) (ctx, cache) () + +shiftContext :: Context Value -> SubM a -> SubM a +shiftContext = local . first . const + +-- | 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 :: [Key] -> SubM (Maybe Value) +search [] = return Nothing +search (key:nextKeys) = (>>= innerSearch nextKeys) <$> go + where + go = asks fst >>= \case + Context parents focus -> do + let searchParents = case parents of + (newFocus: newParents) -> shiftContext (Context newParents newFocus) $ go + _ -> return Nothing + case focus of + Object o -> + case HM.lookup key o of + Just res -> return $ Just res + _ -> searchParents + _ -> searchParents + + +-- | 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 + + + +-- | Syntax tree for a mustache template +type STree = ASTree Text + + +type ASTree α = [Node α] + + +-- | Basic values composing the STree +data Node α + = TextBlock α + | Section DataIdentifier (ASTree α) + | InvertedSection DataIdentifier (ASTree α) + | Variable Bool DataIdentifier + | Partial (Maybe α) FilePath + deriving (Show, Eq) + + +-- | Kinds of identifiers for Variables and sections +data DataIdentifier + = NamedData [Key] + | Implicit + deriving (Show, Eq) + + +-- | A list-like structure used in 'Value' +type Array = V.Vector Value +-- | A map-like structure used in 'Value' +type Object = HM.HashMap Text Value +-- | Source type for constructing 'Object's +type Pair = (Text, Value) + + +-- | Representation of stateful context for the substitution process +data Context α = Context { ctxtParents :: [α], ctxtFocus :: α } + deriving (Eq, Show, Ord) + +-- | Internal value representation +data Value + = Object !Object + | Array !Array + | Number !Scientific + | String !Text + | Lambda (STree -> SubM STree) + | Bool !Bool + | Null + + +instance Show Value where + show (Lambda _) = "Lambda function" + show (Object o) = show o + show (Array a) = show a + show (String s) = show s + show (Number n) = show n + show (Bool b) = show b + show Null = "null" + + +listToMustache' :: ToMustache ω => [ω] -> Value +listToMustache' = Array . V.fromList . fmap toMustache + +integralToMustache :: Integral ω => ω -> Value +integralToMustache = toMustache . toInteger + +-- | Conversion class +class ToMustache ω where + toMustache :: ω -> Value + listToMustache :: [ω] -> Value + listToMustache = listToMustache' + +instance ToMustache Float where + toMustache = Number . fromFloatDigits + +instance ToMustache Double where + toMustache = Number . fromFloatDigits + +instance ToMustache Integer where + toMustache = Number . fromInteger + +instance ToMustache Natural where + toMustache = integralToMustache + +instance ToMustache Int where + toMustache = integralToMustache + +instance ToMustache Word where + toMustache = integralToMustache + +instance ToMustache Int8 where + toMustache = integralToMustache + +instance ToMustache Int16 where + toMustache = integralToMustache + +instance ToMustache Int32 where + toMustache = integralToMustache + +instance ToMustache Int64 where + toMustache = integralToMustache + +instance ToMustache Word8 where + toMustache = integralToMustache + +instance ToMustache Word16 where + toMustache = integralToMustache + +instance ToMustache Word32 where + toMustache = integralToMustache + +instance ToMustache Word64 where + toMustache = integralToMustache + +instance ToMustache Char where + toMustache = toMustache . (:[]) + listToMustache = String . pack + +instance ToMustache Value where + toMustache = id + +instance ToMustache Bool where + toMustache = Bool + +instance ToMustache () where + toMustache = const Null + +instance ToMustache ω => ToMustache (Maybe ω) where + toMustache (Just w) = toMustache w + toMustache Nothing = Null + +instance ToMustache Text where + toMustache = String + +instance ToMustache LT.Text where + toMustache = String . LT.toStrict + +instance ToMustache Scientific where + toMustache = Number + +instance ToMustache α => ToMustache [α] where + toMustache = listToMustache + +instance ToMustache ω => ToMustache (Seq.Seq ω) where + toMustache = listToMustache' . toList + +instance ToMustache ω => ToMustache (V.Vector ω) where + toMustache = Array . fmap toMustache + +instance (ToMustache ω) => ToMustache (Map.Map Text ω) where + toMustache = mapInstanceHelper id + +instance (ToMustache ω) => ToMustache (Map.Map LT.Text ω) where + toMustache = mapInstanceHelper LT.toStrict + +instance (ToMustache ω) => ToMustache (Map.Map String ω) where + toMustache = mapInstanceHelper pack + +mapInstanceHelper :: ToMustache v => (a -> Text) -> Map.Map a v -> Value +mapInstanceHelper conv = + toMustache + . Map.foldrWithKey + (\k -> HM.insert (conv k) . toMustache) + HM.empty + +instance ToMustache ω => ToMustache (HM.HashMap Text ω) where + toMustache = Object . fmap toMustache + +instance ToMustache ω => ToMustache (HM.HashMap LT.Text ω) where + toMustache = hashMapInstanceHelper LT.toStrict + +instance ToMustache ω => ToMustache (HM.HashMap String ω) where + toMustache = hashMapInstanceHelper pack + +hashMapInstanceHelper :: ToMustache v => (a -> Text) -> HM.HashMap a v -> Value +hashMapInstanceHelper conv = + toMustache + . HM.foldrWithKey + (\k -> HM.insert (conv k) . toMustache) + HM.empty + +instance ToMustache (STree -> SubM STree) where + toMustache = Lambda + +instance ToMustache Aeson.Value where + toMustache (Aeson.Object o) = Object $ fmap toMustache +#if MIN_VERSION_aeson(2,0,0) + (KM.toHashMapText o) +#else + o +#endif + toMustache (Aeson.Array a) = Array $ fmap toMustache a + toMustache (Aeson.Number n) = Number n + toMustache (Aeson.String s) = String s + toMustache (Aeson.Bool b) = Bool b + toMustache Aeson.Null = Null + +instance ToMustache ω => ToMustache (HS.HashSet ω) where + toMustache = listToMustache' . HS.toList + +instance ToMustache ω => ToMustache (Set.Set ω) where + toMustache = listToMustache' . Set.toList + +instance (ToMustache α, ToMustache β) => ToMustache (α, β) where + toMustache (a, b) = toMustache [toMustache a, toMustache b] + +instance (ToMustache α, ToMustache β, ToMustache γ) + => ToMustache (α, β, γ) where + toMustache (a, b, c) = toMustache [toMustache a, toMustache b, toMustache c] + +instance (ToMustache α, ToMustache β, ToMustache γ, ToMustache δ) + => ToMustache (α, β, γ, δ) where + toMustache (a, b, c, d) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + ] + +instance ( ToMustache α + , ToMustache β + , ToMustache γ + , ToMustache δ + , ToMustache ε + ) => ToMustache (α, β, γ, δ, ε) where + toMustache (a, b, c, d, e) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + , toMustache e + ] + +instance ( ToMustache α + , ToMustache β + , ToMustache γ + , ToMustache δ + , ToMustache ε + , ToMustache ζ + ) => ToMustache (α, β, γ, δ, ε, ζ) where + toMustache (a, b, c, d, e, f) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + , toMustache e + , toMustache f + ] + +instance ( ToMustache α + , ToMustache β + , ToMustache γ + , ToMustache δ + , ToMustache ε + , ToMustache ζ + , ToMustache η + ) => ToMustache (α, β, γ, δ, ε, ζ, η) where + toMustache (a, b, c, d, e, f, g) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + , toMustache e + , toMustache f + , toMustache g + ] + +instance ( ToMustache α + , ToMustache β + , ToMustache γ + , ToMustache δ + , ToMustache ε + , ToMustache ζ + , ToMustache η + , ToMustache θ + ) => ToMustache (α, β, γ, δ, ε, ζ, η, θ) where + toMustache (a, b, c, d, e, f, g, h) = toMustache + [ toMustache a + , toMustache b + , toMustache c + , toMustache d + , toMustache e + , toMustache f + , toMustache g + , toMustache h + ] + +-- | A collection of templates with quick access via their hashed names +type TemplateCache = HM.HashMap String Template + +-- | Type of key used for retrieving data from 'Value's +type Key = Text + +{-| + A compiled Template with metadata. +-} +data Template = Template + { name :: String + , ast :: STree + , partials :: TemplateCache + } deriving (Show) + + +deriveLift ''DataIdentifier +deriveLift ''Node +deriveLift ''Template + +-- Data.HashMap 0.2.17.0 introduces its own Lift instance +#if !MIN_VERSION_unordered_containers(0,2,17) +instance Lift TemplateCache where +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped m = [|| HM.fromList $$(liftTyped $ HM.toList m) ||] +#else + lift m = [| HM.fromList $(lift $ HM.toList m) |] +#endif +#endif + +--Data.Text 1.2.4.0 introduces its own Lift Text instance +#if !MIN_VERSION_text(1,2,4) +instance Lift Text where + lift = lift . unpack +#endif + diff --git a/mustache/src/Text/Mustache/Parser.hs b/mustache/src/Text/Mustache/Parser.hs new file mode 100644 index 0000000..317e7aa --- /dev/null +++ b/mustache/src/Text/Mustache/Parser.hs @@ -0,0 +1,311 @@ +{-| +Module : $Header$ +Description : Basic functions for dealing with mustache templates. +Copyright : (c) Justus Adam, 2015 +License : BSD3 +Maintainer : dev@justus.science +Stability : experimental +Portability : POSIX +-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +module Text.Mustache.Parser + ( + -- * Generic parsing functions + + parse, parseWithConf + + -- * Configurations + + , MustacheConf(..), defaultConf + + -- * Parser + + , Parser, MustacheState + + -- * Mustache Constants + + , sectionBegin, sectionEnd, invertedSectionBegin, unescape2, unescape1 + , delimiterChange, nestingSeparator + + ) where + + +import Control.Monad +import Data.Char (isAlphaNum, isSpace) +import Data.List (nub) +import Data.Monoid ((<>)) +import Data.Text as T (Text, null, pack) +import Prelude as Prel +import Text.Mustache.Types +import Text.Parsec as P hiding (endOfLine, parse) + + +-- | Initial configuration for the parser +data MustacheConf = MustacheConf + { delimiters :: (String, String) + } + + +-- | User state for the parser +data MustacheState = MustacheState + { sDelimiters :: (String, String) + , textStack :: Text + , isBeginngingOfLine :: Bool + , currentSectionName :: Maybe DataIdentifier + } + + +data ParseTagRes + = SectionBegin Bool DataIdentifier + | SectionEnd DataIdentifier + | Tag (Node Text) + | HandledTag + + +-- | @#@ +sectionBegin :: Char +sectionBegin = '#' +-- | @/@ +sectionEnd :: Char +sectionEnd = '/' +-- | @>@ +partialBegin :: Char +partialBegin = '>' +-- | @^@ +invertedSectionBegin :: Char +invertedSectionBegin = '^' +-- | @{@ and @}@ +unescape2 :: (Char, Char) +unescape2 = ('{', '}') +-- | @&@ +unescape1 :: Char +unescape1 = '&' +-- | @=@ +delimiterChange :: Char +delimiterChange = '=' +-- | @.@ +nestingSeparator :: Char +nestingSeparator = '.' +-- | @!@ +comment :: Char +comment = '!' +-- | @.@ +implicitIterator :: Char +implicitIterator = '.' +-- | Cannot be a letter, number or the nesting separation Character @.@ +isAllowedDelimiterCharacter :: Char -> Bool +isAllowedDelimiterCharacter = + not . Prel.or . sequence + [ isSpace, isAlphaNum, (== nestingSeparator) ] +allowedDelimiterCharacter :: Parser Char +allowedDelimiterCharacter = + satisfy isAllowedDelimiterCharacter + + +-- | Empty configuration +emptyState :: MustacheState +emptyState = MustacheState ("", "") mempty True Nothing + + +-- | Default configuration (delimiters = ("{{", "}}")) +defaultConf :: MustacheConf +defaultConf = MustacheConf ("{{", "}}") + + +initState :: MustacheConf -> MustacheState +initState (MustacheConf { delimiters }) = emptyState { sDelimiters = delimiters } + + +setIsBeginning :: Bool -> Parser () +setIsBeginning b = modifyState (\s -> s { isBeginngingOfLine = b }) + + +-- | The parser monad in use +type Parser = Parsec Text MustacheState + + +(<<) :: Monad m => m b -> m a -> m b +(<<) = flip (>>) + + +endOfLine :: Parser String +endOfLine = do + r <- optionMaybe $ char '\r' + n <- char '\n' + return $ maybe id (:) r [n] + + +{-| + Runs the parser for a mustache template, returning the syntax tree. +-} +parse :: FilePath -> Text -> Either ParseError STree +parse = parseWithConf defaultConf + + +-- | Parse using a custom initial configuration +parseWithConf :: MustacheConf -> FilePath -> Text -> Either ParseError STree +parseWithConf = P.runParser parseText . initState + + +parseText :: Parser STree +parseText = do + (MustacheState { isBeginngingOfLine }) <- getState + if isBeginngingOfLine + then parseLine + else continueLine + + +appendStringStack :: String -> Parser () +appendStringStack t = modifyState (\s -> s { textStack = textStack s <> pack t}) + + +continueLine :: Parser STree +continueLine = do + (MustacheState { sDelimiters = ( start@(x:_), _ )}) <- getState + let forbidden = x : "\n\r" + + many (noneOf forbidden) >>= appendStringStack + + (try endOfLine >>= appendStringStack >> setIsBeginning True >> parseLine) + <|> (try (string start) >> switchOnTag >>= continueFromTag) + <|> (try eof >> finishFile) + <|> (anyChar >>= appendStringStack . (:[]) >> continueLine) + + +flushText :: Parser STree +flushText = do + s@(MustacheState { textStack = text }) <- getState + putState $ s { textStack = mempty } + return $ if T.null text + then [] + else [TextBlock text] + + +finishFile :: Parser STree +finishFile = + getState >>= \case + (MustacheState {currentSectionName = Nothing}) -> flushText + (MustacheState {currentSectionName = Just name}) -> + parserFail $ "Unclosed section " <> show name + + +parseLine :: Parser STree +parseLine = do + (MustacheState { sDelimiters = ( start, _ ) }) <- getState + initialWhitespace <- many (oneOf " \t") + let handleStandalone = do + tag <- switchOnTag + let continueNoStandalone = do + appendStringStack initialWhitespace + setIsBeginning False + continueFromTag tag + standaloneEnding = do + try (skipMany (oneOf " \t") >> (eof <|> void endOfLine)) + setIsBeginning True + case tag of + Tag (Partial _ name) -> + ( standaloneEnding >> + continueFromTag (Tag (Partial (Just (pack initialWhitespace)) name)) + ) <|> continueNoStandalone + Tag _ -> continueNoStandalone + _ -> + ( standaloneEnding >> + continueFromTag tag + ) <|> continueNoStandalone + (try (string start) >> handleStandalone) + <|> (try eof >> appendStringStack initialWhitespace >> finishFile) + <|> (appendStringStack initialWhitespace >> setIsBeginning False >> continueLine) + + +continueFromTag :: ParseTagRes -> Parser STree +continueFromTag (SectionBegin inverted name) = do + textNodes <- flushText + state@(MustacheState + { currentSectionName = previousSection }) <- getState + putState $ state { currentSectionName = return name } + innerSectionContent <- parseText + let sectionTag = + if inverted + then InvertedSection + else Section + modifyState $ \s -> s { currentSectionName = previousSection } + outerSectionContent <- parseText + return (textNodes <> [sectionTag name innerSectionContent] <> outerSectionContent) +continueFromTag (SectionEnd name) = do + (MustacheState + { currentSectionName }) <- getState + case currentSectionName of + Just name' | name' == name -> flushText + Just name' -> parserFail $ "Expected closing sequence for \"" <> show name <> "\" got \"" <> show name' <> "\"." + Nothing -> parserFail $ "Encountered closing sequence for \"" <> show name <> "\" which has never been opened." +continueFromTag (Tag tag) = do + textNodes <- flushText + furtherNodes <- parseText + return $ textNodes <> return tag <> furtherNodes +continueFromTag HandledTag = parseText + + +switchOnTag :: Parser ParseTagRes +switchOnTag = do + (MustacheState { sDelimiters = ( _, end )}) <- getState + + choice + [ SectionBegin False <$> (try (char sectionBegin) >> genParseTagEnd mempty) + , SectionEnd + <$> (try (char sectionEnd) >> genParseTagEnd mempty) + , Tag . Variable False + <$> (try (char unescape1) >> genParseTagEnd mempty) + , 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 mempty >>= \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 mempty + ] + where + parseDelimChange = do + (MustacheState { sDelimiters = ( _, end )}) <- getState + spaces + delim1 <- allowedDelimiterCharacter `manyTill` space + spaces + delim2 <- allowedDelimiterCharacter `manyTill` try (spaces >> string (delimiterChange : end)) + when (delim1 == mempty || delim2 == mempty) + $ parserFail "Tags must contain more than 0 characters" + oldState <- getState + putState $ oldState { sDelimiters = (delim1, delim2) } + + +genParseTagEnd :: String -> Parser DataIdentifier +genParseTagEnd emod = do + (MustacheState { sDelimiters = ( start, end ) }) <- getState + + let nEnd = emod <> end + disallowed = nub $ nestingSeparator : start <> end + + parseOne :: Parser [Text] + parseOne = do + + one <- noneOf disallowed + `manyTill` lookAhead + (try (spaces >> void (string nEnd)) + <|> try (void $ char nestingSeparator)) + + others <- (char nestingSeparator >> parseOne) + <|> (const mempty <$> (spaces >> string nEnd)) + return $ pack one : others + spaces + (try (char implicitIterator) >> spaces >> string nEnd >> return Implicit) + <|> (NamedData <$> parseOne) diff --git a/mustache/src/Text/Mustache/Render.hs b/mustache/src/Text/Mustache/Render.hs new file mode 100644 index 0000000..7a0ad89 --- /dev/null +++ b/mustache/src/Text/Mustache/Render.hs @@ -0,0 +1,248 @@ +{-| +Module : $Header$ +Description : Functions for rendering mustache templates. +Copyright : (c) Justus Adam, 2015 +License : BSD3 +Maintainer : dev@justus.science +Stability : experimental +Portability : POSIX +-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Text.Mustache.Render + ( + -- * Substitution + substitute, substituteValue + -- * Checked substitution + , checkedSubstitute, checkedSubstituteValue, SubstitutionError(..) + -- * Working with Context + , Context(..), search, innerSearch, SubM, substituteNode, substituteAST, catchSubstitute + -- * Util + , toString + ) where + + +import Control.Arrow (first, second) +import Control.Monad + +import Data.Foldable (for_) +import Data.HashMap.Strict as HM hiding (keys, map) +import Data.Maybe (fromMaybe) + +import Data.Scientific (floatingOrInteger) +import Data.Text as T (Text, isSuffixOf, pack, + replace, stripSuffix) +import qualified Data.Vector as V +import Prelude hiding (length, lines, unlines) + +import Control.Monad.Reader +import Control.Monad.Writer +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import Text.Mustache.Internal +import Text.Mustache.Internal.Types +import Text.Mustache.Types + + +{-| + Substitutes all mustache defined tokens (or tags) for values found in the + provided data structure. + + Equivalent to @substituteValue . toMustache@. +-} +substitute :: ToMustache k => Template -> k -> Text +substitute t = substituteValue t . toMustache + + +{-| + Substitutes all mustache defined tokens (or tags) for values found in the + provided data structure and report any errors and warnings encountered during + substitution. + + This function always produces results, as in a fully substituted/rendered template, + it never halts on errors. It simply reports them in the first part of the tuple. + Sites with errors are usually substituted with empty string. + + The second value in the tuple is a template rendered with errors ignored. + Therefore if you must enforce that there were no errors during substitution + you must check that the error list in the first tuple value is empty. + + Equivalent to @checkedSubstituteValue . toMustache@. +-} +checkedSubstitute :: ToMustache k => Template -> k -> ([SubstitutionError], Text) +checkedSubstitute t = checkedSubstituteValue t . toMustache + + +{-| + Substitutes all mustache defined tokens (or tags) for values found in the + provided data structure. +-} +substituteValue :: Template -> Value -> Text +substituteValue = (snd .) . checkedSubstituteValue + + +{-| + Substitutes all mustache defined tokens (or tags) for values found in the + provided data structure and report any errors and warnings encountered during + substitution. + + This function always produces results, as in a fully substituted/rendered template, + it never halts on errors. It simply reports them in the first part of the tuple. + Sites with errors are usually substituted with empty string. + + The second value in the tuple is a template rendered with errors ignored. + Therefore if you must enforce that there were no errors during substitution + you must check that the error list in the first tuple value is empty. +-} +checkedSubstituteValue :: Template -> Value -> ([SubstitutionError], Text) +checkedSubstituteValue template dataStruct = + second T.concat $ runSubM (substituteAST (ast template)) (Context mempty dataStruct) (partials template) + +-- | Catch the results of running the inner substitution. +catchSubstitute :: SubM a -> SubM (a, Text) +catchSubstitute = fmap (second (T.concat . snd)) . SubM . hideResults . listen . runSubM' + where + hideResults = censor (\(errs, _) -> (errs, [])) + +-- | Substitute an entire 'STree' rather than just a single 'Node' +substituteAST :: STree -> SubM () +substituteAST = mapM_ substituteNode + + +-- | Main substitution function +substituteNode :: Node Text -> SubM () + +-- subtituting text +substituteNode (TextBlock t) = tellSuccess t + +-- substituting a whole section (entails a focus shift) +substituteNode (Section Implicit secSTree) = + asks fst >>= \case + Context parents focus@(Array a) + | V.null a -> return () + | otherwise -> for_ a $ \focus' -> + let newContext = Context (focus:parents) focus' + in shiftContext newContext $ substituteAST secSTree + Context _ (Object _) -> substituteAST secSTree + Context _ v -> tellError $ InvalidImplicitSectionContextType $ showValueType v + +substituteNode (Section (NamedData secName) secSTree) = + search secName >>= \case + Just arr@(Array arrCont) -> + if V.null arrCont + then return () + else do + Context parents focus <- asks fst + for_ arrCont $ \focus' -> + let newContext = Context (arr:focus:parents) focus' + in shiftContext newContext $ substituteAST secSTree + Just (Bool False) -> return () + Just Null -> return () + Just (Lambda l) -> substituteAST =<< l secSTree + Just focus' -> do + Context parents focus <- asks fst + let newContext = Context (focus:parents) focus' + shiftContext newContext $ substituteAST secSTree + Nothing -> tellError $ SectionTargetNotFound secName + +-- substituting an inverted section +substituteNode (InvertedSection Implicit _) = tellError InvertedImplicitSection +substituteNode (InvertedSection (NamedData secName) invSecSTree) = + search secName >>= \case + Just (Bool False) -> contents + Just (Array a) | V.null a -> contents + Just Null -> contents + Nothing -> contents + _ -> return () + where + contents = mapM_ substituteNode invSecSTree + +-- substituting a variable +substituteNode (Variable _ Implicit) = asks (ctxtFocus . fst) >>= toString >>= tellSuccess +substituteNode (Variable escaped (NamedData varName)) = + maybe + (tellError $ VariableNotFound varName) + (toString >=> tellSuccess . (if escaped then escapeXMLText else id)) + =<< search varName + +-- substituting a partial +substituteNode (Partial indent pName) = do + cPartials <- asks snd + case HM.lookup pName cPartials of + Nothing -> tellError $ PartialNotFound pName + Just t -> + let ast' = handleIndent indent $ ast t + in local (second (partials t `HM.union`)) $ substituteAST ast' + + +showValueType :: Value -> String +showValueType Null = "Null" +showValueType (Object _) = "Object" +showValueType (Array _) = "Array" +showValueType (String _) = "String" +showValueType (Lambda _) = "Lambda" +showValueType (Number _) = "Number" +showValueType (Bool _) = "Bool" + + +handleIndent :: Maybe Text -> STree -> STree +handleIndent Nothing ast' = ast' +handleIndent (Just indentation) ast' = preface <> content + where + preface = if T.null indentation then [] else [TextBlock indentation] + content = if T.null indentation + then ast' + else reverse $ fromMaybe [] (uncurry (:) . first dropper <$> uncons (reverse fullIndented)) + where + 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 + +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 + + + +-- | Converts values to Text as required by the mustache standard +toString :: Value -> SubM Text +toString (String t) = return t +toString (Number n) = return $ either (pack . show) (pack . show) (floatingOrInteger n :: Either Double Integer) +toString (Lambda l) = do + ((), res) <- catchSubstitute $ substituteAST =<< l [] + return res +toString e = do + tellError $ DirectlyRenderedValue e + return $ pack $ show e + + +instance ToMustache (Context Value -> STree -> STree) where + toMustache f = Lambda $ (<$> askContext) . flip f + +instance ToMustache (Context Value -> STree -> Text) where + toMustache = lambdaHelper id + +instance ToMustache (Context Value -> STree -> LT.Text) where + toMustache = lambdaHelper LT.toStrict + +instance ToMustache (Context Value -> STree -> String) where + toMustache = lambdaHelper pack + +lambdaHelper :: (r -> Text) -> (Context Value -> STree -> r) -> Value +lambdaHelper conv f = Lambda $ (<$> askContext) . wrapper + where + wrapper :: STree -> Context Value -> STree + wrapper lSTree c = [TextBlock $ conv $ f c lSTree] + +instance ToMustache (STree -> SubM Text) where + toMustache f = Lambda (fmap (return . TextBlock) . f) diff --git a/mustache/src/Text/Mustache/Types.hs b/mustache/src/Text/Mustache/Types.hs new file mode 100644 index 0000000..54d5991 --- /dev/null +++ b/mustache/src/Text/Mustache/Types.hs @@ -0,0 +1,110 @@ +{-| +Module : $Header$ +Description : Types and conversions +Copyright : (c) Justus Adam, 2015 +License : BSD3 +Maintainer : dev@justus.science +Stability : experimental +Portability : POSIX +-} +module Text.Mustache.Types + ( + -- * Types for the Parser / Template + ASTree + , STree + , Node(..) + , DataIdentifier(..) + , Template(..) + , TemplateCache + -- * Types for the Substitution / Data + , Value(..) + , Key + -- ** Converting + , object + , (~>), (↝), (~=), (⥱) + , ToMustache, toMustache, mFromJSON, integralToMustache + -- ** Representation + , Array, Object, Pair + , SubM, askContext, askPartials + , Context(..) + ) where + + +import Control.Monad.Reader +import qualified Data.Aeson as Aeson +import qualified Data.HashMap.Strict as HM +import Data.Text (Text) +import Text.Mustache.Internal.Types + + +-- | Convenience function for creating Object values. +-- +-- This function is supposed to be used in conjuction with the '~>' and '~=' operators. +-- +-- ==== __Examples__ +-- +-- @ +-- data Address = Address { ... } +-- +-- instance Address ToJSON where +-- ... +-- +-- data Person = Person { name :: String, address :: Address } +-- +-- instance ToMustache Person where +-- toMustache (Person { name, address }) = object +-- [ "name" ~> name +-- , "address" ~= address +-- ] +-- @ +-- +-- Here we can see that we can use the '~>' operator for values that have +-- themselves a 'ToMustache' instance, or alternatively if they lack such an +-- instance but provide an instance for the 'ToJSON' typeclass we can use the +-- '~=' operator. +object :: [Pair] -> Value +object = Object . HM.fromList + + +-- | Map keys to values that provide a 'ToMustache' instance +-- +-- Recommended in conjunction with the `OverloadedStrings` extension. +(~>) :: ToMustache ω => Text -> ω -> Pair +(~>) t = (t, ) . toMustache +{-# INLINEABLE (~>) #-} +infixr 8 ~> + +-- | Unicode version of '~>' +(↝) :: ToMustache ω => Text -> ω -> Pair +(↝) = (~>) +{-# INLINEABLE (↝) #-} +infixr 8 ↝ + + +-- | Map keys to values that provide a 'ToJSON' instance +-- +-- Recommended in conjunction with the `OverloadedStrings` extension. +(~=) :: Aeson.ToJSON ι => Text -> ι -> Pair +(~=) t = (t ~>) . Aeson.toJSON +{-# INLINEABLE (~=) #-} +infixr 8 ~= + + +-- | Unicode version of '~=' +(⥱) :: Aeson.ToJSON ι => Text -> ι -> Pair +(⥱) = (~=) +{-# INLINEABLE (⥱) #-} +infixr 8 ⥱ + + +-- | Converts a value that can be represented as JSON to a Value. +mFromJSON :: Aeson.ToJSON ι => ι -> Value +mFromJSON = toMustache . Aeson.toJSON + + +askContext :: SubM (Context Value) +askContext = asks fst + + +askPartials :: SubM TemplateCache +askPartials = asks snd diff --git a/mustache/test/integration/Language.hs b/mustache/test/integration/Language.hs new file mode 100644 index 0000000..754c430 --- /dev/null +++ b/mustache/test/integration/Language.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE UnicodeSyntax #-} +module Main where + +import qualified Codec.Archive.Tar as Tar +import qualified Codec.Compression.GZip as GZip +import Control.Applicative ((<$>), (<*>)) +import Control.Lens +import Control.Monad +import Data.ByteString.Lazy (toStrict) +import Data.Foldable (for_) +import qualified Data.HashMap.Strict as HM (HashMap, empty, + traverseWithKey) +import Data.List +import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import Data.Yaml as Y (FromJSON, Value (..), decode, + parseJSON, (.!=), (.:), (.:?)) +import Network.Wreq +import System.FilePath +import Test.Hspec +import Text.Mustache + + +langspecs :: [String] +langspecs = + [ "https://codeload.github.com/andrewthad/spec/legacy.tar.gz/add_list_context_check" + , "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 + + +getOfficialSpecRelease :: String -> IO [(String, LangSpecFile)] +getOfficialSpecRelease releaseURL = do + res <- get releaseURL + let archive = Tar.read $ GZip.decompress (res ^. responseBody) + return $ Tar.foldEntries handleEntry [] (error . show) archive + where + handleEntry e acc = + case content of + Tar.NormalFile f _ + | takeExtension filename `elem` [".yml", ".yaml"] + && not ("~" `isPrefixOf` takeFileName filename) -> + (filename, fromMaybe (error $ "Error parsing spec file " ++ filename) $ decode $ toStrict f):acc + _ -> acc + where + filename = Tar.entryPath e + content = Tar.entryContent e + + +testOfficialLangSpec :: [(String, LangSpecFile)] -> Spec +testOfficialLangSpec testfiles = + for_ testfiles $ \(filename, 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 $ do + specs <- mapM getOfficialSpecRelease langspecs + hspec $ mapM_ testOfficialLangSpec specs diff --git a/mustache/test/unit/Spec.hs b/mustache/test/unit/Spec.hs new file mode 100644 index 0000000..33263a2 --- /dev/null +++ b/mustache/test/unit/Spec.hs @@ -0,0 +1,260 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +module Main where + + +import Control.Applicative ((<$>), (<*>)) +import Data.Either +import Data.Function (on) +import Data.Monoid +import qualified Data.Text as T +import System.IO.Unsafe (unsafePerformIO) +import Test.Hspec +import Text.Mustache +import Text.Mustache.Compile +import Text.Mustache.Parser +import Text.Mustache.Types + + +escaped :: Bool +escaped = True +unescaped :: Bool +unescaped = False + + +parserSpec :: Spec +parserSpec = + describe "mustacheParser" $ do + let lparse = parse "testsuite" + let returnedOne = return . return + + let text = "test12356p0--=-34{}jnv,\n" + + it "parses text" $ + lparse text `shouldBe` returnedOne (TextBlock text) + + it "parses a variable" $ + lparse "{{name}}" `shouldBe` returnedOne (Variable escaped (NamedData ["name"])) + + it "parses a variable with whitespace" $ + lparse "{{ name }}" `shouldBe` returnedOne (Variable escaped (NamedData ["name"])) + + it "allows '-' in variable names" $ + lparse "{{ name-name }}" `shouldBe` + returnedOne (Variable True (NamedData ["name-name"])) + + it "allows '_' in variable names" $ + lparse "{{ name_name }}" `shouldBe` + returnedOne (Variable True (NamedData ["name_name"])) + + it "parses a variable unescaped with {{{}}}" $ + 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 unescaped (NamedData ["name"])) + + it "parses a variable unescaped with & with whitespace" $ + lparse "{{& name }}" `shouldBe` + returnedOne (Variable False (NamedData ["name"])) + + it "parses a partial" $ + lparse "{{>myPartial}}" `shouldBe` + returnedOne (Partial (Just "") "myPartial") + + it "parses a partial with whitespace" $ + lparse "{{> myPartial }}" `shouldBe` + returnedOne (Partial (Just "") "myPartial") + + it "parses the an empty section" $ + lparse "{{#section}}{{/section}}" `shouldBe` + returnedOne (Section (NamedData ["section"]) mempty) + + it "parses the an empty section with whitespace" $ + lparse "{{# section }}{{/ section }}" `shouldBe` + returnedOne (Section (NamedData ["section"]) mempty) + + it "parses a delimiter change" $ + lparse "{{=<< >>=}}<<var>>{{var}}" `shouldBe` + return [Variable True (NamedData ["var"]), TextBlock "{{var}}"] + + it "parses a delimiter change with whitespace" $ + lparse "{{=<< >>=}}<< var >>{{var}}" `shouldBe` + return [Variable True (NamedData ["var"]), TextBlock "{{var}}"] + + it "parses two subsequent delimiter changes" $ + lparse "{{=(( ))=}}(( var ))((=-- $-=))--#section$---/section$-" `shouldBe` + return [Variable True (NamedData ["var"]), Section (NamedData ["section"]) []] + + it "propagates a delimiter change from a nested scope" $ + lparse "{{#section}}{{=<< >>=}}<</section>><<var>>" `shouldBe` + 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 escaped (NamedData ["name", "val"])) + + it "parses a variable containing whitespace" $ + lparse "{{ val space }}" `shouldBe` returnedOne (Variable escaped (NamedData ["val space"])) + + +substituteSpec :: Spec +substituteSpec = + describe "substitute" $ do + + let toTemplate ast' = Template "testsuite" ast' mempty + + it "substitutes a html escaped value for a variable" $ + substitute + (toTemplate [Variable escaped (NamedData ["name"])]) + (object ["name" ~> ("\" ' < > &" :: T.Text)]) + `shouldBe` "" ' < > &" + + it "substitutes raw value for an unescaped variable" $ + substitute + (toTemplate [Variable unescaped (NamedData ["name"])]) + (object ["name" ~> ("\" ' < > &" :: T.Text)]) + `shouldBe` "\" ' < > &" + + it "substitutes a section when the key is present (and an empty object)" $ + substitute + (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) + (object ["section" ~> object []]) + `shouldBe` "t" + + it "substitutes a section when the key is present (and 'true')" $ + substitute + (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) + (object ["section" ~> True]) + `shouldBe` "t" + + it "substitutes a section once when the key is present and a singleton list" $ + substitute + (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) + (object ["section" ~> ["True" :: T.Text]]) + `shouldBe` "t" + + it "substitutes a section twice when the key is present and a list with two items" $ + substitute + (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) + (object ["section" ~> (["True", "False"] :: [T.Text])]) + `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 [Section (NamedData ["section"]) [Variable escaped (NamedData ["t"])]]) + (object + [ "section" ~> + [ object ["t" ~> ("var1" :: T.Text)] + , object ["t" ~> ("var2" :: T.Text)] + ] + ]) + `shouldBe` "var1var2" + + it "substitutes an inverse section when the key is present (and null)" $ + substitute + (toTemplate [InvertedSection (NamedData ["section"]) [TextBlock "t"]]) + (object ["section" ~> Null]) + `shouldBe` "t" + + it "does not substitute a section when the key is not present" $ + substitute + (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) + (object []) + `shouldBe` "" + + it "does not substitute a section when the key is present (and 'false')" $ + substitute + (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) + (object ["section" ~> False]) + `shouldBe` "" + + it "does not substitute a section when the key is present (and null)" $ + substitute + (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) + (object ["section" ~> Null]) + `shouldBe` "" + + it "does not substitute a section when the key is present (and empty list)" $ + substitute + (toTemplate [Section (NamedData ["section"]) [TextBlock "t"]]) + (object ["section" ~> ([] :: [T.Text])]) + `shouldBe` "" + + it "substitutes a lambda by applying lambda to contained text" $ + substitute + (toTemplate [Section (NamedData ["lambda"]) [TextBlock "t"]]) + (object ["lambda" ~> (overText T.toUpper)]) + `shouldBe` "T" + + it "substitutes a lambda by applying lambda to the nested substitution results" $ + substitute + (toTemplate [Section (NamedData ["lambda"]) [TextBlock "t", Variable escaped (NamedData ["inner"])]]) + (object [ "lambda" ~> (overText T.toUpper) + , "inner" ~> ("var" :: T.Text) + ]) + `shouldBe` "TVAR" + + it "substitutes a lambda used directly as if applied to empty block" $ + substitute + (toTemplate [Variable escaped (NamedData ["lambda"])]) + (object ["lambda" ~> (Lambda $ \[] -> return [TextBlock "T"])]) + `shouldBe` "T" + + it "substitutes a nested section" $ + substitute + (toTemplate [Variable escaped (NamedData ["outer", "inner"])]) + (object + [ "outer" ~> object ["inner" ~> ("success" :: T.Text)] + , "inner" ~> ("error" :: T.Text) + ] + ) + `shouldBe` "success" + + +converterSpec :: Spec +converterSpec = + describe "toMustache" $ + it "converts a String" $ + toMustache ("My String" :: String) `shouldSatisfy` \case (String "My String") -> True; _ -> False + +-- This is a one-off instance to define how we want the Spec to compare templates +instance Eq Template where + (==) = (==) `on` ast + +compileTimeSpec :: Spec +compileTimeSpec = + describe "compileTimeCompiling" $ do + + it "creates compiled templates from a QuasiQuoter" $ + Right [mustache|This {{ template }} was injected at compile time with a quasiquoter|] `shouldBe` + compileTemplate "Template Name" "This {{ template }} was injected at compile time with a quasiquoter" + + it "creates compiled templates from an embedded file" $ + Right $(embedTemplate ["test/unit/examples"] "test-template.txt.mustache") `shouldBe` + compileTemplate "Template Name" "This {{ template }} was injected at compile time with an embedded file\n" + + it "creates compiled templates from a single embedded file" $ + Right $(embedSingleTemplate "test/unit/examples/test-template.txt.mustache") `shouldBe` + compileTemplate "Template Name" "This {{ template }} was injected at compile time with an embedded file\n" + + it "creates compiled templates from an embedded file containing partials" $ + Right $(embedTemplate ["test/unit/examples", "test/unit/examples/partials"] "test-template-partials.txt.mustache") `shouldBe` + unsafePerformIO (automaticCompile ["test/unit/examples", "test/unit/examples/partials"] "test-template-partials.txt.mustache") + +main :: IO () +main = hspec $ do + parserSpec + substituteSpec + converterSpec + compileTimeSpec diff --git a/mustache/test/unit/examples/partials/test-partial.txt.mustache b/mustache/test/unit/examples/partials/test-partial.txt.mustache new file mode 100644 index 0000000..87428a6 --- /dev/null +++ b/mustache/test/unit/examples/partials/test-partial.txt.mustache @@ -0,0 +1 @@ +and {{ partials }} diff --git a/mustache/test/unit/examples/test-template-partials.txt.mustache b/mustache/test/unit/examples/test-template-partials.txt.mustache new file mode 100644 index 0000000..738b5ca --- /dev/null +++ b/mustache/test/unit/examples/test-template-partials.txt.mustache @@ -0,0 +1 @@ +This {{ template }} was injected at compile time with an embedded file {{> test-partial.txt.mustache }} diff --git a/mustache/test/unit/examples/test-template.txt.mustache b/mustache/test/unit/examples/test-template.txt.mustache new file mode 100644 index 0000000..75e8897 --- /dev/null +++ b/mustache/test/unit/examples/test-template.txt.mustache @@ -0,0 +1 @@ +This {{ template }} was injected at compile time with an embedded file |