mustache 2.4.2 → 2.4.3
raw patch · 18 files changed
+2494/−2308 lines, 18 filessetup-changednew-uploader
Files
- CHANGELOG.md +115/−104
- LICENSE +30/−30
- README.md +58/−54
- Setup.hs +2/−2
- app/Main.hs +72/−72
- mustache.cabal +132/−141
- src/Text/Mustache.hs +204/−197
- src/Text/Mustache/Compile.hs +234/−213
- src/Text/Mustache/Internal.hs +44/−41
- src/Text/Mustache/Internal/Types.hs +468/−412
- src/Text/Mustache/Parser.hs +349/−311
- src/Text/Mustache/Render.hs +269/−248
- src/Text/Mustache/Types.hs +125/−110
- test/integration/Language.hs +122/−110
- test/unit/Spec.hs +267/−260
- test/unit/examples/partials/test-partial.txt.mustache +1/−1
- test/unit/examples/test-template-partials.txt.mustache +1/−1
- test/unit/examples/test-template.txt.mustache +1/−1
CHANGELOG.md view
@@ -1,104 +1,115 @@-# 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+# Mustache library changelog + +## v2.4.3 + +- Adds compatibility with `text >= 2.1.2`. + +## 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
LICENSE view
@@ -1,30 +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.+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.
README.md view
@@ -1,54 +1,58 @@-# 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+# 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
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
app/Main.hs view
@@ -1,72 +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+{-# 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
mustache.cabal view
@@ -1,141 +1,132 @@-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+cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.38.1. +-- +-- see: https://github.com/sol/hpack + +name: mustache +version: 2.4.3 +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#readme +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 +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: https://github.com/JustusAdam/mustache + +library + exposed-modules: + Text.Mustache + Text.Mustache.Compile + Text.Mustache.Parser + Text.Mustache.Render + Text.Mustache.Types + other-modules: + Text.Mustache.Internal + Text.Mustache.Internal.Types + hs-source-dirs: + src + default-extensions: + LambdaCase + TupleSections + other-extensions: + LambdaCase + NamedFieldPuns + OverloadedStrings + QuasiQuotes + TemplateHaskell + TupleSections + 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 + 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 + 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 + 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
src/Text/Mustache.hs view
@@ -1,197 +1,204 @@-{-|-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+{-| +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 -> pure () -- 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 + + + +-} +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 qualified Data.Text as T +import Text.Mustache.Compile + ( automaticCompile, compileTemplate, compileTemplateWithCache + , localAutomaticCompile + ) +import Text.Mustache.Render + ( catchSubstitute, checkedSubstitute, checkedSubstituteValue + , substitute, substituteAST, substituteNode, substituteValue + ) +import Text.Mustache.Types + ( Template (..), ToMustache (..), Value, (~>), (~=) + , integralToMustache, object + ) + + +-- | 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
src/Text/Mustache/Compile.hs view
@@ -1,213 +1,234 @@-{-|-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)+{-| +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 #-} +module Text.Mustache.Compile + ( automaticCompile + , localAutomaticCompile + , TemplateCache + , compileTemplateWithCache + , compileTemplate + , cacheFromList + , getPartials + , mustache + , embedTemplate + , embedSingleTemplate + ) where + + +import Control.Arrow ( (&&&) ) +import Control.Monad ( (<=<), filterM, foldM ) +import Control.Monad.Except + ( ExceptT (..), MonadError (..), runExceptT ) +import Control.Monad.State + ( MonadState (..), MonadTrans (..), StateT, evalStateT + , modify + ) +import Data.Bool ( bool ) +import qualified Data.HashMap.Strict as HM +import Data.Text ( Text ) +import qualified Data.Text as T +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 (..), quoteExp ) +import qualified Language.Haskell.TH.Syntax as THS +import System.Directory ( doesFileExist, makeAbsolute ) +import System.FilePath ( (</>) ) +import Text.Mustache.Parser ( parse ) +import Text.Mustache.Types + ( STree, Template (..), TemplateCache, Node (..) ) +import Text.Parsec.Error ( Message (..), ParseError, newErrorMessage ) +import Text.Parsec.Pos ( initialPos ) +import Text.Printf ( 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 -> pure 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) + pure (st { partials = HM.insert partialName nt p }) + ) + compiled + (getPartials mSTree) + + +-- | Flatten a list of Templates into a single 'TemplateCache' +cacheFromList :: [Template] -> TemplateCache +cacheFromList = flattenPartials . HM.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 = (getPartials' =<<) + + +{-| + Find partials in a single Node +-} +getPartials' :: Node Text -> [FilePath] +getPartials' (Partial _ p) = pure p +getPartials' (Section _ n) = getPartials n +getPartials' (InvertedSection _ n) = getPartials n +getPartials' _ = mempty + + +flattenPartials :: TemplateCache -> TemplateCache +flattenPartials m = HM.foldrWithKey (HM.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 (T.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)
src/Text/Mustache/Internal.hs view
@@ -1,41 +1,44 @@-{-|-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" , ">")- ]+{-| +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) = pure (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" , ">") + ]
src/Text/Mustache/Internal/Types.hs view
@@ -1,412 +1,468 @@-{-# 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-+{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +module Text.Mustache.Internal.Types + ( Array + , ASTree + , Context (..) + , DataIdentifier (..) + , Key + , Node (..) + , Object + , Pair + , STree + , SubM (..) + , SubstitutionError (..) + , Template (..) + , TemplateCache + , ToMustache (..) + , Value (..) + , innerSearch + , integralToMustache + , runSubM + , search + , shiftContext + , tellError + , tellSuccess + ) where + + +import Control.Arrow ( Arrow (..) ) +import Control.Monad.RWS + ( MonadReader (..), MonadWriter (..), RWS, RWST (..), asks + , evalRWS + ) +import qualified Data.Aeson as Aeson +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.KeyMap as KM +#endif +import Data.Foldable ( toList ) +import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS +import Data.Int ( Int8, Int16, Int32, Int64 ) +import qualified Data.Map as Map +import Data.Scientific ( Scientific, fromFloatDigits ) +import qualified Data.Sequence as Seq +import qualified Data.Set as Set +import Data.Text ( Text ) +import qualified Data.Text as T +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) +#if !MIN_VERSION_unordered_containers(0,2,17) || !MIN_VERSION_text(1,2,4) +import Language.Haskell.TH.Syntax ( Lift (..) ) +#endif +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 [] = pure 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 + _ -> pure Nothing + case focus of + Object o -> + case HM.lookup key o of + Just res -> pure $ 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 . T.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 T.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 T.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 . T.unpack +#endif
src/Text/Mustache/Parser.hs view
@@ -1,311 +1,349 @@-{-|-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)+{-| +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 CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +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 ( void, when ) +import Data.Char ( isAlphaNum, isSpace ) +import Data.List ( nub ) +#if !MIN_VERSION_base(4,11,0) +import Data.Monoid ( (<>) ) +#endif +import Data.Text ( Text ) +import qualified Data.Text as T +import Text.Mustache.Types ( DataIdentifier (..), Node (..), STree ) +import Text.Parsec + ( Parsec, ParseError, (<|>), anyChar, char, choice, eof + , getState, lookAhead, many, manyTill, modifyState, noneOf + , optionMaybe, oneOf, parserFail, putState, runParser + , satisfy, skipMany, space, spaces, string, try + ) + + +-- | Initial configuration for the parser +newtype 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 . 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' + pure $ 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 = 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 <> T.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 } + pure [TextBlock text | not (T.null 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 (T.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 = pure name } + innerSectionContent <- parseText + let sectionTag = + if inverted + then InvertedSection + else Section + modifyState $ \s -> s { currentSectionName = previousSection } + outerSectionContent <- parseText + pure (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 + pure $ textNodes <> pure 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 (pure $ snd unescape2)) + , Tag . Partial Nothing + <$> ( try (char partialBegin) + >> spaces + >> (noneOf (nub end) `manyTill` try (spaces >> string end)) + ) + , pure HandledTag + << (try (char delimiterChange) >> parseDelimChange) + , SectionBegin True + <$> (try (char invertedSectionBegin) >> genParseTagEnd mempty >>= \case + n@(NamedData _) -> pure n + _ -> parserFail "Inverted Sections can not be implicit." + ) + , pure 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) + <|> (mempty <$ (spaces >> string nEnd)) + pure $ T.pack one : others + spaces + (try (char implicitIterator) >> spaces >> string nEnd >> pure Implicit) + <|> (NamedData <$> parseOne)
src/Text/Mustache/Render.hs view
@@ -1,248 +1,269 @@-{-|-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)+{-| +Module : $Header$ +Description : Functions for rendering mustache templates. +Copyright : (c) Justus Adam, 2015 +License : BSD3 +Maintainer : dev@justus.science +Stability : experimental +Portability : POSIX +-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +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 Control.Monad.Reader ( MonadReader (..), asks ) +import Control.Monad.Writer ( MonadWriter (..), censor ) +#if !MIN_VERSION_base(4,11,0) +import Data.Monoid ( (<>) ) +#endif +import Data.Foldable ( for_ ) +import qualified Data.HashMap.Strict as HM +import Data.Maybe ( fromMaybe ) +import Data.Scientific ( floatingOrInteger ) +import Data.Text ( Text ) +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified Data.Vector as V +import Text.Mustache.Internal ( escapeXMLText, uncons ) +import Text.Mustache.Internal.Types + ( SubM (..), SubstitutionError (..), innerSearch, runSubM + , search, shiftContext, tellError, tellSuccess + ) +import Text.Mustache.Types + ( Context (..), DataIdentifier (..), Node (..), STree + , Template (..), ToMustache (..), Value (..), askContext + ) + + +{-| + 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 -> pure () + | 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 pure () + 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) -> pure () + Just Null -> pure () + 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 + _ -> pure () + 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 = [TextBlock indentation | not (T.null indentation)] + content = if T.null indentation + then ast' + else reverse $ maybe [] (uncurry (:) . first dropper) (uncons (reverse fullIndented)) + where + fullIndented = fmap (indentBy indentation) ast' + dropper (TextBlock t) = TextBlock $ + if ("\n" <> indentation) `T.isSuffixOf` t + then fromMaybe t $ 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 $ T.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) = pure t +toString (Number n) = pure $ either + (T.pack . show) + (T.pack . show) + (floatingOrInteger n :: Either Double Integer) +toString (Lambda l) = do + ((), res) <- catchSubstitute $ substituteAST =<< l [] + pure res +toString e = do + tellError $ DirectlyRenderedValue e + pure $ T.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 T.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 (pure . TextBlock) . f)
src/Text/Mustache/Types.hs view
@@ -1,110 +1,125 @@-{-|-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+{-| +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 ( asks ) +import qualified Data.Aeson as Aeson +import qualified Data.HashMap.Strict as HM +import Data.Text ( Text ) +import Text.Mustache.Internal.Types + ( ASTree, Array, Context (..), DataIdentifier (..), Key + , Node (..), Object, Pair, STree, SubM, Template (..) + , TemplateCache, ToMustache (..), Value (..) + , integralToMustache + ) + + +-- | 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
test/integration/Language.hs view
@@ -1,110 +1,122 @@-{-# 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+{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UnicodeSyntax #-} +module Main + ( main + ) where + +import qualified Codec.Archive.Tar as Tar +import qualified Codec.Compression.GZip as GZip +import Control.Applicative ( (<$>), (<*>) ) +import Control.Exception ( Exception (..) ) +import Control.Lens ( (^.) ) +import Control.Monad ( mzero, void ) +import Data.ByteString.Lazy ( toStrict ) +import Data.Foldable ( for_ ) +import qualified Data.HashMap.Strict as HM +import Data.List ( isPrefixOf ) +import Data.Maybe ( fromMaybe ) +import qualified Data.Text as T +import Data.Yaml + ( FromJSON, Value (..), (.!=), (.:), (.:?), decodeEither' + , parseJSON + ) +import Network.Wreq ( get, responseBody ) +import System.FilePath ( takeExtension, takeFileName ) +import Test.Hspec + ( Spec, describe, expectationFailure, hspec, shouldBe, it ) +import Text.Mustache + ( Template (..), compileTemplate, substituteValue, toMustache + ) + +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 :: Value + , template :: T.Text + , expected :: T.Text + , testPartials :: HM.HashMap String T.Text + } + + +instance FromJSON LangSpecFile where + parseJSON (Object o) = LangSpecFile + <$> o .: "overview" + <*> o .: "tests" + parseJSON _ = mzero + + +instance FromJSON LangSpecTest where + parseJSON (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) + pure $ 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 + , case decodeEither' $ toStrict f of + Left e -> error $ + "Error parsing spec file " + ++ filename + ++ ": " + ++ displayException e + Right spec -> spec + ) : 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 + pure $ 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
test/unit/Spec.hs view
@@ -1,260 +1,267 @@-{-# 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+{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +module Main + ( main + ) where + + +import Control.Applicative ( (<$>), (<*>) ) +import Data.Either ( isLeft ) +import Data.Function ( on ) +import qualified Data.Text as T +import System.IO.Unsafe ( unsafePerformIO ) +import Test.Hspec + ( Spec, describe, hspec, it, shouldBe, shouldSatisfy ) +import Text.Mustache + ( Template (..), ToMustache (..), (~>), automaticCompile + , compileTemplate, object, overText, substitute + ) +import Text.Mustache.Compile + ( embedTemplate, embedSingleTemplate, mustache ) +import Text.Mustache.Parser ( parse ) +import Text.Mustache.Types + ( DataIdentifier (..), Node (..), Value (..) ) + + +escaped :: Bool +escaped = True +unescaped :: Bool +unescaped = False + + +parserSpec :: Spec +parserSpec = + describe "mustacheParser" $ do + let lparse = parse "testsuite" + let returnedOne = pure . pure + + 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` + pure [Variable True (NamedData ["var"]), TextBlock "{{var}}"] + + it "parses a delimiter change with whitespace" $ + lparse "{{=<< >>=}}<< var >>{{var}}" `shouldBe` + pure [Variable True (NamedData ["var"]), TextBlock "{{var}}"] + + it "parses two subsequent delimiter changes" $ + lparse "{{=(( ))=}}(( var ))((=-- $-=))--#section$---/section$-" `shouldBe` + pure [Variable True (NamedData ["var"]), Section (NamedData ["section"]) []] + + it "propagates a delimiter change from a nested scope" $ + lparse "{{#section}}{{=<< >>=}}<</section>><<var>>" `shouldBe` + pure [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 (\[] -> pure [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
test/unit/examples/partials/test-partial.txt.mustache view
@@ -1,1 +1,1 @@-and {{ partials }}+and {{ partials }}
test/unit/examples/test-template-partials.txt.mustache view
@@ -1,1 +1,1 @@-This {{ template }} was injected at compile time with an embedded file {{> test-partial.txt.mustache }}+This {{ template }} was injected at compile time with an embedded file {{> test-partial.txt.mustache }}
test/unit/examples/test-template.txt.mustache view
@@ -1,1 +1,1 @@-This {{ template }} was injected at compile time with an embedded file+This {{ template }} was injected at compile time with an embedded file