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