diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright John MacFarlane (c) 2016 +Copyright John MacFarlane (c) 2009-2019 All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,16 +1,40 @@ # doctemplates -This is the templating system used by pandoc. It was formerly -be a module in pandoc. It has been split off to make it easier -to use independently. +[![CI +tests](https://github.com/jgm/doctemplates/workflows/CI%20tests/badge.svg)](https://github.com/jgm/doctemplates/actions) -Example: +This is the text templating system used by pandoc. Its basic function is to +fill variables in a template. Variables are provided by a "context." +Any instance of the `ToContext` typeclass (such as an aeson `Value`) +can serve as the context, or a `Context` value can be constructed manually. + +Control structures are provided to test whether a variable has a non-blank +value and to iterate over the items of a list. Partials---that is, +subtemplates defined in different files---are supported. Pipes +can be used to transform the values of variables or partials. +The provided pipes make it possible to do list enumeration and +tabular layout in templates. + +Templates are rendered to a doclayout `Doc` (which is polymorphic +in the underlying string type). If `Doc` values are used in the +context, rendered documents will be able to wrap flexibly on breaking +spaces. This feature makes doctemplates more suitable than other +template engines for plain-text formats (like Markdown). + +Unlike the various HTML-centered template engines, doctemplates is +output-format agnostic, so no automatic escaping is done on interpolated +values. Values are assumed to be escaped properly in the Context. + +## Example of use + ``` haskell {-# LANGUAGE OverloadedStrings #-} -import Data.Text +import Data.Text (Text) +import qualified Data.Text.IO as T import Data.Aeson import Text.DocTemplates +import Text.DocLayout (render) data Employee = Employee { firstName :: String , lastName :: String @@ -23,9 +47,12 @@ template :: Text template = "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$" -main = case compileTemplate template of +main :: IO () +main = do + res <- compileTemplate "mytemplate.txt" template + case res of Left e -> error e - Right t -> putStrLn $ renderTemplate t $ object + Right t -> T.putStrLn $ render Nothing $ renderTemplate t $ object ["employee" .= [ Employee "John" "Doe" Nothing , Employee "Omar" "Smith" (Just 30000) @@ -33,32 +60,405 @@ ] ``` +## Delimiters + +To mark variables and control structures in the template, +either `$`...`$` or `${`...`}` may be used as delimiters. +The styles may also be mixed in the same template, but the +opening and closing delimiter must match in each case. The +opening delimiter may be followed by one or more spaces +or tabs, which will be ignored. The closing delimiter may +be followed by one or more spaces or tabs, which will be +ignored. + +To include a literal `$` in the document, use `$$`. + +## Comments + +Anything between the sequence `$--` and the end of the +line will be treated as a comment and omitted from the output. + +## Interpolated variables + A slot for an interpolated variable is a variable name surrounded -by dollar signs. To include a literal `$` in your template, use -`$$`. Variable names must begin with a letter and can contain letters, -numbers, `_`, `-`, and `.`. +by matched delimiters. Variable names must begin with a letter +and can contain letters, numbers, `_`, `-`, and `.`. The +keywords `it`, `if`, `else`, `endif`, `for`, `sep`, and `endfor` may +not be used as variable names. Examples: -The values of variables are determined by a JSON object that is +``` +$foo$ +$foo.bar.baz$ +$foo_bar.baz-bim$ +$ foo $ +${foo} +${foo.bar.baz} +${foo_bar.baz-bim} +${ foo } +``` + +The values of variables are determined by the `Context` that is passed as a parameter to `renderTemplate`. So, for example, `title` will return the value of the `title` field, and `employee.salary` will return the value of the `salary` field of the object that is the value of the `employee` field. -The value of a variable will be indented to the same level as the -variable. +- If the value of the variable is simple value, it will be + rendered verbatim. (Note that no escaping is done; + the assumption is that the calling program will escape + the strings appropriately for the output format.) +- If the value of the variable is a boolean value, it + will be rendered as `true` if true, or as empty if false. +- If the value is a list, the values will be concatenated. +- If the value is a map, the string `true` will be rendered. +- Every other value will be rendered as the empty string. -A conditional begins with `$if(variable_name)$` and ends with `$endif$`. -It may optionally contain an `$else$` section. The if section is -used if `variable_name` has a non-null value, otherwise the else section -is used. +When a `Context` is derived from an aeson (JSON) `Value`, +the following conversions are done: -Conditional keywords should not be indented, or unexpected spacing -problems may occur. +- If the value is a number, it will be rendered as an + integer if possible, otherwise as a floating-point number. -The `$for$` keyword can be used to iterate over an array. If -the value of the associated variable is not an array, a single -iteration will be performed on its value. -You may optionally specify separators using `$sep$`, as in the -example above. +## Conditionals + +A conditional begins with `if(variable)` (enclosed in +matched delimiters) and ends with `endif` (enclosed in matched +delimiters). It may optionally contain an `else` (enclosed in +matched delimiters). The `if` section is used if +`variable` has a true value, otherwise the `else` +section is used (if present). The following values +count as true: + +- any map +- any array containing at least one true value +- any nonempty string (even `false`) +- boolean True + +Examples: + +``` +$if(foo)$bar$endif$ + +$if(foo)$ + $foo$ +$endif$ + +$if(foo)$ +part one +$else$ +part two +$endif$ + +${if(foo)}bar${endif} + +${if(foo)} + ${foo} +${endif} + +${if(foo)} +${ foo.bar } +${else} +no foo! +${endif} +``` + +The keyword `elseif` may be used to simplify complex nested +conditionals. Thus + +``` +$if(foo)$ +XXX +$elseif(bar)$ +YYY +$else$ +ZZZ +$endif$ +``` + +is equivalent to + +``` +$if(foo)$ +XXX +$else$ +$if(bar)$ +YYY +$else$ +ZZZ +$endif$ +$endif$ +``` + +## For loops + +A for loop begins with `for(variable)` (enclosed in +matched delimiters) and ends with `endfor` (enclosed in matched +delimiters). + +- If `variable` is an array, the material inside the loop will + be evaluated repeatedly, with `variable` being set to each + value of the array in turn, and concatenated. +- If `variable` is a map, the material inside will be set to + the map. +- If the value of the associated variable is not an array or + a map, a single iteration will be performed on its value. + +Examples: + +``` +$for(foo)$$foo$$sep$, $endfor$ + +$for(foo)$ + - $foo.last$, $foo.first$ +$endfor$ + +${ for(foo.bar) } + - ${ foo.bar.last }, ${ foo.bar.first } +${ endfor } + +$for(mymap)$ +$it.name$: $it.office$ +$endfor$ +``` + +You may optionally specify a separator between consecutive +values using `sep` (enclosed in matched delimiters). The +material between `sep` and the `endfor` is the separator. + +``` +${ for(foo) }${ foo }${ sep }, ${ endfor } +``` + +Instead of using `variable` inside the loop, the special +anaphoric keyword `it` may be used. + +``` +${ for(foo.bar) } + - ${ it.last }, ${ it.first } +${ endfor } +``` + +## Partials + +Partials (subtemplates stored in different files) may be +included using the syntax + +``` +${ boilerplate() } +``` + +The partials are obtained using `getPartial` from +the `TemplateMonad` class. This may be implemented +differently in different monads. The path passed +to `getPartial` is computed on the basis of the +original template path (a parameter to `compileTemplate`) +and the partial's name. The partial's name is substituted +for the *base name* of the original template path +(leaving the original template's extension), unless +the partial has an explicit extension, in which case +this is kept. So, with the `TemplateMonad` instance +for IO, partials will be sought in the directory +containing the main template, and will be assumed +to have the extension of the main template. + +Partials may optionally be applied to variables using +a colon: + +``` +${ date:fancy() } + +${ articles:bibentry() } +``` + +If `articles` is an array, this will iterate over its +values, applying the partial `bibentry()` to each one. So the +second example above is equivalent to + +``` +${ for(articles) } +${ it:bibentry() } +${ endfor } +``` + +Note that the anaphoric keyword `it` must be used when +iterating over partials. In the above examples, +the `bibentry` partial should contain `it.title` +(and so on) instead of `articles.title`. + +Final newlines are omitted from included partials. + +Partials may include other partials. If you exceed +a nesting level of 50, though, in resolving partials, +the literal `(loop)` will be returned, to avoid infinite loops. + +A separator between values of an array may be specified +in square brackets, immediately after the variable name +or partial: + +``` +${months[, ]}$ + +${articles:bibentry()[; ]$ +``` + +The separator in this case is literal and (unlike with `sep` +in an explicit `for` loop) cannot contain interpolated +variables or other template directives. + +## Nesting + +To ensure that content is "nested," that is, subsequent lines +indented, use the `^` directive: + +``` +$item.number$ $^$$item.description$ ($item.price$) +``` + +In this example, if `item.description` has multiple lines, +they will all be indented to line up with the first line: + +``` +00123 A fine bottle of 18-year old + Oban whiskey. ($148) +``` + +To nest multiple lines to the same level, align them +with the `^` directive in the template. For example: + +``` +$item.number$ $^$$item.description$ ($item.price$) + (Available til $item.sellby$.) +``` + +will produce + +``` +00123 A fine bottle of 18-year old + Oban whiskey. ($148) + (Available til March 30, 2020.) +``` + +If a variable occurs by itself on a line, preceded by whitespace +and not followed by further text or directives on the same line, +and the variable's value contains multiple lines, it will be +nested automatically. + +## Breakable spaces + +When rendering to a `Doc`, a distinction can be made between +breakable and unbreakable spaces. Normally, spaces in the +template itself (as opposed to values of the interpolated +variables) are not breakable, but they can be made breakable +in part of the template by using the `~` keyword (ended +with another `~`). + +``` +$~$This long line may break if the document is rendered +with a short line length.$~$ +``` + +The `~` keyword has no effect when rendering to `Text` +or `String`. + +## Pipes + +A pipe transforms the value of a variable or partial. Pipes +are specified using a slash (`/`) between the variable name (or +partial) and the pipe name. Example: + +``` +$for(name)$ +$name/uppercase$ +$endfor$ + +$for(metadata/pairs)$ +- $it.key$: $it.value$ +$endfor$ + +$employee:name()/uppercase$ +``` + +Pipes may be chained: + +``` +$for(employees/pairs)$ +$it.key/alpha/uppercase$. $it.name$ +$endfor$ +``` + +Some pipes take parameters: + +``` +|----------------------|------------| +$for(employee)$ +$it.name.first/uppercase/left 20 "| "$$it.name.salary/right 10 " | " " |"$ +$endfor$ +|----------------------|------------| +``` + +Currently the following pipes are predefined: + +- `pairs`: Converts a map or array to an array of maps, + each with `key` and `value` fields. If the original + value was an array, the `key` will be the array index, + starting with 1. + +- `first`: Returns the first value of an array, if + applied to a non-empty array; otherwise returns + the original value. + +- `last`: Returns the last value of an array, if + applied to a non-empty array; otherwise returns + the original value. + +- `rest`: Returns all but the first value of an array, if + applied to a non-empty array; otherwise returns + the original value. + +- `allbutlast`: Returns all but the last value of an array, if + applied to a non-empty array; otherwise returns + the original value. + +- `uppercase`: Converts text to uppercase. + +- `lowercase`: Converts text to lowercase. + +- `length`: Returns the length of the value: number + of characters for a textual value, number of elements + for a map or array. + +- `reverse`: Reverses a textual value or array, + and has no effect on other values. + +- `chomp`: Removes trailing newlines (and breakable space). + +- `nowrap`: Disables line wrapping on breakable spaces. + +- `alpha`: Converts textual values that can be + read as an integer into lowercase alphabetic + characters `a..z` (mod 26). This can be used to get lettered + enumeration from array indices. To get uppercase + letters, chain with `uppercase`. + +- `roman`: Converts textual values that can be + read as an integer into lowercase roman numerials. + This can be used to get lettered enumeration from array indices. + To get uppercase roman, chain with `uppercase`. + +- `left n "leftborder" "rightborder"`: Renders a textual value + in a block of width `n`, aligned to the left, with an optional + left and right border. Has no effect on other values. This + can be used to align material in tables. Widths are positive + integers indicating the number of characters. Borders + are strings inside double quotes; literal `"` and `\` characters + must be backslash-escaped. + +- `right n "leftborder" "rightborder"`: Renders a textual value + in a block of width `n`, aligned to the right, and has no + effect on other values. + +- `center n "leftborder" "rightborder"`: Renders a textual + value in a block of width `n`, aligned to the center, and has + no effect on other values. diff --git a/bench/bench.hs b/bench/bench.hs new file mode 100644 --- /dev/null +++ b/bench/bench.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +import Text.DocTemplates +import qualified Data.Text as T +import Data.Text (Text) +import Criterion.Main +import Criterion.Types (Config (..)) +import Control.Monad.Identity +import Data.Semigroup ((<>)) +import Data.Aeson (object, (.=), Value) +import Text.DocLayout (render) + +main :: IO () +main = do + Right bigtextTemplate <- compileTemplate "bigtext.txt" bigtext + defaultMainWith defaultConfig{ timeLimit = 5.0 } $ + [ bench "applyTemplate" $ + nf (fmap (render Nothing) + . runIdentity . applyTemplate "bigtext" bigtext + :: Value -> Either String Text) + val + , bench "renderTemplate" $ + nf (render Nothing . renderTemplate bigtextTemplate :: Value -> Text) + val + ] + +bigtext :: Text +bigtext = T.replicate 150 $ + "Hello there $foo$. This is a big text.\n$for(bar)$$bar.baz$$endfor$\n" + <> "$if(foo)$Hi $foo$.$endif$\n" + +val :: Value +val = object [ "foo" .= (22 :: Int) + , "bar" .= [ object [ "baz" .= ("Hello"::Text) ] + , object [ "baz" .= ("Bye"::Text) ] + ] + ] + diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,341 @@ +# doctemplates + +# 0.11.0.1 + + * Bump version bounds for doclayout. + + * Fix typos. + +# 0.11 + + * Remove HsYAML depenedency. + + * Remove upper bound for criterion. + +## 0.10.0.2 + + * Use doclayout 0.4. + +## 0.10.0.1 + + * Don't rely on aeson Object being implemented as a HashMap. + This change is needed for doctemplates to compile against aeson 2.0.0.0. + +## 0.10 + + * Change rendering and conditional behavior with booleans. + Previously, `$if(foo)$` evaluated to false iff `foo` + would render as the empty string. This forced us to render + a boolean False value as an empty string, rather than `false`. + And this has caused various problems with templates + (#16, jgm/pandoc#7402). Now, boolean False values render as + `false` -- just as True values render as `true`. And conditionals + are now sensitive to booleans, so `$if(foo)$` evaluates to false + when `foo` is a boolean False value, even though it would render + as the nonempty string `false`. + +## 0.9 + + * Add BoolVal constructor to Val. This gives a smoother + interface with JSON and YAML. [API change] + + * Remove overlapping instances by generalizing + `ToContext String String` and `FromContext String String` + to `TemplateTarget [a] => ToContext [a] [a]` and + `TemplateTarget [a] => FromContext [a] [a]`. + Remove the instance `ToContext String (Doc String)`. + Remove redundant constraints. (#9, favonia) [API change] + +## 0.8.3 + + * Properly handle nested loops (#15). Previously "it" was + always used for the variable in a loop, and in a nested loop + there was no way to distinguish the value of the inner + iteration from the value of the outer one. Now we assign + the iterated value to both "it" and to the original variable + name (e.g. "foo.bar"). This probably has a small negative + performance impact. Note that this change also affects + the output of the template parser: original variable + names are now retained instead of being replaced by "it". + + * Remove duplicate IsString constraint (#14, Mario Lang). + + * Update haddocks from README (#10). + + * Minor code clean-ups (#7, favonia). + + * Add hsyaml >= 0.2 constraint (#6). + + +## 0.8.2 + + * Add filters: first, rest, last, allbutlast. + + * New constructors for Filter: FirstItem, LastItem, Rest, AllButLast + [API change]. + +## 0.8.1 + + * Depend on doclayout 0.3, which adds an additional method + on the HasChars class. This fixes some stack overflows + in rendering very long lines. + +## 0.8 + + * Change `Filter` data type to `Pipe`. Use the nomenclature of + "pipe" instead of "filter" to avoid confusion in pandoc between + two notions of filter. Otherwise everything works the same. + +## 0.7.2 + + * Add `nowrap` filter. + + * Improve `alpha`, `roman`, `uppercase`, `lowercase` filters so they + apply recursively within a list or map. + + * Allow `for` loops to bind map value. In this case there is no + iteration, but the anophoric variable 'it' is assigned, which may + help in using filters that destructure a string into a map (if + we add any). + +## 0.7.1 + + * Add `chomp` filter. + + * Allow filters to be applied to output of partials. + +## 0.7 + + * Add haddock Makefile target, which regenerates haddocks from README + and tests the code example. + + * Remove `BreakingSpace` constructor on `Template`. + Now we use doclayout `BreakingSpace` inside a `Literal`. + + * Add instance for `ToContext a (Doc a)`. + + * Get benchmarks compiling again. + + * Use (doclayout) `Doc` internally and for rendered output. + + + `TemplateTarget` is now a type constraint synonym, not a regular + typeclass. + + Constraint on `compileTemplate` and `applyTemplate` + simplified using TemplateTarget. + + DocTemplates reexports Text.DocLayout.Doc. + + The `Literal` costructor of `Template` now takes a `Doc a` + rather than an `a`. + + The `SimpleVal` constructor of `Val` now takes a `Doc a` + rather than an `a`. + + `renderTemplate` now returns a `Doc a` rather than an `a`. + (This value can be converted to an a using `render Nothing`.) + + * Remove fromText from `TemplateTarget`. Now we use `fromString` + from Data.String. + + * Parameterize `Template` on underlying stringlike type. + + * Improved behavior of partials. + + * Improve indent functions: don't drop final newline. + + * Allow blank lines in nested section. + + * Indent for Text/String: don't indent empty lines. + + * Additional tests and documentation about nesting. + + * Render items in for loop before separator. + Otherwise we throw off column calculation. + + * Remove `+-reflow`; replace with toggle `$~$`. + + * Remove pNewline parser; it isn't needed now. + + * Remove `+-nest`. + + * Fix nest parsing bug. + + * Improve nesting. + + + Change `Nested` constructor for `Template` so it doesn't take + a parameter. + + Nesting level is now determined dynamically at render time + rather than at compile time. This gives much better results + when nesting occurs after template directives. + Benchmarks show a slight penalty in performance (from 3.5ms to 3.1ms + in rendering), but it's not too much. + + * Add filters. Filters transform the value of a variable, e.g. changing + a map into an array of key/value pairs. Closes #5. + + + Internal: Add `Filter` type and `[Filter]` parameter on `Variable`. + + Remove `unVariable`; now we have `varParts` and `varFilters`. + + Document filters in README.md. + + Implement filters. + + Add tests. + + * Add `ToYAML`, `FromYAML` instances for `Context`, `Val`. + +## 0.6.2 + + * Remove unnecessary `TemplateTarget` constraints on + `ToContext` instances. + + * Add `ToContext` instance for `Map Text a`. + + * Add `Data`, `Typeable` instances for `Context` and `Val`. + +## 0.6.1 + + * Indent bare partials. + +## 0.6 + + * Add `+nest`/`-nest` keywords. + + * Add `+reflow`/`-reflow` keywords. + + * Add Nested constructor to Template, remove Indented + and Indented parameter for Interpolate. + + * More expansive description of library. + +## 0.5.1 + + * Add elseif keyword. + + * Improve compile error source locations with partials. + + * Handle templates that don't end in newlines. Previously + this caused problems in some cases. + +## 0.5 + + * Add toText method to TemplateTarget class. + + * Add String and Lazy Text instances for TemplateTarget. + + * Swap Parameters in ToContext (so that the first parameter + for both ToContext and FromContext refers to the parameter + of Context). + + * Add toVal method to ToContext. + + * Default instance definition for toContext in terms of toVal, + so that defining toVal is sufficient. + + * Add instances for ToContext and FromContext. + + * Remove valueToContext. Add ToJSON, FromJSON instances + for Context and Val instead. + + * isEmpty: For Doc, treat `Text 0 _` as empty. + Also `Concat x y` when x and y are empty. + This differs from isEmpty in DocLayout itself, which only + applies to Empty. + + * Code cleanup. + +## 0.4 + + * Split into three modules. Main module only exports an + opaque version of the Template type. Import Internal if you + need to manipulate a Template. + + * Add Context type, parameterized on the underlying content's type. + + * Add Val type. + + * Add valueToContext for converting an Aeson Value to a Context. + + * Make renderTemplate and applyTemplate polymorphic in both + context and target. Context parameter is now any instance + of ToContext (instead of ToJSON). Result is now any + instance of TemplateTarget. + + * Change type of getPartial in TemplateMonad so it runs in the + TemplateMonad instance, not the Parser. Return a simple + value rather than an Either; error handling can vary with + the monad. + + * Remove TemplatePart. Template is now an algebraci data type, + not a list of TemplateParts. + + * Add an Indented type to indicate indentation for + interpolated variables. + + * Improve architecture, doing more at compile time. + + * Depend on doclayout. Context can be parameterized on a doclayout + Doc type, allowing intelligent reflowing of content. + + * Remove single final newline in interpolated variable. + + * Remove final newline from partial. + + * Don't iterate when the variable evaluates to NullVal. + + * Only indented interpolated variables if by themselves on line. + + * Add Indented parameter to Interpolate constructor. + + * Update documentation and haddocks. + + * Add benchmark. + +## 0.3.0.1 + +* Bump lower bound on base to 4.9, drop support for ghc 7.10. + +* Add needed import for older base versions. + +* Add test.hs to repository. + +## 0.3 + +* Note that all of the changes to template syntax described + below are backwards compatible, and all old pandoc templates + should continue to work as before. + +* Allow `${...}` style delimiters around variables and + directives, in addition to `$...$`. Allow space around + the delimiters. + +* Support `$it$` as a variable for the current value in + an iteration. (The old method, where the containing + variable name is used, still works.) + +* Support partials (subtemplates defined in different files). + +* Interpolated array variables now have all elements rendered, + concatenated, with an optional separator that can be + specified using a new bracketed syntax. + +* Remove `TemplateTarget` class. It was pointless; the + calling program can just do these trivial transformations. + Avoids dependencies on bytestring, blaze-html, blaze-markup. + +* Change type of `renderTemplate` and `applyTemplate` to produce + a `Text`, instead of being polymorphic. + +* Changed type of `compileTemplate`: it now takes a + template path and the template contents, and returns + either a template or an error. It runs in an instance + of `TemplateMonad`, which is an abstraction around different + ways of getting partials. (For example, in IO we can get + partials by reading them from a file system, but in a + web application one might want to obtain them from the + database or have a set of them baked in.) + +* Remove `varListToJSON`. + +* Changed the architecture: `Template` is no longer just + a newtype around a function, but a list of `TemplatePart`s. + +* Added a newtype for `Variable`. + +* Improved documentation in README.md. + +* Added a new test framework and much more extensive tests. + diff --git a/doctemplates.cabal b/doctemplates.cabal --- a/doctemplates.cabal +++ b/doctemplates.cabal @@ -1,47 +1,86 @@ name: doctemplates -version: 0.1.0.2 +version: 0.11.0.1 synopsis: Pandoc-style document templates -description: Please see README.md +description: This is the text templating system used by pandoc. + It supports variable interpolation, iteration, + tests for non-blank values, pipes, and partials. + Templates are rendered to doclayout Docs, + and variable values may come from a variety of + different sources, including aeson Values. homepage: https://github.com/jgm/doctemplates#readme license: BSD3 license-file: LICENSE author: John MacFarlane maintainer: jgm@berkeley.edu -copyright: 2016 John MacFarlane +copyright: 2016-19 John MacFarlane category: Text build-type: Simple -- extra-source-files: data-files: README.md + changelog.md +extra-source-files: test/*.test + test/*.txt + test/*.tex cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Text.DocTemplates - build-depends: base >= 4.7 && < 5, + Text.DocTemplates.Parser + Text.DocTemplates.Internal + build-depends: base >= 4.9 && < 5, + safe, + text-conversions, aeson, - bytestring, - blaze-markup, - blaze-html, text, + doclayout >= 0.4 && < 0.6, containers, vector, + filepath, parsec, - unordered-containers, + mtl, scientific + if !impl(ghc >= 8.0) + build-depends: semigroups == 0.18.* default-language: Haskell2010 ghc-options: -Wall -fno-warn-unused-do-bind test-suite doctemplates-test type: exitcode-stdio-1.0 hs-source-dirs: test - main-is: Spec.hs + main-is: test.hs build-depends: base, doctemplates, + doclayout >= 0.4 && < 0.6, + containers, aeson, - hspec, + Glob, + tasty, + tasty-golden, + tasty-hunit, + filepath, + temporary, + bytestring, text ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 + +benchmark doctemplates-bench + Type: exitcode-stdio-1.0 + Main-Is: bench.hs + Hs-Source-Dirs: bench + Build-Depends: doctemplates, + doclayout >= 0.4 && < 0.6, + base >= 4.8 && < 5, + criterion >= 1.0, + filepath, + aeson, + text, + containers, + mtl + Ghc-Options: -rtsopts -Wall -fno-warn-unused-do-bind + Default-Language: Haskell2010 + source-repository head type: git diff --git a/src/Text/DocTemplates.hs b/src/Text/DocTemplates.hs --- a/src/Text/DocTemplates.hs +++ b/src/Text/DocTemplates.hs @@ -1,22 +1,42 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, - OverloadedStrings, GeneralizedNewtypeDeriving, ScopedTypeVariables #-} {- | - Module : Text.Pandoc.Templates - Copyright : Copyright (C) 2009-2016 John MacFarlane + Module : Text.DocTemplates + Copyright : Copyright (C) 2009-2019 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable -A simple templating system with variable substitution and conditionals. -This module was formerly part of pandoc and is used for pandoc's -templates. The following program illustrates its use: +This is the text templating system used by pandoc. Its basic function is +to fill variables in a template. Variables are provided by a “context.” +Any instance of the @ToContext@ typeclass (such as an aeson @Value@) can +serve as the context, or a @Context@ value can be constructed manually. +Control structures are provided to test whether a variable has a +non-blank value and to iterate over the items of a list. Partials—that +is, subtemplates defined in different files—are supported. Pipes can be +used to transform the values of variables or partials. The provided +pipes make it possible to do list enumeration and tabular layout in +templates. + +Templates are rendered to a doclayout @Doc@ (which is polymorphic in the +underlying string type). If @Doc@ values are used in the context, +rendered documents will be able to wrap flexibly on breaking spaces. +This feature makes doctemplates more suitable than other template +engines for plain-text formats (like Markdown). + +Unlike the various HTML-centered template engines, doctemplates is +output-format agnostic, so no automatic escaping is done on interpolated +values. Values are assumed to be escaped properly in the Context. + +== Example of use + > {-# LANGUAGE OverloadedStrings #-} -> import Data.Text +> import Data.Text (Text) +> import qualified Data.Text.IO as T > import Data.Aeson > import Text.DocTemplates +> import Text.DocLayout (render) > > data Employee = Employee { firstName :: String > , lastName :: String @@ -29,277 +49,402 @@ > template :: Text > template = "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$" > -> main = case compileTemplate template of +> main :: IO () +> main = do +> res <- compileTemplate "mytemplate.txt" template +> case res of > Left e -> error e -> Right t -> putStrLn $ renderTemplate t $ object +> Right t -> T.putStrLn $ render Nothing $ renderTemplate t $ object > ["employee" .= > [ Employee "John" "Doe" Nothing > , Employee "Omar" "Smith" (Just 30000) > , Employee "Sara" "Chen" (Just 60000) ] > ] -A slot for an interpolated variable is a variable name surrounded -by dollar signs. To include a literal @$@ in your template, use -@$$@. Variable names must begin with a letter and can contain letters, -numbers, @_@, @-@, and @.@. +== Delimiters -The values of variables are determined by a JSON object that is -passed as a parameter to @renderTemplate@. So, for example, -@title@ will return the value of the @title@ field, and -@employee.salary@ will return the value of the @salary@ field -of the object that is the value of the @employee@ field. +To mark variables and control structures in the template, either @$@…@$@ +or @${@…@}@ may be used as delimiters. The styles may also be mixed in +the same template, but the opening and closing delimiter must match in +each case. The opening delimiter may be followed by one or more spaces +or tabs, which will be ignored. The closing delimiter may be followed by +one or more spaces or tabs, which will be ignored. -The value of a variable will be indented to the same level as the -variable. +To include a literal @$@ in the document, use @$$@. -A conditional begins with @$if(variable_name)$@ and ends with @$endif$@. -It may optionally contain an @$else$@ section. The if section is -used if @variable_name@ has a non-null value, otherwise the else section -is used. +== Comments -Conditional keywords should not be indented, or unexpected spacing -problems may occur. +Anything between the sequence @$--@ and the end of the line will be +treated as a comment and omitted from the output. -The @$for$@ keyword can be used to iterate over an array. If -the value of the associated variable is not an array, a single -iteration will be performed on its value. +== Interpolated variables -You may optionally specify separators using @$sep$@, as in the -example above. +A slot for an interpolated variable is a variable name surrounded by +matched delimiters. Variable names must begin with a letter and can +contain letters, numbers, @_@, @-@, and @.@. The keywords @it@, @if@, +@else@, @endif@, @for@, @sep@, and @endfor@ may not be used as variable +names. Examples: --} +> $foo$ +> $foo.bar.baz$ +> $foo_bar.baz-bim$ +> $ foo $ +> ${foo} +> ${foo.bar.baz} +> ${foo_bar.baz-bim} +> ${ foo } -module Text.DocTemplates ( renderTemplate - , applyTemplate - , TemplateTarget(..) - , varListToJSON - , compileTemplate - , Template - ) where +The values of variables are determined by the @Context@ that is passed +as a parameter to @renderTemplate@. So, for example, @title@ will return +the value of the @title@ field, and @employee.salary@ will return the +value of the @salary@ field of the object that is the value of the +@employee@ field. -import Data.Char (isAlphaNum) -import Control.Monad (guard, when) -import Data.Aeson (ToJSON(..), Value(..)) -import qualified Text.Parsec as P -import Text.Parsec.Text (Parser) -import qualified Data.Set as Set -import Data.Monoid -import Control.Applicative -import qualified Data.Text as T -import Data.Text (Text) -import Data.Text.Encoding (encodeUtf8) -import Data.List (intersperse) -import qualified Data.Map as M -import qualified Data.HashMap.Strict as H -import Data.Foldable (toList) -import Text.Blaze.Html (Html) -import Text.Blaze.Internal (preEscapedText) -import Data.ByteString.Lazy (ByteString, fromChunks) -import Data.Vector ((!?)) -import Data.Scientific (floatingOrInteger) +- If the value of the variable is simple value, it will be rendered + verbatim. (Note that no escaping is done; the assumption is that the + calling program will escape the strings appropriately for the output + format.) +- If the value of the variable is a boolean value, it will be rendered + as @true@ if true, or as empty if false. +- If the value is a list, the values will be concatenated. +- If the value is a map, the string @true@ will be rendered. +- Every other value will be rendered as the empty string. --- | A 'Template' is essentially a function that takes --- a JSON 'Value' and produces 'Text'. -newtype Template = Template { unTemplate :: Value -> Text } - deriving Monoid +When a @Context@ is derived from an aeson (JSON) @Value@, the following +conversions are done: -type Variable = [Text] +- If the value is a number, it will be rendered as an integer if + possible, otherwise as a floating-point number. -class TemplateTarget a where - toTarget :: Text -> a +== Conditionals -instance TemplateTarget Text where - toTarget = id +A conditional begins with @if(variable)@ (enclosed in matched +delimiters) and ends with @endif@ (enclosed in matched delimiters). It +may optionally contain an @else@ (enclosed in matched delimiters). The +@if@ section is used if @variable@ has a true value, otherwise the +@else@ section is used (if present). The following values count as true: -instance TemplateTarget String where - toTarget = T.unpack +- any map +- any array containing at least one true value +- any nonempty string (even @false@) +- boolean True -instance TemplateTarget ByteString where - toTarget = fromChunks . (:[]) . encodeUtf8 +Examples: -instance TemplateTarget Html where - toTarget = preEscapedText +> $if(foo)$bar$endif$ +> +> $if(foo)$ +> $foo$ +> $endif$ +> +> $if(foo)$ +> part one +> $else$ +> part two +> $endif$ +> +> ${if(foo)}bar${endif} +> +> ${if(foo)} +> ${foo} +> ${endif} +> +> ${if(foo)} +> ${ foo.bar } +> ${else} +> no foo! +> ${endif} --- | A convenience function for passing in an association --- list of string values instead of a JSON 'Value'. -varListToJSON :: [(String, String)] -> Value -varListToJSON assoc = toJSON $ M.fromList assoc' - where assoc' = [(T.pack k, toVal [T.pack z | (y,z) <- assoc, - not (null z), - y == k]) - | k <- ordNub $ map fst assoc ] - toVal [x] = toJSON x - toVal [] = Null - toVal xs = toJSON xs +The keyword @elseif@ may be used to simplify complex nested +conditionals. Thus --- An efficient specialization of nub. -ordNub :: (Ord a) => [a] -> [a] -ordNub l = go Set.empty l - where - go _ [] = [] - go s (x:xs) = if x `Set.member` s then go s xs - else x : go (Set.insert x s) xs +> $if(foo)$ +> XXX +> $elseif(bar)$ +> YYY +> $else$ +> ZZZ +> $endif$ --- | Compile a template. -compileTemplate :: Text -> Either String Template -compileTemplate template = - case P.parse (pTemplate <* P.eof) "template" template of - Left e -> Left (show e) - Right x -> Right x +is equivalent to --- | Render a compiled template using @context@ to resolve variables. -renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b -renderTemplate (Template f) context = toTarget $ f $ toJSON context +> $if(foo)$ +> XXX +> $else$ +> $if(bar)$ +> YYY +> $else$ +> ZZZ +> $endif$ +> $endif$ --- | Combines `renderTemplate` and `compileTemplate`. -applyTemplate :: (ToJSON a, TemplateTarget b) => Text -> a -> Either String b -applyTemplate t context = - case compileTemplate t of - Left e -> Left e - Right f -> Right $ renderTemplate f context +== For loops -var :: Variable -> Template -var = Template . resolveVar +A for loop begins with @for(variable)@ (enclosed in matched delimiters) +and ends with @endfor@ (enclosed in matched delimiters. -resolveVar :: Variable -> Value -> Text -resolveVar var' val = - case multiLookup var' val of - Just (Array vec) -> maybe mempty (resolveVar []) $ vec !? 0 - Just (String t) -> T.stripEnd t - Just (Number n) -> case floatingOrInteger n of - Left (r :: Double) -> T.pack $ show r - Right (i :: Integer) -> T.pack $ show i - Just (Bool True) -> "true" - Just (Object _) -> "true" - Just _ -> mempty - Nothing -> mempty +- If @variable@ is an array, the material inside the loop will be + evaluated repeatedly, with @variable@ being set to each value of the + array in turn, and concatenated. +- If @variable@ is a map, the material inside will be set to the map. +- If the value of the associated variable is not an array or a map, a + single iteration will be performed on its value. -multiLookup :: [Text] -> Value -> Maybe Value -multiLookup [] x = Just x -multiLookup (v:vs) (Object o) = H.lookup v o >>= multiLookup vs -multiLookup _ _ = Nothing +Examples: -lit :: Text -> Template -lit = Template . const +> $for(foo)$$foo$$sep$, $endfor$ +> +> $for(foo)$ +> - $foo.last$, $foo.first$ +> $endfor$ +> +> ${ for(foo.bar) } +> - ${ foo.bar.last }, ${ foo.bar.first } +> ${ endfor } +> +> $for(mymap)$ +> $it.name$: $it.office$ +> $endfor$ -cond :: Variable -> Template -> Template -> Template -cond var' (Template ifyes) (Template ifno) = Template $ \val -> - case resolveVar var' val of - "" -> ifno val - _ -> ifyes val +You may optionally specify a separator between consecutive values using +@sep@ (enclosed in matched delimiters). The material between @sep@ and +the @endfor@ is the separator. -iter :: Variable -> Template -> Template -> Template -iter var' template sep = Template $ \val -> unTemplate - (case multiLookup var' val of - Just (Array vec) -> mconcat $ intersperse sep - $ map (setVar template var') - $ toList vec - Just x -> cond var' (setVar template var' x) mempty - Nothing -> mempty) val +> ${ for(foo) }${ foo }${ sep }, ${ endfor } -setVar :: Template -> Variable -> Value -> Template -setVar (Template f) var' val = Template $ f . replaceVar var' val +Instead of using @variable@ inside the loop, the special anaphoric +keyword @it@ may be used. -replaceVar :: Variable -> Value -> Value -> Value -replaceVar [] new _ = new -replaceVar (v:vs) new (Object o) = - Object $ H.adjust (\x -> replaceVar vs new x) v o -replaceVar _ _ old = old +> ${ for(foo.bar) } +> - ${ it.last }, ${ it.first } +> ${ endfor } ---- parsing +== Partials -pTemplate :: Parser Template -pTemplate = do - sp <- P.option mempty pInitialSpace - rest <- mconcat <$> many (pConditional <|> - pFor <|> - pNewline <|> - pVar <|> - pLit <|> - pEscapedDollar) - return $ sp <> rest +Partials (subtemplates stored in different files) may be included using +the syntax -takeWhile1 :: (Char -> Bool) -> Parser Text -takeWhile1 f = T.pack <$> P.many1 (P.satisfy f) +> ${ boilerplate() } -pLit :: Parser Template -pLit = lit <$> takeWhile1 (\x -> x /='$' && x /= '\n') +The partials are obtained using @getPartial@ from the @TemplateMonad@ +class. This may be implemented differently in different monads. The path +passed to @getPartial@ is computed on the basis of the original template +path (a parameter to @compileTemplate@) and the partial’s name. The +partial’s name is substituted for the /base name/ of the original +template path (leaving the original template’s extension), unless the +partial has an explicit extension, in which case this is kept. So, with +the @TemplateMonad@ instance for IO, partials will be sought in the +directory containing the main template, and will be assumed to have the +extension of the main template. -pNewline :: Parser Template -pNewline = do - P.char '\n' - sp <- P.option mempty pInitialSpace - return $ lit "\n" <> sp +Partials may optionally be applied to variables using a colon: -pInitialSpace :: Parser Template -pInitialSpace = do - sps <- takeWhile1 (==' ') - let indentVar = if T.null sps - then id - else indent (T.length sps) - v <- P.option mempty $ indentVar <$> pVar - return $ lit sps <> v +> ${ date:fancy() } +> +> ${ articles:bibentry() } -pEscapedDollar :: Parser Template -pEscapedDollar = lit "$" <$ P.try (P.string "$$") +If @articles@ is an array, this will iterate over its values, applying +the partial @bibentry()@ to each one. So the second example above is +equivalent to -pVar :: Parser Template -pVar = var <$> (P.try $ P.char '$' *> pIdent <* P.char '$') +> ${ for(articles) } +> ${ it:bibentry() } +> ${ endfor } -pIdent :: Parser [Text] -pIdent = do - first <- pIdentPart - rest <- many (P.char '.' *> pIdentPart) - return (first:rest) +Note that the anaphoric keyword @it@ must be used when iterating over +partials. In the above examples, the @bibentry@ partial should contain +@it.title@ (and so on) instead of @articles.title@. -pIdentPart :: Parser Text -pIdentPart = P.try $ do - first <- P.letter - rest <- T.pack <$> P.many (P.satisfy (\c -> isAlphaNum c || c == '_' || c == '-')) - let id' = T.singleton first <> rest - guard $ id' `notElem` reservedWords - return id' +Final newlines are omitted from included partials. -reservedWords :: [Text] -reservedWords = ["else","endif","for","endfor","sep"] +Partials may include other partials. If you exceed a nesting level of +50, though, in resolving partials, the literal @(loop)@ will be +returned, to avoid infinite loops. -skipEndline :: Parser () -skipEndline = P.try $ P.skipMany (P.satisfy (`elem` (" \t" :: String))) >> P.char '\n' >> return () +A separator between values of an array may be specified in square +brackets, immediately after the variable name or partial: -pConditional :: Parser Template -pConditional = do - P.try $ P.string "$if(" - id' <- pIdent - P.string ")$" - -- if newline after the "if", then a newline after "endif" will be swallowed - multiline <- P.option False (True <$ skipEndline) - ifContents <- pTemplate - elseContents <- P.option mempty $ P.try $ - do P.string "$else$" - when multiline $ P.option () skipEndline - pTemplate - P.string "$endif$" - when multiline $ P.option () skipEndline - return $ cond id' ifContents elseContents +> ${months[, ]}$ +> +> ${articles:bibentry()[; ]$ -pFor :: Parser Template -pFor = do - P.try $ P.string "$for(" - id' <- pIdent - P.string ")$" - -- if newline after the "for", then a newline after "endfor" will be swallowed - multiline <- P.option False $ skipEndline >> return True - contents <- pTemplate - sep <- P.option mempty $ - do P.try $ P.string "$sep$" - when multiline $ P.option () skipEndline - pTemplate - P.string "$endfor$" - when multiline $ P.option () skipEndline - return $ iter id' contents sep +The separator in this case is literal and (unlike with @sep@ in an +explicit @for@ loop) cannot contain interpolated variables or other +template directives. -indent :: Int -> Template -> Template -indent 0 x = x -indent ind (Template f) = Template $ \val -> indent' (f val) - where indent' t = T.concat - $ intersperse ("\n" <> T.replicate ind " ") $ T.lines t +== Nesting + +To ensure that content is “nested,” that is, subsequent lines indented, +use the @^@ directive: + +> $item.number$ $^$$item.description$ ($item.price$) + +In this example, if @item.description@ has multiple lines, they will all +be indented to line up with the first line: + +> 00123 A fine bottle of 18-year old +> Oban whiskey. ($148) + +To nest multiple lines to the same level, align them with the @^@ +directive in the template. For example: + +> $item.number$ $^$$item.description$ ($item.price$) +> (Available til $item.sellby$.) + +will produce + +> 00123 A fine bottle of 18-year old +> Oban whiskey. ($148) +> (Available til March 30, 2020.) + +If a variable occurs by itself on a line, preceded by whitespace and not +followed by further text or directives on the same line, and the +variable’s value contains multiple lines, it will be nested +automatically. + +== Breakable spaces + +When rendering to a @Doc@, a distinction can be made between breakable +and unbreakable spaces. Normally, spaces in the template itself (as +opposed to values of the interpolated variables) are not breakable, but +they can be made breakable in part of the template by using the @~@ +keyword (ended with another @~@). + +> $~$This long line may break if the document is rendered +> with a short line length.$~$ + +The @~@ keyword has no effect when rendering to @Text@ or @String@. + +== Pipes + +A pipe transforms the value of a variable or partial. Pipes are +specified using a slash (@\/@) between the variable name (or partial) +and the pipe name. Example: + +> $for(name)$ +> $name/uppercase$ +> $endfor$ +> +> $for(metadata/pairs)$ +> - $it.key$: $it.value$ +> $endfor$ +> +> $employee:name()/uppercase$ + +Pipes may be chained: + +> $for(employees/pairs)$ +> $it.key/alpha/uppercase$. $it.name$ +> $endfor$ + +Some pipes take parameters: + +> |----------------------|------------| +> $for(employee)$ +> $it.name.first/uppercase/left 20 "| "$$it.name.salary/right 10 " | " " |"$ +> $endfor$ +> |----------------------|------------| + +Currently the following pipes are predefined: + +- @pairs@: Converts a map or array to an array of maps, each with + @key@ and @value@ fields. If the original value was an array, the + @key@ will be the array index, starting with 1. + +- @first@: Returns the first value of an array, if applied to a + non-empty array; otherwise returns the original value. + +- @last@: Returns the last value of an array, if applied to a + non-empty array; otherwise returns the original value. + +- @rest@: Returns all but the first value of an array, if applied to a + non-empty array; otherwise returns the original value. + +- @allbutlast@: Returns all but the last value of an array, if applied + to a non-empty array; otherwise returns the original value. + +- @uppercase@: Converts text to uppercase. + +- @lowercase@: Converts text to lowercase. + +- @length@: Returns the length of the value: number of characters for + a textual value, number of elements for a map or array. + +- @reverse@: Reverses a textual value or array, and has no effect on + other values. + +- @chomp@: Removes trailing newlines (and breakable space). + +- @nowrap@: Disables line wrapping on breakable spaces. + +- @alpha@: Converts textual values that can be read as an integer into + lowercase alphabetic characters @a..z@ (mod 26). This can be used to + get lettered enumeration from array indices. To get uppercase + letters, chain with @uppercase@. + +- @roman@: Converts textual values that can be read as an integer into + lowercase roman numerials. This can be used to get lettered + enumeration from array indices. To get uppercase roman, chain with + @uppercase@. + +- @left n \"leftborder\" \"rightborder\"@: Renders a textual value in + a block of width @n@, aligned to the left, with an optional left and + right border. Has no effect on other values. This can be used to + align material in tables. Widths are positive integers indicating + the number of characters. Borders are strings inside double quotes; + literal @\"@ and @\\@ characters must be backslash-escaped. + +- @right n \"leftborder\" \"rightborder\"@: Renders a textual value in + a block of width @n@, aligned to the right, and has no effect on + other values. + +- @center n \"leftborder\" \"rightborder\"@: Renders a textual value + in a block of width @n@, aligned to the center, and has no effect on + other values. + +-} + +module Text.DocTemplates ( renderTemplate + , compileTemplate + , compileTemplateFile + , applyTemplate + , TemplateMonad(..) + , TemplateTarget + , Context(..) + , Val(..) + , ToContext(..) + , FromContext(..) + , Template -- export opaque type + , Doc(..) + ) where + +import qualified Data.Text.IO as TIO +import Text.DocLayout (Doc(..)) +import Data.Text (Text) +import Text.DocTemplates.Parser (compileTemplate) +import Text.DocTemplates.Internal ( TemplateMonad(..), Context(..), + Val(..), ToContext(..), FromContext(..), TemplateTarget, + Template, renderTemplate ) + +-- | Compile a template from a file. IO errors will be +-- raised as exceptions; template parsing errors result in +-- Left return values. +compileTemplateFile :: TemplateTarget a + => FilePath -> IO (Either String (Template a)) +compileTemplateFile templPath = do + templateText <- TIO.readFile templPath + compileTemplate templPath templateText + +-- | Compile a template and apply it to a context. This is +-- just a convenience function composing 'compileTemplate' +-- and 'renderTemplate'. If a template will be rendered +-- more than once in the same process, compile it separately +-- for better performance. +applyTemplate :: (TemplateMonad m, TemplateTarget a, ToContext a b) + => FilePath -> Text -> b -> m (Either String (Doc a)) +applyTemplate fp t val = do + res <- compileTemplate fp t + case res of + Left s -> return $ Left s + Right t' -> return $ Right $ renderTemplate t' val + diff --git a/src/Text/DocTemplates/Internal.hs b/src/Text/DocTemplates/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Text/DocTemplates/Internal.hs @@ -0,0 +1,469 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} + +{- | + Module : Text.DocTemplates.Internal + Copyright : Copyright (C) 2009-2019 John MacFarlane + License : BSD3 + + Maintainer : John MacFarlane + Stability : alpha + Portability : portable +-} + +module Text.DocTemplates.Internal + ( renderTemplate + , TemplateMonad(..) + , Context(..) + , Val(..) + , ToContext(..) + , FromContext(..) + , TemplateTarget + , Template(..) + , Variable(..) + , Pipe(..) + , Alignment(..) + , Border(..) + ) where + +import Data.Text.Conversions (FromText(..), ToText(..)) +import Data.Aeson (Value(..), ToJSON(..), FromJSON(..), Result(..), fromJSON) +import Control.Monad.Identity +import qualified Control.Monad.State.Strict as S +import Data.Char (chr, ord) +import Data.Maybe (fromMaybe) +import qualified Data.Text.Read as T +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import Text.DocLayout (Doc, HasChars) +import qualified Text.DocLayout as DL +import Data.String (IsString(..)) +import Data.Data (Data) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Data.Text (Text) +import qualified Data.Map as M +import qualified Data.Vector as V +import Data.Scientific (floatingOrInteger) +import Data.List (intersperse) +#if MIN_VERSION_base(4,11,0) +#else +import Data.Semigroup +#endif + +-- | A template. +data Template a = + Interpolate Variable + | Conditional Variable (Template a) (Template a) + | Iterate Variable (Template a) (Template a) + | Nested (Template a) + | Partial [Pipe] (Template a) + | Literal (Doc a) + | Concat (Template a) (Template a) + | Empty + deriving (Show, Read, Data, Typeable, Generic, Eq, Ord, + Foldable, Traversable, Functor) + +instance Semigroup a => Semigroup (Template a) where + x <> Empty = x + Empty <> x = x + x <> y = Concat x y + +instance Semigroup a => Monoid (Template a) where + mappend = (<>) + mempty = Empty + +data Pipe = + ToPairs + | ToUppercase + | ToLowercase + | ToLength + | Reverse + | FirstItem + | LastItem + | Rest + | AllButLast + | Chomp + | ToAlpha + | ToRoman + | NoWrap + | Block Alignment Int Border + deriving (Show, Read, Data, Typeable, Generic, Eq, Ord) + +data Alignment = + LeftAligned + | Centered + | RightAligned + deriving (Show, Read, Data, Typeable, Generic, Eq, Ord) + +data Border = Border + { borderLeft :: Text + , borderRight :: Text + } + deriving (Show, Read, Data, Typeable, Generic, Eq, Ord) + +-- | A variable which may have several parts (@foo.bar.baz@). +data Variable = + Variable + { varParts :: [Text] + , varPipes :: [Pipe] + } + deriving (Show, Read, Data, Typeable, Generic, Eq, Ord) + +instance Semigroup Variable where + Variable xs fs <> Variable ys gs = Variable (xs <> ys) (fs <> gs) + +instance Monoid Variable where + mempty = Variable mempty mempty + mappend = (<>) + +type TemplateTarget a = + (HasChars a, ToText a, FromText a) + +-- | A 'Context' defines values for template's variables. +newtype Context a = Context { unContext :: M.Map Text (Val a) } + deriving (Show, Semigroup, Monoid, Traversable, Foldable, Functor, + Data, Typeable) + +-- | A variable value. +data Val a = + SimpleVal (Doc a) + | ListVal [Val a] + | MapVal (Context a) + | BoolVal Bool + | NullVal + deriving (Show, Traversable, Foldable, Functor, Data, Typeable) + +-- | The 'ToContext' class provides automatic conversion to +-- a 'Context' or 'Val'. +class ToContext a b where + toContext :: b -> Context a + toContext x = case toVal x of + MapVal c -> c + _ -> mempty + toVal :: b -> Val a + +instance ToContext a (Context a) where + toContext = id + toVal = MapVal + +instance ToContext a (Val a) where + toVal = id + +instance TemplateTarget a => ToContext a a where + toVal = SimpleVal . DL.literal + +instance ToContext a a => ToContext a (Doc a) where + toVal = SimpleVal + +instance ToContext a b => ToContext a [b] where + toVal = ListVal . map toVal + +instance {-# OVERLAPPING #-} TemplateTarget [a] => ToContext [a] [a] where + toVal = SimpleVal . DL.literal + +instance ToContext a b => ToContext a (M.Map Text b) where + toVal = MapVal . toContext + toContext = Context . M.map toVal + +instance TemplateTarget a => ToContext a Bool where + toVal True = BoolVal True + toVal False = BoolVal False + +instance TemplateTarget a => ToContext a Value where + toContext x = case fromJSON x of + Success y -> y + Error _ -> mempty + toVal x = case fromJSON x of + Success y -> y + Error _ -> NullVal + +-- | The 'FromContext' class provides functions for extracting +-- values from 'Val' and 'Context'. +class FromContext a b where + fromVal :: Val a -> Maybe b + lookupContext :: Text -> Context a -> Maybe b + lookupContext t (Context m) = M.lookup t m >>= fromVal + +instance TemplateTarget a => FromContext a (Val a) where + fromVal = Just + +instance TemplateTarget a => FromContext a (Doc a) where + fromVal (SimpleVal x) = Just x + fromVal _ = Nothing + +instance TemplateTarget a => FromContext a a where + fromVal (SimpleVal x) = Just (DL.render Nothing x) + fromVal _ = Nothing + +instance {-# OVERLAPPING #-} TemplateTarget [a] => FromContext [a] [a] where + fromVal (SimpleVal x) = Just (DL.render Nothing x) + fromVal _ = Nothing + +instance FromContext a b => FromContext a [b] where + fromVal (ListVal xs) = mapM fromVal xs + fromVal x = sequence [fromVal x] + +instance TemplateTarget a => FromJSON (Val a) where + parseJSON v = + case v of + Array vec -> ListVal <$> mapM parseJSON (V.toList vec) + String t -> return $ SimpleVal $ DL.literal $ fromText t + Number n -> return $ SimpleVal $ fromString $ + case floatingOrInteger n of + Left (r :: Double) -> show r + Right (i :: Integer) -> show i + Bool b -> return $ BoolVal b + Object _ -> MapVal . Context <$> parseJSON v + _ -> return NullVal + +instance TemplateTarget a => FromJSON (Context a) where + parseJSON v = do + val <- parseJSON v + case val of + MapVal o -> return o + _ -> fail "Expecting MapVal" + +instance TemplateTarget a => ToJSON (Context a) where + toJSON (Context m) = toJSON m + +instance TemplateTarget a => ToJSON (Val a) where + toJSON NullVal = Null + toJSON (MapVal m) = toJSON m + toJSON (ListVal xs) = toJSON xs + toJSON (SimpleVal d) = toJSON $ toText $ DL.render Nothing d + toJSON (BoolVal b) = toJSON b + +mapDoc :: TemplateTarget a => (Doc a -> Doc a) -> Val a -> Val a +mapDoc f val = + case val of + SimpleVal d -> SimpleVal (f d) + MapVal (Context m) -> MapVal (Context $ M.map (mapDoc f) m) + ListVal xs -> ListVal $ map (mapDoc f) xs + BoolVal b -> BoolVal b + NullVal -> NullVal + +mapText :: TemplateTarget a => (Text -> Text) -> Val a -> Val a +mapText f val = + runIdentity (traverse (return . fromText . f . toText) val) + +applyPipe :: TemplateTarget a => Pipe -> Val a -> Val a +applyPipe ToLength val = SimpleVal $ fromString . show $ len + where + len = case val of + SimpleVal d -> T.length . toText $ DL.render Nothing d + MapVal (Context m) -> M.size m + ListVal xs -> length xs + BoolVal _ -> 0 + NullVal -> 0 +applyPipe ToUppercase val = mapText T.toUpper val +applyPipe ToLowercase val = mapText T.toLower val +applyPipe ToPairs val = + case val of + MapVal (Context m) -> + ListVal $ map toPair $ M.toList m + ListVal xs -> + ListVal $ map toPair $ zip (map (fromString . show) [(1::Int)..]) xs + _ -> val + where + toPair (k, v) = MapVal $ Context $ M.fromList + [ ("key", SimpleVal $ fromString . T.unpack $ k) + , ("value", v) ] +applyPipe FirstItem val = + case val of + ListVal (x:_) -> x + _ -> val +applyPipe LastItem val = + case val of + ListVal xs@(_:_) -> last xs + _ -> val +applyPipe Rest val = + case val of + ListVal (_:xs) -> ListVal xs + _ -> val +applyPipe AllButLast val = + case val of + ListVal xs@(_:_) -> ListVal (init xs) + _ -> val +applyPipe Reverse val = + case val of + ListVal xs -> ListVal (reverse xs) + SimpleVal{} -> mapText T.reverse val + _ -> val +applyPipe Chomp val = mapDoc DL.chomp val +applyPipe ToAlpha val = mapText toAlpha val + where toAlpha t = + case T.decimal t of + Right (y,"") -> fromString [chr (ord 'a' + (y `mod` 26) - 1)] + _ -> t +applyPipe ToRoman val = mapText toRoman' val + where toRoman' t = + case T.decimal t of + Right (y,"") -> fromMaybe t (toRoman y) + _ -> t +applyPipe NoWrap val = mapDoc DL.nowrap val +applyPipe (Block align n border) val = + let constructor = case align of + LeftAligned -> DL.lblock + Centered -> DL.cblock + RightAligned -> DL.rblock + toBorder y = if T.null y + then mempty + else DL.vfill (fromText y) + in case nullToSimple val of + SimpleVal d -> SimpleVal $ + toBorder (borderLeft border) <> + constructor n d <> + toBorder (borderRight border) + _ -> val + +nullToSimple :: Monoid a => Val a -> Val a +nullToSimple NullVal = SimpleVal mempty +nullToSimple x = x + +-- | Convert number 0 < x < 4000 to lowercase roman numeral. +toRoman :: Int -> Maybe Text +toRoman x + | x >= 1000 + , x < 4000 = ("m" <>) <$> toRoman (x - 1000) + | x >= 900 = ("cm" <>) <$> toRoman (x - 900) + | x >= 500 = ("d" <>) <$> toRoman (x - 500) + | x >= 400 = ("cd" <>) <$> toRoman (x - 400) + | x >= 100 = ("c" <>) <$> toRoman (x - 100) + | x >= 90 = ("xc" <>) <$> toRoman (x - 90) + | x >= 50 = ("l" <>) <$> toRoman (x - 50) + | x >= 40 = ("xl" <>) <$> toRoman (x - 40) + | x >= 10 = ("x" <>) <$> toRoman (x - 10) + | x == 9 = return "ix" + | x >= 5 = ("v" <>) <$> toRoman (x - 5) + | x == 4 = return "iv" + | x >= 1 = ("i" <>) <$> toRoman (x - 1) + | x == 0 = return "" + | otherwise = Nothing + +applyPipes :: TemplateTarget a => [Pipe] -> Val a -> Val a +applyPipes fs x = foldr applyPipe x $ reverse fs + +multiLookup :: TemplateTarget a => [Text] -> Val a -> Val a +multiLookup [] x = x +multiLookup (t:vs) (MapVal (Context o)) = + case M.lookup t o of + Nothing -> NullVal + Just v' -> multiLookup vs v' +multiLookup _ _ = NullVal + +-- The Bool indicates whether it's a true or false value. +data Resolved a = Resolved Bool [Doc a] + deriving (Show, Read, Data, Typeable, Generic, Eq, Ord, + Foldable, Traversable, Functor) + +instance Semigroup (Resolved a) where + Resolved b1 x1 <> Resolved b2 x2 = Resolved (b1 || b2) (x1 <> x2) + +instance Monoid (Resolved a) where + mappend = (<>) + mempty = Resolved False [] + +resolveVariable :: TemplateTarget a + => Variable -> Context a -> Resolved a +resolveVariable v ctx = resolveVariable' v (MapVal ctx) + +resolveVariable' :: TemplateTarget a + => Variable -> Val a -> Resolved a +resolveVariable' v val = + case applyPipes (varPipes v) $ multiLookup (varParts v) val of + ListVal xs -> mconcat $ map (resolveVariable' mempty) xs + SimpleVal d + | DL.isEmpty d -> Resolved False [] + | otherwise -> Resolved True [removeFinalNl d] + MapVal _ -> Resolved True ["true"] + BoolVal True -> Resolved True ["true"] + BoolVal False -> Resolved False ["false"] + NullVal -> Resolved False [] + +removeFinalNl :: Doc a -> Doc a +removeFinalNl DL.NewLine = mempty +removeFinalNl DL.CarriageReturn = mempty +removeFinalNl (DL.Concat d1 d2) = d1 <> removeFinalNl d2 +removeFinalNl x = x + +withVariable :: (Monad m, TemplateTarget a) + => Variable -> Context a -> (Context a -> m (Doc a)) + -> m [Doc a] +withVariable var ctx f = + case applyPipes (varPipes var) $ multiLookup (varParts var) (MapVal ctx) of + NullVal -> return mempty + ListVal xs -> mapM (\iterval -> f $ setVarVal iterval) xs + MapVal ctx' -> (:[]) <$> f (setVarVal (MapVal ctx')) + val' -> (:[]) <$> f (setVarVal val') + where + setVarVal x = + addToContext var x $ Context $ M.insert "it" x $ unContext ctx + addToContext (Variable [] _) _ (Context ctx') = Context ctx' + addToContext (Variable (v:vs) fs) x (Context ctx') = + Context $ M.adjust + (\z -> case z of + _ | null vs -> x + MapVal m -> + MapVal $ addToContext (Variable vs fs) x m + _ -> z) v ctx' + +type RenderState = S.State Int + +-- | Render a compiled template in a "context" which provides +-- values for the template's variables. +renderTemplate :: (TemplateTarget a, ToContext a b) + => Template a -> b -> Doc a +renderTemplate t x = S.evalState (renderTemp t (toContext x)) 0 + +updateColumn :: TemplateTarget a => Doc a -> RenderState (Doc a) +updateColumn x = do + S.modify $ DL.updateColumn x + return x + +renderTemp :: forall a . TemplateTarget a + => Template a -> Context a -> RenderState (Doc a) +renderTemp (Literal t) _ = updateColumn t +renderTemp (Interpolate v) ctx = + case resolveVariable v ctx of + Resolved _ xs -> updateColumn (mconcat xs) +renderTemp (Conditional v ift elset) ctx = + case resolveVariable v ctx of + Resolved False _ -> renderTemp elset ctx + Resolved True _ -> renderTemp ift ctx +renderTemp (Iterate v t sep) ctx = do + xs <- withVariable v ctx (renderTemp t) + sep' <- renderTemp sep ctx + return . mconcat . intersperse sep' $ xs +renderTemp (Nested t) ctx = do + n <- S.get + DL.nest n <$> renderTemp t ctx +renderTemp (Partial fs t) ctx = do + val' <- renderTemp t ctx + return $ case applyPipes fs (SimpleVal val') of + SimpleVal x -> x + _ -> mempty +renderTemp (Concat t1 t2) ctx = + mappend <$> renderTemp t1 ctx <*> renderTemp t2 ctx +renderTemp Empty _ = return mempty + +-- | A 'TemplateMonad' defines a function to retrieve a partial +-- (from the file system, from a database, or using a default +-- value). +class Monad m => TemplateMonad m where + getPartial :: FilePath -> m Text + +instance TemplateMonad Identity where + getPartial _ = return mempty + +instance TemplateMonad IO where + getPartial = TIO.readFile diff --git a/src/Text/DocTemplates/Parser.hs b/src/Text/DocTemplates/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Text/DocTemplates/Parser.hs @@ -0,0 +1,441 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Text.DocTemplates.Parser + Copyright : Copyright (C) 2009-2019 John MacFarlane + License : BSD3 + + Maintainer : John MacFarlane + Stability : alpha + Portability : portable +-} + +module Text.DocTemplates.Parser + ( compileTemplate ) where + +import Data.Char (isAlphaNum) +import Control.Monad (guard, when) +import Control.Monad.Trans (lift) +import qualified Text.Parsec as P +import qualified Text.Parsec.Pos as P +import Control.Applicative +import Data.String (IsString(..)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Read as T +import System.FilePath +import Text.DocTemplates.Internal +import qualified Text.DocLayout as DL +#if MIN_VERSION_base(4,11,0) +#else +import Data.Semigroup ((<>), Semigroup) +#endif + +-- | Compile a template. The FilePath parameter is used +-- to determine a default path and extension for partials +-- and may be left empty if partials are not used. +compileTemplate :: (TemplateMonad m, TemplateTarget a) + => FilePath -> Text -> m (Either String (Template a)) +compileTemplate templPath template = do + res <- P.runParserT (pTemplate <* P.eof) + PState{ templatePath = templPath + , partialNesting = 1 + , breakingSpaces = False + , firstNonspace = P.initialPos templPath + , nestedCol = Nothing + , insideDirective = False + } templPath template + case res of + Left e -> return $ Left $ show e + Right x -> return $ Right x + + +data PState = + PState { templatePath :: FilePath + , partialNesting :: !Int + , breakingSpaces :: !Bool + , firstNonspace :: P.SourcePos + , nestedCol :: Maybe Int + , insideDirective :: Bool + } + +type Parser = P.ParsecT Text PState + +pTemplate :: (TemplateMonad m, TemplateTarget a) => Parser m (Template a) +pTemplate = do + P.skipMany pComment + mconcat <$> many + ((pLit <|> pNewline <|> pDirective <|> + pEscape) <* P.skipMany pComment) + +pEndline :: Monad m => Parser m String +pEndline = P.try $ do + nls <- pLineEnding + mbNested <- nestedCol <$> P.getState + inside <- insideDirective <$> P.getState + case mbNested of + Just col -> do + P.skipMany $ do + P.getPosition >>= guard . (< col) . P.sourceColumn + P.char ' ' <|> P.char '\t' + curcol <- P.sourceColumn <$> P.getPosition + guard $ inside || curcol >= col + Nothing -> return () + return nls + +pBlankLine :: (TemplateTarget a, Monad m) => Parser m (Template a) +pBlankLine = + P.try $ Literal . fromString <$> pLineEnding <* P.lookAhead pNewlineOrEof + +pNewline :: (TemplateTarget a, Monad m) => Parser m (Template a) +pNewline = P.try $ do + nls <- pEndline + sps <- P.many (P.char ' ' <|> P.char '\t') + breakspaces <- breakingSpaces <$> P.getState + pos <- P.getPosition + P.updateState $ \st -> st{ firstNonspace = pos } + return $ Literal $ + if breakspaces + then DL.BreakingSpace + else fromString $ nls <> sps + +pLit :: (TemplateTarget a, Monad m) => Parser m (Template a) +pLit = do + cs <- P.many1 (P.satisfy (\c -> c /= '$' && c /= '\n' && c /= '\r')) + when (all (\c -> c == ' ' || c == '\t') cs) $ do + pos <- P.getPosition + when (P.sourceLine pos == 1) $ + P.updateState $ \st -> st{ firstNonspace = pos } + breakspaces <- breakingSpaces <$> P.getState + if breakspaces + then return $ toBreakable cs + else return $ Literal $ fromString cs + +toBreakable :: TemplateTarget a => String -> Template a +toBreakable [] = Empty +toBreakable xs = + case break isSpacy xs of + ([], []) -> Empty + ([], zs) -> Literal DL.BreakingSpace <> + toBreakable (dropWhile isSpacy zs) + (ys, []) -> Literal (fromString ys) + (ys, zs) -> Literal (fromString ys) <> toBreakable zs + +isSpacy :: Char -> Bool +isSpacy ' ' = True +isSpacy '\n' = True +isSpacy '\r' = True +isSpacy '\t' = True +isSpacy _ = False + +backupSourcePos :: Monad m => Int -> Parser m () +backupSourcePos n = do + pos <- P.getPosition + P.setPosition $ P.incSourceColumn pos (- n) + +pEscape :: (TemplateTarget a, Monad m) => Parser m (Template a) +pEscape = Literal "$" <$ P.try (P.string "$$" <* backupSourcePos 1) + +pDirective :: (TemplateTarget a, TemplateMonad m) + => Parser m (Template a) +pDirective = + pConditional <|> pForLoop <|> pReflowToggle <|> pNested <|> + pInterpolate <|> pBarePartial + +pEnclosed :: Monad m => Parser m a -> Parser m a +pEnclosed parser = P.try $ do + closer <- pOpen + P.skipMany pSpaceOrTab + result <- parser + P.skipMany pSpaceOrTab + closer + return result + +pParens :: Monad m => Parser m a -> Parser m a +pParens parser = do + P.char '(' + result <- parser + P.char ')' + return result + +pInside :: Monad m + => Parser m (Template a) + -> Parser m (Template a) +pInside parser = do + oldInside <- insideDirective <$> P.getState + P.updateState $ \st -> st{ insideDirective = True } + res <- parser + P.updateState $ \st -> st{ insideDirective = oldInside } + return res + +pConditional :: (TemplateTarget a, TemplateMonad m) + => Parser m (Template a) +pConditional = do + v <- pEnclosed $ P.try $ P.string "if" *> pParens pVar + pInside $ do + multiline <- P.option False (True <$ skipEndline) + -- if newline after the "if", then a newline after "endif" will be swallowed + ifContents <- pTemplate + elseContents <- P.option mempty (pElse multiline <|> pElseIf) + pEnclosed (P.string "endif") + when multiline $ P.option () skipEndline + return $ Conditional v ifContents elseContents + +pElse :: (TemplateTarget a, TemplateMonad m) + => Bool -> Parser m (Template a) +pElse multiline = do + pEnclosed (P.string "else") + when multiline $ P.option () skipEndline + pTemplate + +pElseIf :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a) +pElseIf = do + v <- pEnclosed $ P.try $ P.string "elseif" *> pParens pVar + multiline <- P.option False (True <$ skipEndline) + ifContents <- pTemplate + elseContents <- P.option mempty (pElse multiline <|> pElseIf) + return $ Conditional v ifContents elseContents + +skipEndline :: Monad m => Parser m () +skipEndline = do + pEndline + pos <- P.lookAhead $ do + P.skipMany (P.char ' ' <|> P.char '\t') + P.getPosition + P.updateState $ \st -> st{ firstNonspace = pos } + +pReflowToggle :: (Monoid a, Semigroup a, TemplateMonad m) + => Parser m (Template a) +pReflowToggle = do + pEnclosed $ P.char '~' + P.modifyState $ \st -> st{ breakingSpaces = not (breakingSpaces st) } + return mempty + +pNested :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a) +pNested = do + col <- P.sourceColumn <$> P.getPosition + pEnclosed $ P.char '^' + oldNested <- nestedCol <$> P.getState + P.updateState $ \st -> st{ nestedCol = Just col } + x <- pTemplate + xs <- P.many $ P.try $ do + y <- mconcat <$> P.many1 pBlankLine + z <- pTemplate + return (y <> z) + let contents = x <> mconcat xs + P.updateState $ \st -> st{ nestedCol = oldNested } + return $ Nested contents + +pForLoop :: (TemplateTarget a, TemplateMonad m) => Parser m (Template a) +pForLoop = do + v <- pEnclosed $ P.try $ P.string "for" *> pParens pVar + -- if newline after the "for", then a newline after "endfor" will be swallowed + pInside $ do + multiline <- P.option False $ skipEndline >> return True + contents <- pTemplate + sep <- P.option mempty $ + do pEnclosed (P.string "sep") + when multiline $ P.option () skipEndline + pTemplate + pEnclosed (P.string "endfor") + when multiline $ P.option () skipEndline + return $ Iterate v contents sep + +pInterpolate :: (TemplateTarget a, TemplateMonad m) + => Parser m (Template a) +pInterpolate = do + pos <- P.getPosition + -- we don't used pEnclosed here, to get better error messages: + (closer, var) <- P.try $ do + cl <- pOpen + P.skipMany pSpaceOrTab + v <- pVar + P.notFollowedBy (P.char '(') -- bare partial + return (cl, v) + res <- (P.char ':' *> (pPartialName >>= pPartial (Just var))) + <|> Iterate var (Interpolate (Variable ["it"] [])) <$> pSep + <|> return (Interpolate var) + P.skipMany pSpaceOrTab + closer + handleNesting False pos res + +pLineEnding :: Monad m => Parser m String +pLineEnding = P.string "\n" <|> P.try (P.string "\r\n") <|> P.string "\r" + +pNewlineOrEof :: Monad m => Parser m () +pNewlineOrEof = () <$ pLineEnding <|> P.eof + +handleNesting :: TemplateMonad m + => Bool -> P.SourcePos -> Template a -> Parser m (Template a) +handleNesting eatEndline pos templ = do + firstNonspacePos <- firstNonspace <$> P.getState + let beginline = firstNonspacePos == pos + endofline <- (True <$ P.lookAhead pNewlineOrEof) <|> pure False + when (eatEndline && beginline) $ P.optional skipEndline + mbNested <- nestedCol <$> P.getState + let toNested t@(Nested{}) = t + toNested t = case P.sourceColumn pos of + 1 -> t + n | Just n == mbNested -> t + | otherwise -> Nested t + return $ if beginline && endofline + then toNested templ + else templ + +pBarePartial :: (TemplateTarget a, TemplateMonad m) + => Parser m (Template a) +pBarePartial = do + pos <- P.getPosition + (closer, fp) <- P.try $ do + closer <- pOpen + P.skipMany pSpaceOrTab + fp <- pPartialName + return (closer, fp) + res <- pPartial Nothing fp + P.skipMany pSpaceOrTab + closer + handleNesting True pos res + +pPartialName :: TemplateMonad m + => Parser m FilePath +pPartialName = P.try $ do + fp <- P.many1 (P.alphaNum <|> P.oneOf ['_','-','.','/','\\']) + P.string "()" + return fp + +pPartial :: (TemplateTarget a, TemplateMonad m) + => Maybe Variable -> FilePath -> Parser m (Template a) +pPartial mbvar fp = do + oldst <- P.getState + separ <- P.option mempty pSep + tp <- templatePath <$> P.getState + let fp' = case takeExtension fp of + "" -> replaceBaseName tp fp + _ -> replaceFileName tp fp + partial <- lift $ removeFinalNewline <$> getPartial fp' + nesting <- partialNesting <$> P.getState + t <- if nesting > 50 + then return $ Literal "(loop)" + else do + oldInput <- P.getInput + oldPos <- P.getPosition + P.setPosition $ P.initialPos fp' + P.setInput partial + P.updateState $ \st -> st{ partialNesting = nesting + 1 } + P.updateState $ \st -> st{ nestedCol = Nothing } + res' <- pTemplate <* P.eof + P.updateState $ \st -> st{ partialNesting = nesting } + P.setInput oldInput + P.setPosition oldPos + return res' + P.putState oldst + fs <- many pPipe + case mbvar of + Just var -> return $ Iterate var (Partial fs t) separ + Nothing -> return $ Partial fs t + +removeFinalNewline :: Text -> Text +removeFinalNewline t = + case T.unsnoc t of + Just (t', '\n') -> t' + _ -> t + +pSep :: (TemplateTarget a, Monad m) => Parser m (Template a) +pSep = do + P.char '[' + xs <- P.many (P.satisfy (/= ']')) + P.char ']' + return $ Literal (fromString xs) + +pSpaceOrTab :: Monad m => Parser m Char +pSpaceOrTab = P.satisfy (\c -> c == ' ' || c == '\t') + +pComment :: Monad m => Parser m () +pComment = do + pos <- P.getPosition + P.try (P.string "$--") + P.skipMany (P.satisfy (/='\n')) + -- If the comment begins in the first column, the line ending + -- will be consumed; otherwise not. + when (P.sourceColumn pos == 1) $ () <$ pNewlineOrEof + +pOpenDollar :: Monad m => Parser m (Parser m ()) +pOpenDollar = + pCloseDollar <$ P.try (P.char '$' <* + P.notFollowedBy (P.char '$' <|> P.char '{')) + where + pCloseDollar = () <$ P.char '$' + +pOpenBraces :: Monad m => Parser m (Parser m ()) +pOpenBraces = + pCloseBraces <$ P.try (P.string "${" <* P.notFollowedBy (P.char '}')) + where + pCloseBraces = () <$ P.try (P.char '}') + +pOpen :: Monad m => Parser m (Parser m ()) +pOpen = pOpenDollar <|> pOpenBraces + +pVar :: Monad m => Parser m Variable +pVar = do + first <- pIdentPart <|> pIt + rest <- P.many (P.char '.' *> pIdentPart) + pipes <- P.many pPipe + return $ Variable (first:rest) pipes + +pPipe :: Monad m => Parser m Pipe +pPipe = do + P.char '/' + pipeName <- P.many1 P.letter + P.notFollowedBy P.letter + case pipeName of + "uppercase" -> return ToUppercase + "lowercase" -> return ToLowercase + "pairs" -> return ToPairs + "length" -> return ToLength + "alpha" -> return ToAlpha + "roman" -> return ToRoman + "reverse" -> return Reverse + "first" -> return FirstItem + "rest" -> return Rest + "last" -> return LastItem + "allbutlast" -> return AllButLast + "chomp" -> return Chomp + "nowrap" -> return NoWrap + "left" -> Block LeftAligned <$> pBlockWidth <*> pBlockBorders + "right" -> Block RightAligned <$> pBlockWidth <*> pBlockBorders + "center" -> Block Centered <$> pBlockWidth <*> pBlockBorders + _ -> fail $ "Unknown pipe " ++ pipeName + +pBlockWidth :: Monad m => Parser m Int +pBlockWidth = P.try (do + _ <- P.many1 P.space + ds <- P.many1 P.digit + case T.decimal (T.pack ds) of + Right (n,"") -> return n + _ -> fail "Expected integer parameter for pipe") P. + "integer parameter for pipe" + +pBlockBorders :: Monad m => Parser m Border +pBlockBorders = do + P.skipMany P.space + let pBorder = do + P.char '"' + cs <- P.many $ (P.noneOf ['"','\\']) <|> (P.char '\\' >> P.anyChar) + P.char '"' + P.skipMany P.space + return $ T.pack cs + Border <$> P.option mempty pBorder <*> P.option mempty pBorder + +pIt :: Monad m => Parser m Text +pIt = fromString <$> P.try (P.string "it") + +pIdentPart :: Monad m => Parser m Text +pIdentPart = P.try $ do + first <- P.letter + rest <- P.many (P.satisfy (\c -> isAlphaNum c || c == '_' || c == '-')) + let part = first : rest + guard $ part `notElem` reservedWords + return $ fromString part + +reservedWords :: [String] +reservedWords = ["if","else","endif","elseif","for","endfor","sep","it"] diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 --- a/test/Spec.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Text.DocTemplates -import Test.Hspec -import Data.Text -import Data.Aeson - -data Employee = Employee { firstName :: String - , lastName :: String - , salary :: Maybe Integer } -instance ToJSON Employee where - toJSON e = object [ "name" .= object [ "first" .= firstName e - , "last" .= lastName e ] - , "salary" .= salary e ] - -employees :: [Employee] -employees = [ Employee "John" "Doe" Nothing - , Employee "Omar" "Smith" (Just 30000) - , Employee "Sara" "Chen" (Just 60000) ] - -template :: Text -template = - "$for(employee)$Hi, $employee.name.first$. $if(employee.salary)$You make $$$employee.salary$.$else$No salary data.$endif$$sep$\n$endfor$" - -main :: IO () -main = hspec $ do - describe "applyTemplate" $ do - it "works" $ do - applyTemplate template (object ["employee" .= employees]) - `shouldBe` - (Right "Hi, John. No salary data.\nHi, Omar. You make $30000.\nHi, Sara. You make $60000." :: Either String Text) - it "renders numbers appropriately as integer or floating" $ do - applyTemplate "$m$ and $n$" - (object ["m" .= (5 :: Integer), "n" .= (7.3 :: Double)]) - `shouldBe` - (Right "5 and 7.3" :: Either String Text) - it "fails with an incorrect template" $ do - applyTemplate "$if(x$and$endif$" (object []) - `shouldBe` - (Left "\"template\" (line 1, column 6):\nunexpected \"$\"\nexpecting \".\" or \")$\"" :: Either String Text) - diff --git a/test/bad.txt b/test/bad.txt new file mode 100644 --- /dev/null +++ b/test/bad.txt @@ -0,0 +1,2 @@ +partial +$with syntax error diff --git a/test/basic-with-braces.test b/test/basic-with-braces.test new file mode 100644 --- /dev/null +++ b/test/basic-with-braces.test @@ -0,0 +1,16 @@ +{ "employee": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "30000" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": "60000" } + ] +} +. +${ for(employee) } +Hi, ${employee.name.first}. ${ if(employee.salary) }You make $$${ employee.salary }.${ else }No salary data.${ endif } +${ endfor } +. +Hi, John. No salary data. +Hi, Omar. You make $30000. +Hi, Sara. You make $60000. diff --git a/test/basic-with-it.test b/test/basic-with-it.test new file mode 100644 --- /dev/null +++ b/test/basic-with-it.test @@ -0,0 +1,16 @@ +{ "employee": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "30000" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": "60000" } + ] +} +. +$for(employee)$ +Hi, $it.name.first$. $if(it.salary)$You make $$$it.salary$.$else$No salary data.$endif$ +$endfor$ +. +Hi, John. No salary data. +Hi, Omar. You make $30000. +Hi, Sara. You make $60000. diff --git a/test/basic.test b/test/basic.test new file mode 100644 --- /dev/null +++ b/test/basic.test @@ -0,0 +1,16 @@ +{ "employee": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "30000" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": "60000" } + ] +} +. +$for(employee)$ +Hi, $employee.name.first$. $if(employee.salary)$You make $$$employee.salary$.$else$No salary data.$endif$ +$ endfor $ +. +Hi, John. No salary data. +Hi, Omar. You make $30000. +Hi, Sara. You make $60000. diff --git a/test/boilerplate.txt b/test/boilerplate.txt new file mode 100644 --- /dev/null +++ b/test/boilerplate.txt @@ -0,0 +1,3 @@ +BOILERPLATE +HERE + diff --git a/test/boolean.test b/test/boolean.test new file mode 100644 --- /dev/null +++ b/test/boolean.test @@ -0,0 +1,13 @@ +{ "foo": true, + "bar": false +} +. +$foo$ +$bar$ +$if(foo)$XXX$else$YYY$endif$ +$if(bar)$XXX$else$YYY$endif$ +. +true +false +XXX +YYY diff --git a/test/comments.test b/test/comments.test new file mode 100644 --- /dev/null +++ b/test/comments.test @@ -0,0 +1,9 @@ +{ "foo": 3 } +. +$-- a comment +$--${foo} more comment +$$-- not a comment +a$-- comment +. +$-- not a comment +a diff --git a/test/conditionals.test b/test/conditionals.test new file mode 100644 --- /dev/null +++ b/test/conditionals.test @@ -0,0 +1,37 @@ +{ "foo": 1, + "bar": null, + "baz": ["a", "b"], + "bim": { "zub": "sim" }, + "sup": [ { "biz": "qux" } + , { "sax": "" } + ] +} +. +${if(sup.sax)} +XXX +${else} +YYY +${endif} +${if(bar)} +BAR +${endif} +${if(bar)}BAR${endif} +${if(foo)} +FOO +${endif} +${if(baz)} +BAZ +${endif} +${if(bim)} +BIM +${endif} +${if(sup)} +SUP +${endif} +. +YYY + +FOO +BAZ +BIM +SUP diff --git a/test/elseif.test b/test/elseif.test new file mode 100644 --- /dev/null +++ b/test/elseif.test @@ -0,0 +1,30 @@ +{ "foo": 1, + "bar": null, + "baz": ["a", "b"], + "bim": { "zub": "sim" }, + "sup": [ { "biz": "qux" } + , { "sax": "" } + ] +} +. +$if(sup.sax)$ +XXX +$elseif(baz)$ +YYY +$else$ +ZZZ +$endif$ + +$if(sup.sax)$ +XXX +$elseif(baz.nonexist)$ +YYY +$elseif(sup.sax)$ +ZZZ +$else$ +WWW +$endif$ +. +YYY + +WWW diff --git a/test/empty.test b/test/empty.test new file mode 100644 --- /dev/null +++ b/test/empty.test @@ -0,0 +1,16 @@ +{ "employee": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": [] } + ] +} +. +$for(employee)$ +Hi, $employee.name.first$. $if(employee.salary)$You make $$$employee.salary$.$else$No salary data.$endif$ +$ endfor $ +. +Hi, John. No salary data. +Hi, Omar. No salary data. +Hi, Sara. No salary data. diff --git a/test/enum.txt b/test/enum.txt new file mode 100644 --- /dev/null +++ b/test/enum.txt @@ -0,0 +1,2 @@ +$it.key/alpha/uppercase$. $^$$it.value$ + diff --git a/test/final-newline.test b/test/final-newline.test new file mode 100644 --- /dev/null +++ b/test/final-newline.test @@ -0,0 +1,15 @@ +{ "employee": + [ { "name": "John\n" } + , { "name": "Sara\n\n" } + , { "name": "Omar" } + ] +} +. +$for(employee)$ +$employee.name$ +$ endfor $ +. +John +Sara + +Omar diff --git a/test/forloop.test b/test/forloop.test new file mode 100644 --- /dev/null +++ b/test/forloop.test @@ -0,0 +1,21 @@ +{ "employee": + [ { "name": { "first": "John", "last": "Doe" } + , "salary": "30000" } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "60000" } + , { "name": { "first": "Sara", "last": "Chen" } } + ] +} +. +$for(employee)$ +$employee.name.first$ $employee.name.last$$sep$; +$endfor$ + + +$for(employee)$$employee.salary$$sep$; $endfor$ +. +John Doe; +Omar Smith; +Sara Chen + +30000; 60000; diff --git a/test/indent.test b/test/indent.test new file mode 100644 --- /dev/null +++ b/test/indent.test @@ -0,0 +1,30 @@ +{ "foo": "FOO1\nFOO2" +, "bar": [ "LINE1\n LINE2" + , "LINE3\n LINE4" + ] +} +. +$if(foo)$ + $foo$ +$endif$ +$for(bar)$ + $bar$ +$endfor$ + +- $foo$ + $foo$ - + $if(foo)$$foo$$endif$ +. + FOO1 + FOO2 + LINE1 + LINE2 + LINE3 + LINE4 + +- FOO1 +FOO2 + FOO1 +FOO2 - + FOO1 +FOO2 diff --git a/test/inparens.txt b/test/inparens.txt new file mode 100644 --- /dev/null +++ b/test/inparens.txt @@ -0,0 +1,1 @@ +($it$) diff --git a/test/loop-in-object.test b/test/loop-in-object.test new file mode 100644 --- /dev/null +++ b/test/loop-in-object.test @@ -0,0 +1,19 @@ +{ "worksite": + { "name": "canyon" + , "workers": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "30000" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": "60000" } + ] + } +} +. +${ for(worksite.workers) } +${it.name.last}, ${it.name.first} +${ endfor } +. +Doe, John +Smith, Omar +Chen, Sara diff --git a/test/loop-in-partial.test b/test/loop-in-partial.test new file mode 100644 --- /dev/null +++ b/test/loop-in-partial.test @@ -0,0 +1,6 @@ +{} +. +$loop1()$ + +. +(loop) diff --git a/test/loop1.txt b/test/loop1.txt new file mode 100644 --- /dev/null +++ b/test/loop1.txt @@ -0,0 +1,1 @@ +$loop2()$ diff --git a/test/loop2.txt b/test/loop2.txt new file mode 100644 --- /dev/null +++ b/test/loop2.txt @@ -0,0 +1,1 @@ +$loop1()$ diff --git a/test/name.tex b/test/name.tex new file mode 100644 --- /dev/null +++ b/test/name.tex @@ -0,0 +1,1 @@ +\name{$it.name.first$}{$it.name.last$} diff --git a/test/name.txt b/test/name.txt new file mode 100644 --- /dev/null +++ b/test/name.txt @@ -0,0 +1,1 @@ +$it.name.first:inparens()$ $it.name.last$ diff --git a/test/nest.test b/test/nest.test new file mode 100644 --- /dev/null +++ b/test/nest.test @@ -0,0 +1,67 @@ +{ "foo": 1, + "baz": ["a", "b"], + "bim": { "zub": "sim" }, + "sup": "a multiline\nstring" +} +. + $sup$ + $sup$ + + $^$$sup$ + +$bim.zub$ $^$$sup$ + +$bim.zub$ $^$$foo$ + bar $sup$ + +$for(baz)$ +1. $^$Hello + $if(it)$ + $it$ + $endif$ +$endfor$ + + $^$hey $sup$ + hey $sup$ + + hey $sup$ + + hey + $if(foo)$ + + $foo$ + $endif$ + hey +. + a multiline + string + a multiline + string + + a multiline + string + +sim a multiline + string + +sim 1 + bar a multiline + string + +1. Hello + a +1. Hello + b + + hey a multiline + string + hey a multiline + string + + hey a multiline + string + + hey + + 1 + hey diff --git a/test/nested-loop.test b/test/nested-loop.test new file mode 100644 --- /dev/null +++ b/test/nested-loop.test @@ -0,0 +1,41 @@ +{ + "pages": [ + { + "subpages": [ + { + "slug": "subpage-1" + }, + { + "slug": "subpage-2" + } + ], + "slug": "page-1" + }, + { + "subpages": [ + { + "slug": "subpage-1" + }, + { + "slug": "subpage-2" + } + ], + "slug": "page-2" + } + ] +} +. +$-- see #15 +$for(pages)$ +/$pages.slug$ +$for(pages.subpages)$ + /$pages.slug$/$pages.subpages.slug$ +$endfor$ +$endfor$ +. +/page-1 + /page-1/subpage-1 + /page-1/subpage-2 +/page-2 + /page-2/subpage-1 + /page-2/subpage-2 diff --git a/test/numbers.test b/test/numbers.test new file mode 100644 --- /dev/null +++ b/test/numbers.test @@ -0,0 +1,7 @@ +{ "m": 5 +, "n": 7.3 +} +. +$m$ and $n$ +. +5 and 7.3 diff --git a/test/pad.test b/test/pad.test new file mode 100644 --- /dev/null +++ b/test/pad.test @@ -0,0 +1,53 @@ +{ "sup": "a multiline\nstring", + "baz": ["a\nb", "b\nc\nd"], + "employee": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "30000" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": "60000" } + ] +} +. +$sup/right 15$$sup/center 15$$sup/left 15$ + +$for(baz/pairs)$ +$it.key/alpha/right 4$. $^$$it.value$ +$endfor$ + ++------+-----------+ +$for(baz/pairs)$ +$it.key/right 4 "| " " | "$$it.value/left 10 "" "|"$ ++------+-----------+ +$endfor$ + +|------------|------------| +$for(employee)$ +$it.name.first/uppercase/left 10 "| "$$it.salary/right 10 " | " " |"$ +$endfor$ +|------------|------------| + +. + a multiline a multiline a multiline + string string string + + a. a + b + b. b + c + d + ++------+-----------+ +| 1 | a | +| | b | ++------+-----------+ +| 2 | b | +| | c | +| | d | ++------+-----------+ + +|------------|------------| +| JOHN | | +| OMAR | 30000 | +| SARA | 60000 | +|------------|------------| diff --git a/test/partial_foo.txt b/test/partial_foo.txt new file mode 100644 --- /dev/null +++ b/test/partial_foo.txt @@ -0,0 +1,4 @@ +Hello +$if(foo)$ +$foo$ +$endif$ diff --git a/test/partials.test b/test/partials.test new file mode 100644 --- /dev/null +++ b/test/partials.test @@ -0,0 +1,39 @@ +{ "employee": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "30000" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": "60000" } + ] +} +. +$for(employee)$ +$it:name()$ +$endfor$ + +$employee:name()[, ]$ + +$employee:name()$ + +$employee:name.tex()[; ]$ + +--- + $boilerplate()$ +--- +$partial_foo()$ +. +(John) Doe +(Omar) Smith +(Sara) Chen + +(John) Doe, (Omar) Smith, (Sara) Chen + +(John) Doe(Omar) Smith(Sara) Chen + +\name{John}{Doe}; \name{Omar}{Smith}; \name{Sara}{Chen} + +--- + BOILERPLATE + HERE +--- +Hello diff --git a/test/pipe-and-partial.test b/test/pipe-and-partial.test new file mode 100644 --- /dev/null +++ b/test/pipe-and-partial.test @@ -0,0 +1,16 @@ +{ "employee": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "30000" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": "60000" } + ] +} +. +$for(employee)$ +$it:name()/uppercase$ +$endfor$ +. +(JOHN) DOE +(OMAR) SMITH +(SARA) CHEN diff --git a/test/pipes.test b/test/pipes.test new file mode 100644 --- /dev/null +++ b/test/pipes.test @@ -0,0 +1,109 @@ +{ "foo": 1, + "bar": null, + "baz": ["a", "b"], + "bim": { "Zub": "Sim" }, + "sup": [ { "biz": "qux" }, + { "sax": 2 } ], + "items": [ "one with\na line break", + "two", + "three with\na line break" ], + "hasblanks": "hello\n\n", + "hasblanksmap": { "a": "hello\n\n", + "b": "there\n\n" }, + "digits": [1, 5, 20] +} +. +$bar/length$ +$baz/length$ +$bim.Zub/length$ +$bim/length$ +$sup/length$ + +$baz/uppercase[, ]$ + +$for(baz)$ +$it$ +$it/uppercase$ +$baz$ +$baz/uppercase$ +$endfor$ + +$for(bim/pairs)$ +$it.key$: $it.value$ +$bim.key$: $bim.value/lowercase$ +$endfor$ + +$for(baz/pairs)$ +$it.key/roman/uppercase/right 4$. $it.value$ +$endfor$ + +$items/pairs/reverse:enum()$ + +($hasblanks/chomp$) + +$for(hasblanksmap/chomp/pairs/uppercase)$ +$it.key$ ($it.value$) +$endfor$ + +$digits/roman[ ]$ + +$for(bim/uppercase)$ +$it.Zub$ +$endfor$ + +$digits/first$ +$digits/last$ +$for(digits/rest)$ +$it$ +$endfor$ +$for(digits/allbutlast)$ +$it$ +$endfor$ +$foo/first$ +. +0 +2 +3 +1 +2 + +A, B + +a +A +a +A +b +B +b +B + +Zub: Sim +Zub: sim + + I. a + II. b + +C. three with + a line break +B. two +A. one with + a line break + + +(hello) + +A (HELLO) +B (THERE) + +i v xx + +SIM + +1 +20 +5 +20 +1 +5 +1 diff --git a/test/space-in-loop.test b/test/space-in-loop.test new file mode 100644 --- /dev/null +++ b/test/space-in-loop.test @@ -0,0 +1,27 @@ +{ "employee": + [ { "name": { "first": "John", "last": "Doe" } } + , { "name": { "first": "Omar", "last": "Smith" } + , "salary": "30000" } + , { "name": { "first": "Sara", "last": "Chen" } + , "salary": "60000" } + ] +} +. +$for(employee)$ +$employee.name.first$ + +$endfor$ +--- +$for(nonexistent)$ + +$endfor$ +--- +. +John + +Omar + +Sara + +--- +--- diff --git a/test/test.hs b/test/test.hs new file mode 100644 --- /dev/null +++ b/test/test.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import Text.DocLayout (render) +import qualified Text.DocLayout as DL +import qualified Data.Map as M +import Text.DocTemplates +import Test.Tasty.Golden +import Test.Tasty +import Test.Tasty.HUnit +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Data.Text.Encoding as T +import System.FilePath +import System.IO.Temp +import Data.Aeson +import System.FilePath.Glob +import qualified Data.ByteString.Lazy as BL +import Data.Semigroup ((<>)) +import Data.Maybe + +main :: IO () +main = withTempDirectory "test" "out." $ \tmpdir -> do + testFiles <- glob "test/*.test" + goldenTests <- mapM (getTest tmpdir) testFiles + defaultMain $ testGroup "Tests" + [ testGroup "Golden tests" goldenTests + , testGroup "Unit tests" unitTests + ] + +unitTests :: [TestTree] +unitTests = [ + testCase "compile failure" $ do + (res :: Either String (Template T.Text)) <- + compileTemplate "" "$if(x$and$endif$" + res @?= Left "(line 1, column 6):\nunexpected \"$\"\nexpecting \".\", \"/\" or \")\"" + , testCase "compile failure (keyword as variable)" $ do + (res :: Either String (Template T.Text)) <- + compileTemplate "foobar.txt" "$sep$" + res @?= Left "\"foobar.txt\" (line 1, column 5):\nunexpected \"$\"\nexpecting letter or digit or \"()\"" + , testCase "compile failure (unknown pipe)" $ do + (res :: Either String (Template T.Text)) <- + compileTemplate "foobar.txt" "$foo/nope$" + res @?= Left "\"foobar.txt\" (line 1, column 10):\nunexpected \"$\"\nexpecting letter, letter or digit or \"()\"\nUnknown pipe nope" + , testCase "compile failure (missing parameter for pipe)" $ do + (res :: Either String (Template T.Text)) <- + compileTemplate "foobar.txt" "$foo/left$" + res @?= Left "\"foobar.txt\" (line 1, column 10):\nunexpected \"$\"\nexpecting letter, integer parameter for pipe, letter or digit or \"()\"" + , testCase "compile failure (unexpected parameter for pipe)" $ do + (res :: Either String (Template T.Text)) <- + compileTemplate "foobar.txt" "$foo/left a$" + res @?= Left "\"foobar.txt\" (line 1, column 11):\nunexpected \"a\"\nexpecting integer parameter for pipe" + , testCase "compile failure (error in partial)" $ do + (res :: Either String (Template T.Text)) <- + compileTemplate "test/foobar.txt" "$bad()$" + res @?= Left "\"test/bad.txt\" (line 2, column 7):\nunexpected \"s\"\nexpecting \"$\"" + , testCase "comment with no newline" $ do + (res :: Either String (Template T.Text)) <- + compileTemplate "foo" "$-- hi" + res @?= Right (mempty :: Template T.Text) + , testCase "reflow" $ do + (templ :: Either String (Template T.Text)) <- + compileTemplate "foo" "not breakable and$~$ this is breakable\nok? $foo$$~$" + let res :: T.Text + res = case templ of + Right t -> render (Just 10) + (renderTemplate t (object ["foo" .= ("42" :: T.Text)])) + Left e -> T.pack e + res @?= "not breakable and\nthis is\nbreakable\nok? 42" + , testCase "nowrap pipe" $ do + (templ :: Either String (Template T.Text)) <- + compileTemplate "foo" "$foo/nowrap$\n$foo$" + let res :: T.Text + res = case templ of + Right t -> render (Just 10) + (renderTemplate t (Context $ M.insert "foo" + (SimpleVal $ + DL.hsep ["hello", "this", "is", "a", + "test", "of", "the", "wrapping"] + :: Val T.Text) mempty)) + Left e -> T.pack e + res @?= "hello this is a test of the wrapping\nhello this\nis a test\nof the\nwrapping" + ] + +{- The test "golden" files are structured as follows: + +{ "foo": ["bar", "baz"] } +. +A template with $foo$. +. +A template with bar, baz. + +-} + +diff :: FilePath -> FilePath -> [String] +diff ref new = ["diff", "-u", "--minimal", ref, new] + +getTest :: FilePath -> FilePath -> IO TestTree +getTest tmpdir fp = do + let actual = tmpdir takeFileName fp + return $ goldenVsFileDiff fp diff fp actual $ do + inp <- T.readFile fp + let (j, template', _expected) = + case T.splitOn "\n.\n" inp of + [x,y,z] -> (x,y,z) + _ -> error $ "Error parsing " ++ fp + let j' = j <> "\n" + let template = template' <> "\n" + let templatePath = replaceExtension fp ".txt" + let (context :: Value) = fromMaybe Null $ + decode' . BL.fromStrict . T.encodeUtf8 $ j' + res <- applyTemplate templatePath template context + case res of + Left e -> error e + Right x -> T.writeFile actual $ j' <> ".\n" <> template <> ".\n" <> + render Nothing x diff --git a/test/values.test b/test/values.test new file mode 100644 --- /dev/null +++ b/test/values.test @@ -0,0 +1,20 @@ +{ "foo": 1, + "bar": null, + "baz": ["a", "b"], + "bim": { "zub": "sim" }, + "sup": [ { "biz": "qux" } + , { "sax": 2 } + ] +} +. +$foo$ +$bar$ +$baz$ +$bim$ +$sup$ +. +1 + +ab +true +truetrue