ginger2 2.0.0.0 → 2.1.0.0
raw patch · 18 files changed
+1914/−423 lines, 18 filesdep +randomdep +template-haskell
Dependencies added: random, template-haskell
Files
- CHANGELOG +19/−0
- README.markdown +6/−16
- cli/Main.hs +3/−0
- ginger2.cabal +7/−2
- src/Language/Ginger.haddock +744/−0
- src/Language/Ginger.hs +24/−15
- src/Language/Ginger/AST.hs +4/−4
- src/Language/Ginger/BuiltinsAutodoc.hs +206/−0
- src/Language/Ginger/Interpret/Builtins.hs +302/−67
- src/Language/Ginger/Interpret/DefEnv.hs +129/−114
- src/Language/Ginger/Interpret/Eval.hs +41/−24
- src/Language/Ginger/Interpret/Type.hs +20/−3
- src/Language/Ginger/Parse.hs +12/−2
- src/Language/Ginger/SourcePosition.hs +1/−1
- src/Language/Ginger/Value.hs +166/−56
- test/Language/Ginger/Interpret/Tests.hs +192/−107
- test/Language/Ginger/Parse/Tests.hs +18/−0
- test/Language/Ginger/TestUtils.hs +20/−12
CHANGELOG view
@@ -1,3 +1,22 @@ 2.0.0.0 - Initial release++2.1.0.0++- Improved documentation.+- Added support for `{% elif %}`.+- Fixed some spurious test failures.+- Moved `date` builtin to ginger extensions (its alias, `dateformat`, was+ an extension already).+- Added built-ins:+ - random()+ - min()+ - max()+ - sum()+ - reject()+- Added some built-in string, dict, and list methods+- Made truthiness checks more lenient, so that things like `{% if [] %}` work+ like in Jinja.+- Added an RNG state to the execution environment; this is necessary in order to+ support the random() function.
README.markdown view
@@ -2,13 +2,13 @@  -A Haskell implementation of the [Jinja2](https://jinja.palletsprojects.com/)+A Haskell implementation of the [Jinja](https://jinja.palletsprojects.com/) template language. ## Introduction -Ginger2 provides most of the original Jinja2 template language, as much as that-makes sense in a Haskell host application.+Ginger2 provides most of the Jinja template language, as much as that makes+sense in a Haskell host application. We do, however, avoid some of the most blatant Pythonisms, especially where we felt the features in question were more of an accidental result of binding@@ -60,13 +60,8 @@ </body> </html> -There are three kinds of delimiters:--- Interpolation, to inject values into the output; these default to `{{` and- `}}`-- Flow Control, to create conditionals, loops, and other control constructs;- these default to `{%` and `%}`-- Comments, which are removed from the output; these default to `{#` and `#}`.+For a full description of the syntax, refer to the Haddock documentation for the+[Language.Ginger module](https://hackage-content.haskell.org/package/ginger2/docs/Language-Ginger.html) ### Jinja syntax features absent from Ginger 2 @@ -78,7 +73,7 @@ - Line statements (using a leading `#` to mark a line as a statement, instead of `{% ... %}` markers). - Template objects (passing an expression to `extends` that evaluates to a- template, instead of passing a template name as a string).+ template, instead of passing a template name as a string) are not supported. - Ginger 2 makes no distinction between mutable "lists" and immutable "tuples"; there are only immutable lists. @@ -90,16 +85,11 @@ - `format` - `groupby` - `indent`-- `max` - `pprint` - `selectattr` - `slice` - `striptags`-- `sum`-- `random` - `rejectattr`-- `reject`-- `min` - `trim` - `truncate` - `unique`
cli/Main.hs view
@@ -22,6 +22,7 @@ import System.Directory (getCurrentDirectory) import System.FilePath (takeDirectory, takeFileName, takeExtension, (</>) ) import System.IO (hPutStrLn, stderr)+import qualified System.Random as R import qualified Data.Yaml as YAML @@ -188,6 +189,7 @@ ".txt" -> textEncoder ".text" -> textEncoder _ -> htmlEncoder+ rng <- R.initStdGen ginger (fileOrStdinLoader baseDir) defPOptions@@ -195,6 +197,7 @@ , pstateStripBlocks = poStripBlocks po } (poDialect po)+ rng encoder templateName (vars <> extensions) >>= printResultTo (poOutputFile po)
ginger2.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ginger2-version: 2.0.0.0+version: 2.1.0.0 synopsis: Jinja templates for Haskell description: Ginger2 approximates Jinja2 (https://jinja.palletsprojects.com/) in Haskell.@@ -14,7 +14,7 @@ bug-reports: https://github.com/tdammers/ginger2/issues extra-doc-files: README.markdown , CHANGELOG--- extra-source-files:+extra-source-files: src/Language/Ginger.haddock source-repository head type: git@@ -26,6 +26,7 @@ library import: warnings exposed-modules: Language.Ginger+ , Language.Ginger.BuiltinsAutodoc , Language.Ginger.AST , Language.Ginger.Value , Language.Ginger.Interpret@@ -49,11 +50,13 @@ , filepath >=1.5.4.0 && <1.6 , megaparsec >=9.7.0 && <9.8 , mtl >=2.3.1 && <2.4+ , random >=1.3.1 && <1.4 , regex-tdfa >=1.3.2.3 && <1.4 , scientific >=0.3.8 && <0.4 , SHA >=1.6.4.4 && <1.7 , tasty >=1.5.3 && <1.6 , tasty-quickcheck >=0.11.1 && <0.12+ , template-haskell >=2.19.0.0 && <2.24 , text >=2.0 && <2.3 , time >=1.12 && <1.15 , vector >=0.13.2 && <0.14@@ -73,6 +76,7 @@ , directory >=1.3.9 && <1.4 , filepath >=1.5.4.0 && <1.6 , optparse-applicative >=0.18.1.0 && <0.19+ , random >=1.3.1 && <1.4 , text >=2.0 && <2.3 , vector >=0.13.2 && <0.14 , yaml >=0.11.11 && <0.12@@ -99,6 +103,7 @@ , megaparsec >=9.7.0 && <9.8 , mtl >=2.3.1 && <2.4 , quickcheck-instances >=0.3.2 && <0.4+ , random >=1.3.1 && <1.4 , tasty >=1.5.3 && <1.6 , tasty-quickcheck >=0.11.1 && <0.12 , tasty-hunit >=0.10.2 && <0.11
+ src/Language/Ginger.haddock view
@@ -0,0 +1,744 @@+[Jinja](https://jinja.palletsprojects.com/) is a dynamically-typed+template language designed for generating HTML and text output.++Ginger2 provides most of the Jinja template language, as much as that makes+sense in a Haskell host application.++We do, however, avoid some of the most blatant Pythonisms, especially where we+felt the features in question were more of an accidental result of binding+template constructs to Python constructs.++We also add some optional features that are absent from the Python+implementation, but that we felt useful and worth adding.++= Template Syntax++== __Minimal Example__++> <!DOCTYPE html>+> <html>+> <head>+> <title>{{ title }}</title>+> </head>+> {# This is a comment. Comments are removed from the output. #}+> <body>+> <menu id="nav-main">+> {% for item in navigation %}+> <li><a href="{{ item.url }}">{{ item.label }}</a></li>+> {% endfor %}+> </menu>+> <div class="layout-content-main">+> <h1>{{ title }}</h1>+> {{ body }}+> </div>+> </body>+> </html>++== __Comments__++Comments are delimited by @{#@ ... @#}@ markers.++It is not currently possible to nest comments.++== __Interpolation__++The @{{@ and @}}@ markers delimit /interpolation/: anything between these+markers is interpreted as an /expression/, and the result of evaluating that+expression is written into the template output at this point.++The following expression constructs are available:++=== Literals++==== String Literals+String literals can be written with single quotes:++> 'Hello, world!'++...or double quotes:++> "Hello, world!"++Quotes inside string literals can be escaped using backslashes:++> "Hello, \"world!\""++==== Numeric Literals+Integers can be written in decimal:++> 23++Floats can be written as decimal fractions:++> 23.5++...or in scientific notation:++> 0.25e10++==== Booleans+Two boolean literals exist: @true@ and @false@. For backwards compatibility+with Jinja, @True@ and @False@ are accepted as alternative spellings.++==== None+The literal @none@ designates the @NULL@ object (approximately equivalent+to '()' or 'Nothing' in Haskell). For backwards compatibility with Jinja,+@None@ is accepted as an alternative spelling.++=== Variables+Variables (built-in, passed in by the host application, or defined within+the template itself) are written as barewords. Their names must follow the+rules for identifiers:++* They must start with an alphabetic ASCII character or an underscore.+* All subsequent characters must be alphanumeric ASCII characters or+ underscores.++=== Lists+List literals are written as comma-separated lists between square brackets,+like in most programming languages:++> ["foo", "bar", "baz"]++Because Ginger is dynamically typed, lists are heterogenous, so the+following is perfectly fine:++> ["foo", 23, none, true, 1.5]++Unlike Jinja, Ginger does not distinguish lists from tuples; there is only+one list type, and all lists in Ginger are immutable.++=== Dictionaries+Dictionaries ("dicts") are key-value association containers. They are+written as comma-separated lists of dot-separated key/value pairs between+curly braces, like so:++> { "foo": 23, "bar": 42 }++Keys and values are both interpreted as expressions; this means that string+keys must be written as string literals, not barewords - barewords are+interpreted as variables, so for example @{ foo: "bar" }@ will not make a+dictionary key \"foo\", but rather try to look up a variable named @foo@ in+the current scope, and use its value as the key.++Values can be anything; keys, however, must be scalars, that is, strings,+numbers, booleans, or @none@.++=== Dot Member Access+Members of dictionaries and (some) native objects can be obtained using dot+access syntax, like so:++> someDictionary.foo++Note that the member name is written as a bareword; these are *not*+interpreted as variables, and quoting member names in dot syntax like string+literals is a syntax error.+Dot syntax can also be used to access built-in methods of various types of+values; for example, the @string@ type provides a method @upper()@, which+returns the original string converted to uppercase, so you can write:++> "Hello, world!".upper()++...which will yield the string @"HELLO, WORLD!"@.++Dot syntax will prioritize *attributes* (built-in properties) over *items*+(data items stored in a dictionary).++=== Indexing+Members of dictionaries, as well as elements of lists and characters in a+string, can be accessed using an index between square brackets, as follows.++Get an item from a list:++> someList[3]++Get a member/item from a dictionary:++> someDict["foo"]++Get the n-th character from a string:++> someString[3]++Note that strings and lists will only accept integer indices, while+dictionaries and native objects may accept arbitrary scalars.++Note further that, unlike dot syntax, the thing between square brackets is+evaluated as an expression, so if you want to access a string key in a+dictionary, it must be written as a quoted string literal. The following is+an example of accessing a dictionary member through a variable key:++> someDict[foo]++This will *not* look up a key named "foo", but rather, try to find a+variable named "foo" in the current scope, get its value, and use that as a+key to look up in @someDict@.++Indices into strings and lists are zero-based, that is, @[0]@ yields the+first element of a list, or the first character of a string.++Square bracket syntax will prioritize *items* (data items stored in a+container) over *attributes* (built-in methods associated with a value).++=== Slicing+Square bracket syntax can also be used to get sub-ranges from a list or+string, using the colon (@:@) to separate the start and end of the desired+range. Negative indices imply counting from the end of the range; absent+indices refer to the start or end of the original sequence respectively.++Examples:++> "Hello, world!"[1:2]++Get a substring of length 2, starting at the second character: "el".++> "Hello, world!"[:2]++Get a substring of length 2, starting at the beginning of the string: "He".++> "Hello, world!"[-2:]++Get a substring up to the end of the string, starting two characters before+the end: "d!".++> "Hello, world!"[2:-2]++Get a substring from the third character up to 2 characters before the end+of the string: "llo, worl".++=== Unary Operators+Two unary operators are available, both written in prefix notation:++* @not@ provides boolean negation+* @-@ provides numeric negation++=== Binary Operators+All binary operators are written in infix notation. In order of precedence,+the following classes of operators are available:++==== Boolean++* @and@ - boolean AND+* @or@ - boolean OR++==== Boolean Negation++Not a binary operator, but listed here to indicate precedence; see above.++==== Comparative and Membership++* @==@ - equals+* @!=@ - not-equals+* @<@ - less-than; works on numbers as well as strings+* @>@ - greater-than; dito+* @<=@ - less-than-or-equal; dito+* @>=@ - greater-than-or-equal; dito+* @in@ - membership test++==== Test++Not a real operator, but listed here to indicate precendence. See below for+details on tests.++==== Concatenation++* @~@ - String concatenation. If non-string arguments are given, they are+ converted to string. However, if either argument is encoded text,+ then the other argument will also be encoded first.++==== Additive++These operations are numeric. If both arguments are integers, integer+operations will be used, otherwise, both arguments will be converted to+float.++* @+@ - Numeric addition.+* @-@ - Numeric subtraction.++==== Multiplicative++These operations are numeric. If both arguments are integers, integer+operations will be used, otherwise, both arguments will be converted to+float, unless specified otherwise.++* @*@ - Numeric multiplication.+* @/@ - Numeric division.+* @%@ - Integer modulus. Both arguments will be converted to int.+* @//@ - Integer division. Both arguments will be converted to int.++==== Power++Numeric operation; if both arguments are integers, integer arithmetic will+be used, otherwise, both arguments will be cast to float.++* @**@ Exponentiation: @a ** b@ means \"a to the power of b\".++==== Member access, filter, call++Not operators, but listed here to indicate precedence. See respective+sections for details.++=== Ternary Operator+The ternary operator consists of the keywords @if@ and @else@, and works+much like in Python:++> "foo" if condition else "bar"++...means \"evaluate to \'foo\' if @condition@ holds, otherwise, evaluate to+\'bar\'\".++=== Procedure Calls+Procedure calls are written like in most imperative languages, appending+a comma-separated list of arguments between parentheses to the procedure to+be called.++To call a procedure @foo@ with two arguments, @1@ and @2@:++> foo(1, 2)++Procedures may have optional arguments (which can be left out, using a+default value instead), and arguments can also be given by name instead of+positionally, e.g.:++> foo(bar=23)++This calls procedure @foo@ with the @bar@ argument set to @23@, and any other+arguments left at their defaults.++Some objects can be called as procedures while also offering other APIs; an+exampe is the @loop@ object that is available within recursive @for@ loops+(see below), which exposes a number of fields providing information about+the state of the iteration, but can also be called as a procedure to recurse+into a deeper iteration level.++=== Filters+Filter syntax is a convenient syntactic alternative to procedure call+syntax. It looks like this:++> foo|center(10)++This will call the @center@ filter, passing the value of @foo@ as the first+argument, and @10@ as a second argument. Thus, it is equivalent to:++> center(foo, 10)++If no additional arguments are passed, the parentheses can be omitted:++> foo|capitalize++This syntax is particularly useful when chaining multiple filters, e.g.:++> foo|default('n/a')|lower|trim++One filter, @default@, and its alias @d@, cannot be implemented as+procedures, because it must inspect its argument as an unevaluated+expression - evaluating it before passing it to the filter would cause a+\"Not In Scope\" error when the argument isn't defined, making the entire+filter moot. Hence, this filter is only available through filter syntax, not+as a procedure.++=== Tests++Tests are written using the @is@ keyword, much like a binary operator;+however, they are special-cased in the language, for two reasons:+* They can inspect their argument unevaluated (e.g., the @defined@ test will+ do this to determine whether the argument is in scope).+* Some tests have the same name as a procedure or filter, but their+ functionality is different in a text context. E.g., @lower@, when used as+ a filter of procedure will convert its argument to lowercase, but when+ used as a test, it will instead check whether the argument is lowercase.++In Jinja, tests may only occur in contexts where a boolean condition is+expected (e.g., the ternary operator, or an @{% if ... %}@ statement);+Ginger allows tests in any expression context, and treats the result as a+boolean value. For example, the following would be perfectly fine in Ginger,+but (probably) not work in Jinja:++> {% set answers = { false: "odd", true: "even" } %}+> Foo is {{ answers[foo is even] }}.++== __Flow Control Statements__++All statements are delimited using statement brackets: @{%@ ... @%}@.++=== @{% filter %}@+Apply a filter (see above, filter expressions) to a block of template code.++> {% filter 'capitalize' %}+> Hello, world!+> {% endfilter %}++...will output:++> HELLO, WORLD!++The filter itself may be specified as an expression (e.g. @{% filter+capitalize %}@), or as a string that will be resolved as a variable (e.g.+@{%filter 'capitalize' %}@. Both are equivalent.++Additional arguments may be passed just like with filter expression syntax:++> {% filter center(100) %}+> Hello, world!+> {% endfilter %}++=== @{% for %}@++Loops over a collection (list or dictionary).++In its simplest form, it looks like this:++> {% for user in users %}+> {{ user }}+> {% endfor %}++This will iterate over the elements of a list in the variable @users@,+binding the current element to the variable @user@ within the scope of the+iteration body.++Inside of a for-loop block, you can access some special variables:++* @loop.index@ - The current iteration of the loop. (1 indexed)+* @loop.index0@ - The current iteration of the loop. (0 indexed)+* @loop.revindex@ - The number of iterations from the end of the loop (1+ indexed)+* @loop.revindex0@ - The number of iterations from the end of the loop (0+ indexed)+* @loop.first@ - True if first iteration.+* @loop.last@ - True if last iteration.+* @loop.length@ - The number of items in the sequence.+* @loop.cycle@ - A helper function to cycle between a list of sequences. See+ the explanation below.+* @loop.depth@ - Indicates how deep in a recursive loop the rendering+ currently is. Starts at level 1+* @loop.depth0@ - Indicates how deep in a recursive loop the rendering+ currently is. Starts at level 0+* @loop.previtem@ - The item from the previous iteration of the loop.+ Undefined during the first iteration.+* @loop.nextitem@ - The item from the following iteration of the loop.+ Undefined during the last iteration.+* @loop.changed(val)@ - True if previously called with a different value+ (or not called at all).++While there are no @continue@ or @break@ statements to alter the flow of+a loop from within, it is possible to filter the iteree, by adding an @if@+construct to the loop header:++> {% for user in users if user.username is not none %}+> {{ user.username }}+> {% endfor %}++The same effect can be achieved by wrapping the loop body in an @if@+statement; however, filtering the loop iteree has the advantage that the+@loop@ variables will count correctly.++E.g., given a list of users like so:++> [ { "username": "tdammers" },+> { "username": none },+> { "username": "jdoe" }+> ]++This template will work correctly:++> {% for user in users if user.username is not none %}+> {{ loop.index }}. {{ user.username }}+> {% endfor %}++...outputting:++> 1. tdammers+> 2. jdoe++Whereas this template:++> {% for user in users %}+> {% if user.username is not none %}+> {{ loop.index }}. {{ user.username }}+> {% endif %}+> {% endfor %}++...would output:++> 1. tdammers+> 3. jdoe++An optional @else@ branch can be added to a loop, which will be used when+the iteration body has not been used at all (because the list was empty, or+because all items were filtered out):++> {% for user in users %}+> <p>{{ user.username }}</p>+> {% else %}+> <p class="no-results">No users found.</p>+> {% endfor %}++Loops can also be used recursively. For this, two things are required:++1. The loop needs to be declared as being recursive: @{% for ... in ...+ recursive %}@+2. The @loop@ variable must be called with an appropriate iteree in order to+ recurse into it.++Example:++> {% for branch in tree recursive %}+> <section>+> <h3>{{ branch.name }}</h3>+> <p>{{ branch.description }}</p>+> {% if "children" in branch %}+> {{ loop(branch.children) }}+> {% endif %}+> {% endfor %}++Please note that assignments in loops will be cleared at the end of the+iteration and cannot outlive the loop scope.++To work around this, consider using namespace objects, created using the+@namespace@ procedure. However, if all you need to do is check the previous+and/or next item in the iteration, you can simply use @loop.prev@ and+@loop.next@.++=== @{% if %}@++Conditionals. These work much like if / then / else in a typical imperative+language. Three forms exist:++Simple @if@ with no @else@:++> {% if isGreeting %}+> Hi!+> {% endif %}++@if@ / @else@:++> {% if isArriving %}+> Hello!+> {% else %}+> Goodbye!+> {% endif %}++@if@ / @elif@ / @else@:++> {% if isMorning %}+> Good morning!+> {% elif isEvening %}+> Good night!+> {% else %}+> Good day!+> {% endif %}++=== @{% set %}@++Assignment. There are two forms of the @set@ statement.++First form: assign an expression.++> {% set name = "tdammers" %}++Second form: assign a block of encoded output.++> {% set name %}+> tdammers+> {% endset %}++Variables set using either construct will be available within the current+scope; includes, imports, template inheritance, the @{% with %}@ statement,+and @{% for %}@ loops can affect scope.++=== @{% with %}@++Creates a nested scope. Any variables set or overwritten within the nested+scope will only be reflected inside the nested scope; any variables from the+containing scope will be available until overridden, and will revert back to+their previous values when leaving the inner scope.++> {% set foo = "A" %}+> {{ foo }}+> {% with %}+> {{ foo }}+> {% set foo = "B" %}+> {{ foo }}+> {% endwith %}+> {{ foo }}++Will yield:++> A+> A+> B+> A++=== @{% macro %}@++Defines a macro. Macros are reusable bits of Jinja code, akin to procedures.+In fact, macros and procedures are represented as the same thing internally+in Ginger, and you can call procedures as macros (using the @{% call %}@+statement), and macros as procedures or filters (using expression-level+procedure call or filter syntax).++A macro definition looks like this:++> {% macro userInfo(user, extraInfo=none) %}+> <section class="userinfo">+> <h3>{{ user.username }}</h3>+> <p>Role: {{ user.role }}</p>+> <p>Status: {% if user.active %}active{% else %}inactive{% endif %}+> {% if extraInfo is not none %}+> {{ extraInfo }}+> {% endif %}+> </section>+> {% endmacro %}++Macros can be declared to take any number of arguments, the values of which+will be bound to variables in the scope of the macro's body. Defaults can be+given for each argument, making it optional; it is considered good practice+to list required arguments (without defaults) before optional arguments, so+that there is no ambiguity when arguments are given positionally (i.e.,+without explicit argument names).++Inside a macro body, a special variable, @caller@, is made available if the+macro was invoked through a @{% call %}@ statement. In that case, @caller@+will be a procedure that outputs the body of the @{% call %}@ statement that+was used to invoke the macro.++=== @{% call %}@++Calls a macro (see above) with an additional body, which is passed through+the magic @caller()@ procedure.++Given this macro definition:++> {% macro sectionize(title) %}+> <section>+> <h1>{{ title }}</h1>+> {{ caller() }}+> </section>+> {% endmacro %}++...the following will call that macro with a @caller()@ body:++> {% call sectionize("Some Section") %}+> Lorem ipsum dolor sit amet.+> {% endcall %}++This will render as:++> <section>+> <h1>Some Section</h1>+> Lorem ipsum dolor sit amet.+> </section>++=== @{% include %}@++> {% include "foo.html" %}++This will load the template "foo.html", and insert its output at this+position, as if the template source were pasted in.++By default, this implies that the included template will have access to the+scope of the location where it is included; you can change this by adding+@without context@ to the include statement:++> {% include "foo.html" without context %}++It is also valid to write @with context@, but since that is the default,+this will do nothing.++Missing templates are an error; if you want to be lenient, you can add+@ignore missing@ to the include, which ignore such errors. If both are given,+@ignore missing@ must come before @with@ / @without context@.++> {% include "foo.html" ignore missing without context %}++=== @{% import %}@++Works much like @include@, however, there are some key differences:++* @import@ will not inject any output from the imported template. The+ imported template will still be evaluated in full, and any macros and+ top-level variables it defines (using @{% macro %}@ and @{% set %}@) will+ be exported, but any output it generates will be discarded.+* @import@ defaults to @without context@, i.e., it does not have access to+ the scope in which the import statement appears.+* Because the main purpose of @import@ is to pull top-level definitions into+ the importing scope, @import@ supports syntax flavors that import specific+ exports (macros / variables) selectively, as well as one that binds the+ exports to a single variable acting as a quasi-namespace.++To import a template's exports wholesale:++> {% import "util.html" %}++To bind an entire template's export to a quasi-namespace dictionary:++> {% import "util.html" as util %}++To import specific exports selectively:++> {% from "util.html" import abbreviateUsername, decorateUser %}++To import specific exports, renaming them to aliases:++> {% from "util.html" import abbreviateUsername as abbrev, decorateUser as deco %}++=== @{% extends %}@++Used for template inheritance:++> {% extends "parent.html" %}++Indicates that the current template \"extends\" the template+\"parent.html\". To render the current template, Ginger will take any blocks+(see below under \"@{% block %}@\") from the current template, and inject+them into the corresponding blocks of the parent template.++Child templates should not directly output anything themselves; they should+only override blocks (@{% block %}@) and top-level variables ({% set %}).++=== @{% block %}@++Blocks are overridable subsections of a template. The @{% block %}@+statement is used both to define a block and to override it: the first+template in an inheritance chain to use a block name defines it, and+determines where it appears in the output; subsequent templates in the+chain can override its contents, but not where it appears in the output.++Maybe the most common use case for this is to have a \"skeleton\" template+that defines the overall layout of a web page, and a number of child+templates that override those parts that are specific to their respective+use cases.++Example:++(@skeleton.html@)++> <!DOCTYPE html>+> <html>+> <head>+> <meta charset="utf-8">+> <title>{% block "title" %}Unnamed Page{% endblock %}</title>+> <link rel="stylesheet" href="/static/style.css">+> </head>+> <body>+> {% include "mainnav.html" %}+> <div class="maincontent">+> {% block content %}+> Nothing to see here.+> {% endblock }+> </div>+> </body>+> </html>++(@userlist.html@)++> {% extends "skeleton.html" %}+> {% block "title" %}Users{% endblock %}+> {% block "content" %}+> <h1>Users</h1>+> <ul>+> {% for user in users %}+> <li>{{ user.username }}</li>+> {% endfor %}+> </ul>+> {% endblock %}
src/Language/Ginger.hs view
@@ -1,21 +1,12 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-} module Language.Ginger-( -- * AST- Statement (..)-, Expr (..)-, Template (..)-, Block (..)- -- * Representing Values-, Value (..)-, Scalar (..)-, Encoded (..)-, prettyRuntimeError-, Identifier (..)- -- * Interpreting Templates-, ginger+( -- * Interpreting Templates+ ginger , GingerT , Eval (..) , RuntimeError (..)@@ -26,6 +17,17 @@ , defEnv , defVars , defVarsCompat+ -- * AST+, Statement (..)+, Expr (..)+, Template (..)+, Block (..)+ -- * Representing Values+, Value (..)+, Scalar (..)+, Encoded (..)+, prettyRuntimeError+, Identifier (..) -- * Configuration , Encoder , htmlEncoder@@ -42,6 +44,7 @@ where import Language.Ginger.AST+import Language.Ginger.BuiltinsAutodoc import Language.Ginger.Value import Language.Ginger.Interpret import Language.Ginger.RuntimeError (prettyRuntimeError)@@ -66,6 +69,7 @@ import Data.Text (Text) import qualified Data.Text as Text import Data.Map.Strict (Map)+import System.Random (SplitGen) data JinjaDialect = DialectGinger2@@ -73,7 +77,7 @@ deriving (Show, Eq, Ord, Enum, Bounded) -- | One-stop function for parsing and interpreting a template.-ginger :: forall m. Monad m+ginger :: forall m g. (Monad m, SplitGen g) => TemplateLoader m -- ^ Template loader to use for loading the initial template and -- any included templates. For most use cases, 'fileLoader' should@@ -83,6 +87,7 @@ -> JinjaDialect -- ^ Jinja dialect; currently determines which built-in globals to -- load into the initial namespace.+ -> g -> Encoder m -- ^ Encoder to use for automatic encoding. Use 'htmlEncoder' for -- HTML templates.@@ -93,7 +98,7 @@ -> Map Identifier (Value m) -- ^ Variables defined in the initial namespace. -> m (Either RuntimeError Encoded)-ginger loader parserOptions dialect encoder templateName vars = runExceptT $ do+ginger loader parserOptions dialect rng encoder templateName vars = runExceptT $ do templateSrc <- maybe (throwError $ TemplateFileNotFoundError templateName) pure@@ -121,3 +126,7 @@ (evalT template >>= encode) ctx env+ rng++$(addHaddockFromFile "src/Language/Ginger.haddock")+$(builtinsAutodoc)
src/Language/Ginger/AST.hs view
@@ -77,12 +77,12 @@ , blockScoped :: !Scoped , blockRequired :: !Required }- deriving (Show, Eq)+ deriving (Show, Eq, Ord) data SetTarget = SetVar !Identifier | SetMutable !Identifier !Identifier- deriving (Show, Eq)+ deriving (Show, Eq, Ord) -- | A statement in the template language. data Statement@@ -162,7 +162,7 @@ | -- | Group of statements; not parsed, but needed for combining statements -- sequentially. GroupS ![Statement]- deriving (Show, Eq)+ deriving (Show, Eq, Ord) data IncludeMissingPolicy = RequireMissing@@ -378,7 +378,7 @@ -- | @TernaryE cond yes no@ | TernaryE !Expr !Expr !Expr | VarE !Identifier- deriving (Show, Eq)+ deriving (Show, Eq, Ord) pattern TrueE :: Expr pattern TrueE = BoolE True
+ src/Language/Ginger/BuiltinsAutodoc.hs view
@@ -0,0 +1,206 @@+{-# LANGUAGE OverloadedStrings #-}++module Language.Ginger.BuiltinsAutodoc+where++import Control.Monad.Identity (Identity, runIdentity)+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Vector as Vector+import Language.Haskell.TH (getDoc, putDoc, DocLoc (..), DecsQ, runIO)++import Language.Ginger.Interpret+import Language.Ginger.Interpret.Builtins+ ( builtinGlobals+ , builtinGlobalsNonJinja+ , builtinBoolAttribs+ , builtinIntAttribs+ , builtinFloatAttribs+ , builtinStringAttribs+ , builtinListAttribs+ , builtinDictAttribs+ , BuiltinAttribs+ )+import Language.Ginger.Interpret.DefEnv+ ( builtinTests+ , builtinFilters+ )+import Language.Ginger.AST+import Language.Ginger.Value++markdownToHaddock :: Text -> Text+markdownToHaddock =+ Text.replace "'" "\\'" .+ Text.replace "\"" "\\\"" .+ Text.replace "\n" "\n\n" .+ Text.replace "`" "@"++addHaddockFromFile :: FilePath -> DecsQ+addHaddockFromFile path = do+ src <- runIO $ readFile path+ doc <- fromMaybe "" <$> getDoc ModuleDoc+ putDoc ModuleDoc $ doc ++ src+ pure []++extractAttribs :: Monoid a+ => BuiltinAttribs a Identity+ -> [(Identifier, Value Identity)]+extractAttribs =+ extractAttribsWith mempty++extractAttribsWith :: a+ -> BuiltinAttribs a Identity+ -> [(Identifier, Value Identity)]+extractAttribsWith dummy =+ Map.toAscList .+ fmap (+ either (error . show) id .+ runIdentity .+ ($ dummy)+ )++builtinsAutodoc :: DecsQ+builtinsAutodoc = do+ doc <- fromMaybe "" <$> getDoc ModuleDoc+ putDoc ModuleDoc $+ doc +++ "\n\n== __List Of Builtin Globals__\n" +++ "\nThese are available in Jinja, and work (mostly) the same in Ginger.\n" +++ unlines (map (goItem Nothing "globals_jinja_") (Map.toAscList $ builtinGlobals evalE)) ++++ "\n\n== __List Of Extension Globals__\n" +++ "\nThese are not available in Jinja\n" +++ unlines (map (goItem Nothing "globals_ginger_") (Map.toAscList $ builtinGlobalsNonJinja evalE)) ++++ "\n\n== __List Of Builtin Attributes__\n" +++ "\n\n=== Bool\n" +++ unlines+ (map+ (goItem (Just "bool") "globals_bool_")+ (extractAttribsWith False builtinBoolAttribs)) +++ "\n\n=== Int\n" +++ unlines+ (map+ (goItem (Just "int") "globals_int_")+ (extractAttribsWith 0 builtinIntAttribs)) +++ "\n\n=== Float\n" +++ unlines+ (map+ (goItem (Just "float") "globals_float_")+ (extractAttribsWith 0 builtinFloatAttribs)) +++ "\n\n=== String\n" +++ unlines+ (map+ (goItem (Just "string") "globals_string_")+ (extractAttribs builtinStringAttribs)) +++ "\n\n=== List\n" +++ unlines+ (map+ (goItem (Just "list") "globals_list_")+ (extractAttribs builtinListAttribs)) +++ "\n\n=== Dict\n" +++ unlines+ (map+ (goItem (Just "dict") "globals_dict_")+ (extractAttribs builtinDictAttribs)) ++++ "\n\n== __List Of Builtin Filters__\n" +++ "\nThese will only work in a filter context, not via procedure call syntax.\n" +++ unlines (map (goItem Nothing "filters_") (Map.toAscList $ builtinFilters)) ++++ "\n\n== __List Of Builtin Tests__\n" +++ "\nThese will only work in a test context (e.g., an @is@-expression).\n\n" +++ "\nSome of these tests shadow globals of the same name but different functionality.\n\n" +++ unlines (map (goItem Nothing "tests_") (Map.toAscList $ builtinTests))+ pure []+ where+ goTy :: TypeDoc -> Text+ goTy TypeDocAny = "@any@"+ goTy TypeDocNone = "@none@"+ goTy (TypeDocSingle t) = "@" <> t <> "@"+ goTy (TypeDocAlternatives ts) =+ case Vector.unsnoc ts of+ Just (ts', t) ->+ "@" <> Text.intercalate "@, @" (Vector.toList $ ts') <> "@" <>+ ", or @" <> t <> "@"+ Nothing ->+ "@" <> Text.intercalate "@ or @" (Vector.toList $ ts) <> "@"++ goItemHeading :: Maybe Text -> Text -> Text -> [Text]+ goItemHeading namespaceMay prefix name =+ [ ""+ , "#" <> prefix <> maybe "" (<> ".") namespaceMay <> name <> "#"+ , ""+ , "=== " <> maybe "" (<> ".") namespaceMay <> name+ ]+++ goDocumentedItem :: Maybe Text -> Text -> (Identifier, ProcedureDoc) -> String+ goDocumentedItem namespaceMay prefix (name, d) =+ let qualifiedName = maybe "" (<> ".") namespaceMay <> identifierName name+ in+ Text.unpack . Text.unlines $+ goItemHeading namespaceMay prefix (identifierName name <> "()") +++ ( if qualifiedName /= procedureDocName d &&+ identifierName name /= procedureDocName d then+ [ "Alias for [" <> procedureDocName d <> "](#" <> prefix <> procedureDocName d <> ")"+ ]+ else+ [ ""+ , "__Arguments:__"+ ] +++ ( if Vector.null (procedureDocArgs d) then+ [ "none"+ , ""+ ]+ else+ [ "" ] +++ [ "* @" <> argumentDocName arg+ <> case argumentDocDefault arg of+ Nothing -> ""+ Just defval -> "=" <> defval+ <> "@"+ <> maybe "" ((" : " <>) . goTy) (argumentDocType arg)+ <> case argumentDocDefault arg of+ Nothing -> " __(required)__"+ Just _ -> ""+ <> (if argumentDocDescription arg /= "" then+ " - " <> markdownToHaddock (argumentDocDescription arg)+ else+ ""+ )+ | arg <- Vector.toList (procedureDocArgs d)+ ]+ ) +++ [ ""+ , "__Return type:__ " <> maybe "n/a" goTy (procedureDocReturnType d)+ , ""+ , markdownToHaddock $ procedureDocDescription d+ ]+ )++ goItem :: Maybe Text -> Text -> (Identifier, Value Identity) -> String+ goItem namespaceMay prefix (name, DictV subitems) =+ let qualifiedName = maybe "" (<> ".") namespaceMay <> identifierName name+ heading = Text.unpack . Text.unlines $+ [ ""+ , "=== Module \\'" <> qualifiedName <> "\\'"+ ]+ in+ heading +++ unlines+ [ goItem (Just qualifiedName) prefix (Identifier k, v)+ | (StringScalar k, v) <- Map.toAscList subitems+ ]++ goItem namespaceMay prefix (name, ProcedureV (NativeProcedure _ (Just d) _)) =+ goDocumentedItem namespaceMay prefix (name, d)+ goItem namespaceMay prefix (name, FilterV (NativeFilter (Just d) _)) =+ goDocumentedItem namespaceMay prefix (name, d)+ goItem namespaceMay prefix (name, TestV (NativeTest (Just d) _)) =+ goDocumentedItem namespaceMay prefix (name, d)+ goItem namespaceMay prefix (name, _) =+ Text.unpack . Text.unlines $+ goItemHeading namespaceMay prefix (identifierName name)
src/Language/Ginger/Interpret/Builtins.hs view
@@ -17,10 +17,10 @@ import Language.Ginger.AST import Language.Ginger.Interpret.Type+import Language.Ginger.Render (renderSyntaxText) import Language.Ginger.RuntimeError import Language.Ginger.Value-import Language.Ginger.Render (renderSyntaxText)- + import Control.Monad.Except import Control.Monad.Trans (lift) import qualified Data.Aeson as JSON@@ -30,7 +30,7 @@ import qualified Data.ByteString.Lazy as LBS import Data.Char (isUpper, isLower, isAlphaNum, isPrint, isSpace, isAlpha, isDigit, ord) import Data.Foldable (asum)-import Data.List (sortBy)+import Data.List (sortBy, minimumBy, maximumBy) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, listToMaybe, catMaybes, isJust)@@ -52,6 +52,7 @@ ) import Data.Vector (Vector) import qualified Data.Vector as V+import System.Random (uniformR) import Text.Printf (printf) import Text.Read (readMaybe) import qualified Text.Regex.TDFA as RE@@ -129,7 +130,6 @@ Text.toTitle) , ("center", ProcedureV fnCenter) , ("count", ProcedureV fnLength)- , ("date", ProcedureV fnDateFormat) , ("dictsort", ProcedureV fnDictsort) , ("e", ProcedureV fnEscape) , ("escape", ProcedureV fnEscape)@@ -180,8 +180,8 @@ ) Text.toLower) , ("map", FilterV $ fnMap evalE)- -- , ("max", undefined)- -- , ("min", undefined)+ , ("max", ProcedureV fnMax)+ , ("min", ProcedureV fnMin) , ("namespace", ProcedureV NamespaceProcedure) , ("odd", intBuiltin "builtin:odd"@@ -200,9 +200,9 @@ ) odd) -- , ("pprint", undefined)- -- , ("random", undefined)+ , ("random", ProcedureV fnRandom) -- , ("rejectattr", undefined)- -- , ("reject", undefined)+ , ("reject", FilterV $ fnReject evalE) , ("replace", ProcedureV fnStrReplace) , ("reverse", ProcedureV fnReverse) , ("round", ProcedureV fnRound)@@ -222,7 +222,7 @@ } ) (EncodedV @m . Encoded)- + ) -- , ("selectattr", undefined) , ("select", FilterV $ fnSelect evalE)@@ -231,7 +231,7 @@ , ("split", ProcedureV fnStrSplit) , ("string", ProcedureV fnToString) -- , ("striptags", undefined)- -- , ("sum", undefined)+ , ("sum", ProcedureV fnSum) , ("title", textBuiltin "builtin:title" (Just ProcedureDoc@@ -296,6 +296,7 @@ builtinGlobalsNonJinja _evalE = Map.fromList $ [ ("strip", ProcedureV fnStrStrip) , ("regex", regexModule)+ , ("date", ProcedureV fnDateFormat) , ("dateformat", ProcedureV fnDateFormat) , ("help", ProcedureV fnHelp) ]@@ -310,7 +311,7 @@ , procedureDocArgs = mempty , procedureDocReturnType = (Just $ TypeDocSingle "int") , procedureDocDescription =- Text.unlines + Text.unlines [ "Bit count (popcount)." , "Counts the number of set bits in an integer." ]@@ -346,7 +347,7 @@ , procedureDocReturnType = (Just $ TypeDocSingle "int") , procedureDocArgs = mempty , procedureDocDescription =- Text.unlines + Text.unlines [ "Bit count (popcount)." , "Counts the number of set bits." , "Since a boolean only has one bit, this will " <>@@ -559,7 +560,38 @@ builtinDictAttribs :: Monad m => BuiltinAttribs (Map Scalar (Value m)) m builtinDictAttribs = Map.fromList- [+ [ ("items", dictAttrib+ "builtin:dict:items"+ (Just ProcedureDoc+ { procedureDocName = "dict.items"+ , procedureDocArgs = mempty+ , procedureDocReturnType = (Just $ TypeDocSingle "list")+ , procedureDocDescription = "Get a list of key/value pairs from dictionary `value` as a list"+ }+ )+ Map.toList)+ , ("values", dictAttrib+ "builtin:dict:values"+ (Just ProcedureDoc+ { procedureDocName = "dict.values"+ , procedureDocArgs = mempty+ , procedureDocReturnType = (Just $ TypeDocSingle "list")+ , procedureDocDescription = "Extract the values from dictionary `value` as a list"+ }+ )+ Map.elems)+ , ("keys", dictAttrib+ "builtin:dict:keys"+ (Just ProcedureDoc+ { procedureDocName = "dict.keys"+ , procedureDocArgs = mempty+ , procedureDocReturnType = (Just $ TypeDocSingle "list")+ , procedureDocDescription = "Get a list of all keys in dict `value`"+ }+ )+ Map.keys)+ , ("get", dictProcAttrib+ fnDictGet) ] --------------------------------------------------------------------------------@@ -612,7 +644,7 @@ $ runReWith (\r h -> convertMatchOnceText $ RE.matchOnceText r h) fnReMatches :: forall m. Monad m => Procedure m-fnReMatches = mkFn3 "regex.match"+fnReMatches = mkFn3 "regex.matches" (Text.unlines [ "Match a regular expression against a string." , "Returns an array of matches, where each match is an " <>@@ -699,7 +731,7 @@ StringV s -> pure $ Text.length s ListV xs -> pure $ length xs DictV xs -> pure $ Map.size xs- x -> + x -> throwError $ ArgumentError "length"@@ -719,7 +751,7 @@ , "" ) (Just $ TypeDocSingle "encoded")- $ \ctx value ->+ $ \ctx _ value -> (EncodedV @m) <$> encodeWith ctx value @@ -770,7 +802,7 @@ (Text.unlines [ "Convert `value` to float." , "If `default` is given, values that cannot be converted " <>- " to floats will be replaced with this default value." + " to floats will be replaced with this default value." ] ) ( "value"@@ -799,7 +831,7 @@ (Text.unlines [ "Convert `value` to int." , "If `default` is given, values that cannot be converted " <>- " to integers will be replaced with this default value." + " to integers will be replaced with this default value." ] ) ( "value"@@ -840,6 +872,138 @@ $ \value -> stringify value +fnMin :: forall m. Monad m => Procedure m+fnMin = mkFn3 "min"+ "Get the minimum value from a list"+ ( "value"+ , Nothing+ , Just $ TypeDocSingle "list"+ , ""+ )+ ( "case_sensitive"+ , Just False+ , Just $ TypeDocSingle "bool"+ , "Treat upper and lowercase strings as distinct."+ )+ ( "attr"+ , Just (Nothing :: Maybe Text)+ , Just $ TypeDocSingle "string"+ , "Get the object with the min value of this attribute."+ )+ (Just TypeDocAny)+ $ \xs caseSensitive attrMay -> do+ let caseProjection =+ if caseSensitive then+ id+ else+ caseFoldValue+ attrProjection =+ case attrMay of+ Nothing -> pure+ Just attr -> fmap (fromMaybe NoneV) . eitherExceptM . flip getAttrOrItemRaw (Identifier attr)+ xs' <- mapM (fmap caseProjection . attrProjection) $ V.toList xs+ if null xs' then+ pure NoneV+ else+ pure . snd . minimumBy (\a b -> compare (fst a) (fst b)) $ zip xs' (V.toList xs)++fnMax :: forall m. Monad m => Procedure m+fnMax = mkFn3 "max"+ "Get the maximum value from a list"+ ( "value"+ , Nothing+ , Just $ TypeDocSingle "list"+ , ""+ )+ ( "case_sensitive"+ , Just False+ , Just $ TypeDocSingle "bool"+ , "Treat upper and lowercase strings as distinct."+ )+ ( "attr"+ , Just (Nothing :: Maybe Identifier)+ , Just $ TypeDocSingle "string"+ , "Get the object with the max value of this attribute."+ )+ (Just TypeDocAny)+ $ \xs caseSensitive attrMay -> do+ let caseProjection =+ if caseSensitive then+ id+ else+ caseFoldValue+ attrProjection =+ case attrMay of+ Nothing -> pure+ Just attr -> fmap (fromMaybe NoneV) . eitherExceptM . flip getAttrOrItemRaw attr+ xs' <- mapM (fmap caseProjection . attrProjection) $ V.toList xs+ if null xs' then+ pure NoneV+ else+ pure . snd . maximumBy (\a b -> compare (fst a) (fst b)) $ zip xs' (V.toList xs)++fnSum :: forall m. Monad m => Procedure m+fnSum = mkFn3 "sum"+ "Get the sum of the values in a list"+ ( "value"+ , Nothing+ , Just $ TypeDocSingle "list"+ , ""+ )+ ( "attr"+ , Just (Nothing :: Maybe Identifier)+ , Just $ TypeDocSingle "string"+ , "Use this attribute from each object in the list"+ )+ ( "start"+ , Just (Nothing :: Maybe Int)+ , Just $ TypeDocSingle "int"+ , "Start at this offset into the list"+ )+ (Just TypeDocAny)+ $ \xs attrMay startMay -> do+ let startTransform =+ case startMay of+ Nothing -> id+ Just start -> V.drop start+ attrProjection =+ case attrMay of+ Nothing -> pure+ Just attr -> fmap (fromMaybe NoneV) . eitherExceptM . flip getAttrOrItemRaw attr+ xs' <- mapM attrProjection . V.toList . startTransform $ xs+ pure . valueSum $ xs'++valueSum :: [Value m] -> Value m+valueSum = foldl' valueAdd NoneV++valueAdd :: Value m -> Value m -> Value m+valueAdd (IntV a) (IntV b) = IntV (a + b)+valueAdd NoneV x = x+valueAdd x NoneV = x+valueAdd (FloatV x) (FloatV y) = FloatV (x + y)+valueAdd x y = FloatV (asFloatValLenient 0 x + asFloatValLenient 0 y)++caseFoldValue :: Value m -> Value m+caseFoldValue (StringV t) = StringV (Text.toCaseFold t)+caseFoldValue (EncodedV (Encoded t)) = EncodedV (Encoded (Text.toCaseFold t))+caseFoldValue x = x++fnRandom :: forall m. Monad m => Procedure m+fnRandom = mkFn1' "random"+ "Pick a random element from a list"+ ( "value"+ , Nothing :: Maybe (Vector (Value m))+ , Just $ TypeDocSingle "list"+ , ""+ )+ (Just $ TypeDocAny)+ $ \_ctx rng xs -> do+ if V.null xs then+ pure NoneV+ else do+ let (i, _) = uniformR (0, V.length xs - 1) rng+ pure $ xs V.! i+ fnReverse :: forall m. Monad m => Procedure m fnReverse = mkFn1 "reverse" "Reverse a list or string"@@ -974,11 +1138,25 @@ fnSelect :: forall m. Monad m => (Expr -> GingerT m (Value m)) -> Filter m-fnSelect evalE =+fnSelect = fnSelectReject False "select" "select"++fnReject :: forall m. Monad m+ => (Expr -> GingerT m (Value m))+ -> Filter m+fnReject = fnSelectReject True "reject" "reject"++fnSelectReject :: forall m. Monad m+ => Bool+ -> Text+ -> Text+ -> (Expr -> GingerT m (Value m))+ -> Filter m+fnSelectReject invert procName procDescName evalE = NativeFilter (Just ProcedureDoc- { procedureDocName = "select"- , procedureDocArgs = + { procedureDocName =+ procName+ , procedureDocArgs = [ ArgumentDoc "value" (Just $ TypeDocSingle "list")@@ -989,7 +1167,7 @@ (Just $ TypeDocAlternatives [ "string", "filter", "test", "procedure" ]) (Just "none") ( "A filter or test to apply to each element to determine " <>- "whether to select it or not."+ "whether to " <> procDescName <> " it or not." ) , ArgumentDoc "attribute"@@ -1002,11 +1180,11 @@ ] , procedureDocReturnType = (Just $ TypeDocSingle "list") , procedureDocDescription = Text.unlines- [ "Select by a test or filter, and/or an attribute."+ [ Text.toTitle procDescName <> " by a test or filter, and/or an attribute." ] } ) $- \scrutineeE args ctx env -> runExceptT $ do+ \scrutineeE args ctx env rng -> runExceptT $ do -- This one is quite a monster, because it accepts arguments in so many -- different ways. -- Specifically:@@ -1030,7 +1208,8 @@ args varargs <- fnArg funcName "varargs" argValues (kwargs :: Map Scalar (Value m)) <- fnArg funcName "kwargs" argValues- (scrutinee :: Value m) <- eitherExceptM $ runGingerT (evalE scrutineeE) ctx env+ (scrutinee :: Value m) <- eitherExceptM $+ runGingerT (evalE scrutineeE) ctx env rng (xs :: Vector (Value m)) <- eitherExceptM $ fromValue scrutinee case varargs of@@ -1057,7 +1236,7 @@ testV' <- eitherExceptM $ runGingerT (withJinjaTests $ evalE (VarE $ Identifier name))- ctx env+ ctx env rng apply' testV' x DictV m -> do -- If it's a dict, try to find a @"__call__"@ item.@@ -1074,7 +1253,7 @@ NonCallableObjectError "non-callable native object" Just f -> eitherExceptM (f obj args') >>=- eitherExcept . asBoolVal+ eitherExcept . asTruthVal "native object to bool conversion" TestV f -> do -- If it's a test, we apply it as such, mapping the -- current list element to the variable "@" (which cannot@@ -1084,12 +1263,12 @@ -- scrutinee argument, but we have an already-evaluated -- value. let env' = env { envVars = Map.insert "@" x $ envVars env }- eitherExceptM $ runTest f (VarE "@") args' ctx env'+ eitherExceptM $ runTest f (VarE "@") args' ctx env' rng ProcedureV (NativeProcedure _ _ f) -> do -- If it's a native procedure, we can just call it without -- binding anything.- eitherExceptM (f ((Nothing, x):args') ctx) >>=- eitherExcept . asBoolVal+ eitherExceptM (f ((Nothing, x):args') ctx rng) >>=+ eitherExcept . asTruthVal "native procedure" ProcedureV (GingerProcedure env' argSpecs body) -> do -- If it's a ginger procedure, we need to prepend the -- current list element to the argument list (so it becomes@@ -1101,15 +1280,16 @@ "select callback" argSpecs ((Nothing, x):args')- eitherExceptM (runGingerT (setVars args'' >> evalE body) ctx env') >>=- eitherExcept . asBoolVal+ eitherExceptM (runGingerT (setVars args'' >> evalE body) ctx env' rng) >>=+ eitherExcept . asTruthVal "ginger procedure" _ -> -- Not something we can call. throwError $ NonCallableObjectError (tagNameOf test <> " " <> Text.show testV) - apply = apply' test+ invertFun = if invert then not else id+ apply = fmap invertFun . apply' test ListV <$> V.filterM apply xs where@@ -1133,7 +1313,7 @@ ] } ) $- \scrutineeE args ctx env -> runExceptT $ do+ \scrutineeE args ctx env rng -> runExceptT $ do -- This one is quite a monster, because it accepts arguments in so many -- different ways. -- Specifically:@@ -1155,7 +1335,7 @@ args varargs <- fnArg funcName "varargs" argValues (kwargs :: Map Scalar (Value m)) <- fnArg funcName "kwargs" argValues- (scrutinee :: Value m) <- eitherExceptM $ runGingerT (evalE scrutineeE) ctx env+ (scrutinee :: Value m) <- eitherExceptM $ runGingerT (evalE scrutineeE) ctx env rng (xs :: Vector (Value m)) <- eitherExceptM $ fromValue scrutinee -- First, let's see if an attribute was specified.@@ -1200,7 +1380,7 @@ filterV' <- eitherExceptM $ runGingerT (withJinjaFilters $ evalE (VarE $ Identifier name))- ctx env+ ctx env rng apply' filterV' x DictV m -> do -- If it's a dict, try to find a @"__call__"@ item.@@ -1226,11 +1406,11 @@ -- scrutinee argument, but we have an already-evaluated -- value. let env' = env { envVars = Map.insert "@" x $ envVars env }- eitherExceptM $ runFilter f (VarE "@") args' ctx env'+ eitherExceptM $ runFilter f (VarE "@") args' ctx env' rng ProcedureV (NativeProcedure _ _ f) -> do -- If it's a native procedure, we can just call it without -- binding anything.- eitherExceptM $ f ((Nothing, x):args') ctx+ eitherExceptM $ f ((Nothing, x):args') ctx rng ProcedureV (GingerProcedure env' argSpecs body) -> do -- If it's a ginger procedure, we need to prepend the -- current list element to the argument list (so it becomes@@ -1243,7 +1423,7 @@ argSpecs ((Nothing, x):args') eitherExceptM $- runGingerT (setVars args'' >> evalE body) ctx env'+ runGingerT (setVars args'' >> evalE body) ctx env' rng _ -> -- Not something we can call. throwError $@@ -1765,7 +1945,7 @@ EncodedV (Encoded txt) -> pure $ EncodedV . Encoded $ Text.take 1 txt BytesV arr -> pure . toValue $ BS.indexMaybe arr 0 x -> throwError $ ArgumentError "first" "value" "list or string" (tagNameOf x)- + fnLast :: forall m. Monad m => Procedure m fnLast = mkFn1 "last" "Get the last element from a list, or the last character from a string."@@ -1869,11 +2049,11 @@ , "Format strings follow the specification found here: " <> "[Date.Time.Format.formatTime](https://hackage.haskell.org/package/time-1.14/docs/Data-Time-Format.html#v:formatTime)" , "Accepted input formats:"- , "- `%Y-%m-%dT%H:%M:%S%Q%Z`"- , "- `%Y-%m-%d %H:%M:%S%Q`"- , "- `%Y-%m-%d %H:%M:%S%Q%z`"- , "- `%Y-%m-%d %H:%M:%S%Q%Z`"- , "- `%Y-%m-%d`"+ , "- `%Y-%m-%dT%H:%M:%S%Q%Z` (2025-11-28T23:54:32.1234UTC)"+ , "- `%Y-%m-%d %H:%M:%S%Q` (2025-11-28 23:54:32.1234UTC)"+ , "- `%Y-%m-%d %H:%M:%S%Q%z` (2025-11-28 23:54:32.1234+0100)"+ , "- `%Y-%m-%d %H:%M:%S%Q%Z` (2025-11-28 23:54:32.1234UTC)"+ , "- `%Y-%m-%d` (2025-11-28)" ] ) ( "date"@@ -1937,6 +2117,30 @@ _ -> pure NoneV +fnDictGet :: forall m. Monad m => Procedure m+fnDictGet = mkFn3 "dict.get"+ "Get an item from a dictionary."+ ( "value"+ , Nothing :: Maybe (Map Scalar (Value m))+ , Just $ TypeDocSingle "dict"+ , ""+ )+ ( "key"+ , Nothing+ , Just $ TypeDocSingle "scalar"+ , ""+ )+ ( "default"+ , Just NoneV :: Maybe (Value m)+ , Just $ TypeDocAny+ , ""+ )+ (Just $ TypeDocAny)+ $ \value key defval -> do+ case Map.lookup key value of+ Nothing -> pure defval+ Just v -> pure v+ isUpperVal :: Value m -> Value m isUpperVal (StringV txt) = BoolV (Text.all isUpper txt) isUpperVal (EncodedV (Encoded txt)) = BoolV (Text.all isUpper txt)@@ -2275,13 +2479,44 @@ textProcAttrib f = pureAttrib $ nativeMethod f . StringV +dictProp :: (Monad m, ToValue a m)+ => (Map Scalar (Value m) -> a)+ -> Map Scalar (Value m)+ -> m (Either RuntimeError (Value m))+dictProp f t = pure . Right . toValue $ f t++dictAttrib :: (Monad m, ToValue a m)+ => ObjectID+ -> Maybe ProcedureDoc+ -> (Map Scalar (Value m) -> a)+ -> Map Scalar (Value m)+ -> m (Either RuntimeError (Value m))+dictAttrib oid doc f =+ pureAttrib $ nativePureMethod oid doc (dictFunc (pure . f)) . DictV++dictNProcAttrib :: (Monad m, ToNativeProcedure m a)+ => ObjectID+ -> Maybe ProcedureDoc+ -> (Value m -> a)+ -> Map Scalar (Value m)+ -> m (Either RuntimeError (Value m))+dictNProcAttrib oid doc f =+ pureAttrib $ toNativeMethod oid doc f . DictV++dictProcAttrib :: Monad m+ => Procedure m+ -> Map Scalar (Value m)+ -> m (Either RuntimeError (Value m))+dictProcAttrib f =+ pureAttrib $ nativeMethod f . DictV+ builtinNotImplemented :: Monad m => Text -> Value m builtinNotImplemented name = ProcedureV $- NativeProcedure + NativeProcedure (ObjectID $ "builtin:not_implemented:" <> name) Nothing- $ \_ _ ->+ $ \_ _ _ -> pure . Left $ NotImplementedError name fnMaybeArg :: Monad m => Text -> Text -> Maybe b -> ExceptT RuntimeError m b@@ -2324,7 +2559,7 @@ => Text -> Text -> Maybe TypeDoc- -> (Context m -> ExceptT RuntimeError m r)+ -> (Context m -> SomePRNG -> ExceptT RuntimeError m r) -> Procedure m mkFn0' funcName desc retType f = NativeProcedure (ObjectID $ "builtin:" <> funcName)@@ -2335,13 +2570,13 @@ , procedureDocDescription = desc } )- $ \args ctx -> runExceptT $ do+ $ \args ctx rng -> runExceptT $ do _ <- eitherExcept $ resolveArgs funcName [] args- toValue <$> f ctx+ toValue <$> f ctx rng mkFn0 :: ( Monad m , ToValue r m@@ -2352,7 +2587,7 @@ -> (ExceptT RuntimeError m r) -> Procedure m mkFn0 funcName desc retType f =- mkFn0' funcName desc retType (const f)+ mkFn0' funcName desc retType (const . const $ f) mkFn1' :: forall m a r. ( Monad m@@ -2364,7 +2599,7 @@ -> Text -> (Identifier, Maybe a, Maybe TypeDoc, Text) -> Maybe TypeDoc- -> (Context m -> a -> ExceptT RuntimeError m r)+ -> (Context m -> SomePRNG -> a -> ExceptT RuntimeError m r) -> Procedure m mkFn1' funcName desc (argname1, default1, typedoc1, argdesc1) retType f = NativeProcedure (ObjectID $ "builtin:" <> funcName)@@ -2377,7 +2612,7 @@ , procedureDocDescription = desc } )- $ \args ctx -> runExceptT $ do+ $ \args ctx rng -> runExceptT $ do argValues <- eitherExcept $ resolveArgs funcName@@ -2385,7 +2620,7 @@ ] args arg1 <- fnArg funcName argname1 argValues- toValue <$> f ctx arg1+ toValue <$> f ctx rng arg1 mkFn1 :: ( Monad m , ToValue a m@@ -2399,7 +2634,7 @@ -> (a -> ExceptT RuntimeError m r) -> Procedure m mkFn1 funcName a desc retType f =- mkFn1' funcName a desc retType (const f)+ mkFn1' funcName a desc retType (const . const $ f) mkFn2' :: forall m a1 a2 r. ( Monad m@@ -2414,7 +2649,7 @@ -> (Identifier, Maybe a1, Maybe TypeDoc, Text) -> (Identifier, Maybe a2, Maybe TypeDoc, Text) -> Maybe TypeDoc- -> (Context m -> a1 -> a2 -> ExceptT RuntimeError m r)+ -> (Context m -> SomePRNG -> a1 -> a2 -> ExceptT RuntimeError m r) -> Procedure m mkFn2' funcName desc (argname1, default1, typedoc1, argdesc1)@@ -2432,7 +2667,7 @@ , procedureDocDescription = desc } )- $ \args ctx -> runExceptT $ do+ $ \args ctx rng -> runExceptT $ do argValues <- eitherExcept $ resolveArgs funcName@@ -2442,7 +2677,7 @@ args arg1 <- fnArg funcName argname1 argValues arg2 <- fnArg funcName argname2 argValues- toValue <$> f ctx arg1 arg2+ toValue <$> f ctx rng arg1 arg2 mkFn2 :: ( Monad m , ToValue a1 m@@ -2459,7 +2694,7 @@ -> (a1 -> a2 -> ExceptT RuntimeError m r) -> Procedure m mkFn2 funcName desc a b retType f =- mkFn2' funcName desc a b retType (const f)+ mkFn2' funcName desc a b retType (const . const $ f) mkFn3' :: forall m a1 a2 a3 r. ( Monad m@@ -2477,7 +2712,7 @@ -> (Identifier, Maybe a2, Maybe TypeDoc, Text) -> (Identifier, Maybe a3, Maybe TypeDoc, Text) -> Maybe TypeDoc- -> (Context m -> a1 -> a2 -> a3 -> ExceptT RuntimeError m r)+ -> (Context m -> SomePRNG -> a1 -> a2 -> a3 -> ExceptT RuntimeError m r) -> Procedure m mkFn3' funcName desc (argname1, default1, typedoc1, argdesc1)@@ -2497,7 +2732,7 @@ , procedureDocDescription = desc } )- $ \args ctx -> runExceptT $ do+ $ \args ctx rng -> runExceptT $ do argValues <- eitherExcept $ resolveArgs funcName@@ -2509,7 +2744,7 @@ arg1 <- fnArg funcName argname1 argValues arg2 <- fnArg funcName argname2 argValues arg3 <- fnArg funcName argname3 argValues- toValue <$> f ctx arg1 arg2 arg3+ toValue <$> f ctx rng arg1 arg2 arg3 mkFn3 :: ( Monad m , ToValue a1 m@@ -2529,7 +2764,7 @@ -> (a1 -> a2 -> a3 -> ExceptT RuntimeError m r) -> Procedure m mkFn3 funcName desc a b c retType f =- mkFn3' funcName desc a b c retType (const f)+ mkFn3' funcName desc a b c retType (const . const $ f) mkFn4' :: forall m a1 a2 a3 a4 r. ( Monad m@@ -2550,7 +2785,7 @@ -> (Identifier, Maybe a3, Maybe TypeDoc, Text) -> (Identifier, Maybe a4, Maybe TypeDoc, Text) -> Maybe TypeDoc- -> (Context m -> a1 -> a2 -> a3 -> a4 -> ExceptT RuntimeError m r)+ -> (Context m -> SomePRNG -> a1 -> a2 -> a3 -> a4 -> ExceptT RuntimeError m r) -> Procedure m mkFn4' funcName desc (argname1, default1, typedoc1, argdesc1)@@ -2572,7 +2807,7 @@ , procedureDocDescription = desc } )- $ \args ctx -> runExceptT $ do+ $ \args ctx rng -> runExceptT $ do argValues <- eitherExcept $ resolveArgs funcName@@ -2586,7 +2821,7 @@ arg2 <- fnArg funcName argname2 argValues arg3 <- fnArg funcName argname3 argValues arg4 <- fnArg funcName argname4 argValues- toValue <$> f ctx arg1 arg2 arg3 arg4+ toValue <$> f ctx rng arg1 arg2 arg3 arg4 mkFn4 :: ( Monad m , ToValue a1 m@@ -2609,4 +2844,4 @@ -> (a1 -> a2 -> a3 -> a4 -> ExceptT RuntimeError m r) -> Procedure m mkFn4 funcName desc a b c d retType f =- mkFn4' funcName desc a b c d retType (const f)+ mkFn4' funcName desc a b c d retType (const . const $ f)
src/Language/Ginger/Interpret/DefEnv.hs view
@@ -18,8 +18,8 @@ import Language.Ginger.Interpret.Builtins import Language.Ginger.Interpret.Eval import Language.Ginger.Interpret.Type-import Language.Ginger.RuntimeError import Language.Ginger.Render+import Language.Ginger.RuntimeError import Language.Ginger.Value import Control.Monad.Except@@ -32,6 +32,7 @@ import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Vector as V+import qualified System.Random as R defEnv :: Monad m => Env m defEnv =@@ -71,7 +72,47 @@ [ ( "__jinja__" , dictV [ ( "tests"- , dictV+ , DictV . Map.mapKeys toScalar $ builtinTests+ )+ , ( "filters"+ , DictV . Map.mapKeys toScalar $ builtinFilters+ )+ , ( "globals"+ , DictV . Map.mapKeys toScalar $ builtinGlobals evalE+ )+ ]+ )+ ]+ <> builtinGlobals evalE++defVarsCompat :: forall m. Monad m+ => Map Identifier (Value m)+defVarsCompat = defVarsCommon++defVars :: forall m. Monad m+ => Map Identifier (Value m)+defVars = defVarsCommon+ <> builtinGlobalsNonJinja evalE+ <> Map.fromList+ [ ( "__ginger__"+ , dictV+ [ ( "globals"+ , DictV . Map.mapKeys toScalar $ builtinGlobalsNonJinja evalE+ )+ ]+ )+ ]++builtinFilters :: forall m. Monad m+ => Map Identifier (Value m)+builtinFilters = Map.fromList+ [ ("default", FilterV $ defaultFilter)+ , ("d", FilterV $ defaultFilter)+ ]++builtinTests :: forall m. Monad m+ => Map Identifier (Value m)+builtinTests = Map.fromList [ ("defined", TestV $ NativeTest (Just ProcedureDoc@@ -291,39 +332,7 @@ ) (isNone :: Value m -> Value m)) ]- )- , ( "filters"- , dictV- [ ("default", FilterV $ defaultFilter)- , ("d", FilterV $ defaultFilter)- ]- )- , ( "globals"- , DictV . Map.mapKeys toScalar $ builtinGlobals evalE- )- ]- )- ]- <> builtinGlobals evalE -defVarsCompat :: forall m. Monad m- => Map Identifier (Value m)-defVarsCompat = defVarsCommon--defVars :: forall m. Monad m- => Map Identifier (Value m)-defVars = defVarsCommon- <> builtinGlobalsNonJinja evalE- <> Map.fromList- [ ( "__ginger__"- , dictV- [ ( "globals"- , DictV . Map.mapKeys toScalar $ builtinGlobalsNonJinja evalE- )- ]- )- ]- isCallable' :: Monad m => Value m -> Bool isCallable' (ProcedureV {}) = True isCallable' (NativeV n) =@@ -336,8 +345,9 @@ isCallable = BoolV . isCallable' isFilter :: Monad m => TestFunc m-isFilter expr _ ctx env = do- result <- runGingerT (evalE expr) ctx env+isFilter expr _ ctx env rng = do+ let (rngL, rngR) = R.splitGen rng+ result <- runGingerT (evalE expr) ctx env rngL case result of Right (StringV name) -> do let exists =@@ -348,7 +358,7 @@ (asBool "" =<< eval (InE (StringLitE name) (DotE (VarE "__jinja__") "filters")))- ctx env+ ctx env rngR pure $ (exists ||) <$> existsExt Right a -> pure . Left $ TagError "filter name" "string" (tagNameOf a)@@ -372,8 +382,8 @@ isSequence _ = FalseV isTest :: Monad m => TestFunc m-isTest expr _ ctx env = do- result <- runGingerT (evalE expr) ctx env+isTest expr _ ctx env rng = do+ result <- runGingerT (evalE expr) ctx env rng case result of Right NoneV -> pure . Right $ True Right BoolV {} -> pure . Right $ True@@ -392,7 +402,7 @@ case existing of Just a -> pure . Right $ isCallable' a _ -> pure . Right $ False- + Right a -> pure . Left $ TagError "test name" "string" (tagNameOf a) Left err ->@@ -438,8 +448,8 @@ "`value` otherwise." } ) $- \expr args ctx env -> do- calleeEither <- runGingerT (evalE expr) ctx env+ \expr args ctx env rng -> do+ calleeEither <- runGingerT (evalE expr) ctx env rng let resolvedArgsEither = resolveArgs "default" [("default_value", Just (StringV "")), ("boolean", Just FalseV)]@@ -459,85 +469,90 @@ (Left err, _) -> pure . Left $ err -isDefined :: Monad m => TestFunc m-isDefined _ (_:_) _ _ = pure $ Left $ ArgumentError "defined" "0" "end of arguments" "argument"-isDefined (PositionedE _ e) [] ctx env =- isDefined e [] ctx env-isDefined (VarE name) [] ctx env =- pure . Right $- name `Map.member` (envVars env) ||- name `Map.member` (contextVars ctx)-isDefined NoneE [] _ _ = pure . Right $ True-isDefined BoolE {} [] _ _ = pure . Right $ True-isDefined StringLitE {} [] _ _ = pure . Right $ True-isDefined IntLitE {} [] _ _ = pure . Right $ True-isDefined FloatLitE {} [] _ _ = pure . Right $ True-isDefined (SliceE slicee startMay endMay) [] ctx env = do- definedSlicee <- isDefined slicee [] ctx env- definedStart <- maybe (pure . Right $ True) (\start -> isDefined start [] ctx env) startMay- definedEnd <- maybe (pure . Right $ True) (\end -> isDefined end [] ctx env) endMay- pure $ allEitherBool [ definedSlicee, definedStart, definedEnd ]-isDefined (IndexE parent selector) [] ctx env = do- definedParent <- isDefined parent [] ctx env- case definedParent of- Right True -> do- result <- runGingerT (evalE (InE selector parent)) ctx env- case result of- Left (NotInScopeError {}) -> pure . Right $ False- Left err -> pure . Left $ err- Right (BoolV b) -> pure . Right $ b- Right _ -> pure . Left $ FatalError "Evaluating an 'in' expression produced non-boolean result"- x -> pure x-isDefined (UnaryE _ a) [] ctx env =- isDefined a [] ctx env-isDefined (BinaryE _ a b) [] ctx env = do- definedA <- isDefined a [] ctx env- definedB <- isDefined b [] ctx env- pure $ (&&) <$> definedA <*> definedB-isDefined (DotE a _b) [] ctx env = do- isDefined a [] ctx env-isDefined (TernaryE c a b) [] ctx env = do- definedA <- isDefined a [] ctx env- definedB <- isDefined b [] ctx env- definedC <- isDefined c [] ctx env- pure $ allEitherBool [definedA, definedB, definedC]-isDefined (ListE v) [] ctx env =- case V.uncons v of- Nothing -> pure . Right $ True- Just (x, xs) -> do- definedX <- isDefined x [] ctx env- definedXS <- isDefined (ListE xs) [] ctx env- pure $ allEitherBool [definedX, definedXS]-isDefined (DictE []) [] _ _ = pure . Right $ True-isDefined (DictE ((k, v):xs)) [] ctx env = do- definedK <- isDefined k [] ctx env- definedV <- isDefined v [] ctx env- definedXS <- isDefined (DictE xs) [] ctx env- pure $ allEitherBool [definedK, definedV, definedXS]-isDefined (IsE {}) [] _ _ = pure . Right $ True-isDefined (StatementE {}) [] _ _ = pure . Right $ True-isDefined (FilterE posArg0 callee posArgs kwArgs) [] ctx env = do- definedPosArg0 <- isDefined posArg0 [] ctx env- definedCallee <- isDefined callee [] ctx env- definedPosArgs <- allEitherBool <$> mapM (\x -> isDefined x [] ctx env) posArgs- definedKWArgs <- allEitherBool <$> mapM (\(_, x) -> isDefined x [] ctx env) kwArgs- pure $ allEitherBool [definedPosArg0, definedCallee, definedPosArgs, definedKWArgs]-isDefined (CallE callee posArgs kwArgs) [] ctx env = do- definedCallee <- isDefined callee [] ctx env- definedPosArgs <- allEitherBool <$> mapM (\x -> isDefined x [] ctx env) posArgs- definedKWArgs <- allEitherBool <$> mapM (\(_, x) -> isDefined x [] ctx env) kwArgs- pure $ allEitherBool [definedCallee, definedPosArgs, definedKWArgs]+isDefined :: forall m. Monad m => TestFunc m+isDefined _ (_:_) _ _ _ = pure $ Left $ ArgumentError "defined" "0" "end of arguments" "argument"+isDefined value [] ctx env rng = go value+ where+ go :: Expr -> m (Either RuntimeError Bool)+ go (PositionedE _ e) =+ go e+ go (VarE name) =+ pure . Right $+ name `Map.member` (envVars env) ||+ name `Map.member` (contextVars ctx)+ go NoneE = pure . Right $ True+ go BoolE {} = pure . Right $ True+ go StringLitE {} = pure . Right $ True+ go IntLitE {} = pure . Right $ True+ go FloatLitE {} = pure . Right $ True+ go (SliceE slicee startMay endMay) = do+ definedSlicee <- go slicee+ definedStart <- maybe (pure . Right $ True) (\start -> go start) startMay+ definedEnd <- maybe (pure . Right $ True) (\end -> go end) endMay+ pure $ allEitherBool [ definedSlicee, definedStart, definedEnd ]+ go (IndexE parent selector) = do+ definedParent <- go parent+ case definedParent of+ Right True -> do+ result <- runGingerT (evalE (InE selector parent)) ctx env rng+ case result of+ Left (NotInScopeError {}) -> pure . Right $ False+ Left err -> pure . Left $ err+ Right (BoolV b) -> pure . Right $ b+ Right _ -> pure . Left $ FatalError "Evaluating an 'in' expression produced non-boolean result"+ x -> pure x+ go (UnaryE _ a) =+ go a+ go (BinaryE _ a b) = do+ definedA <- go a+ definedB <- go b+ pure $ (&&) <$> definedA <*> definedB+ go (DotE a _b) = do+ go a+ go (TernaryE c a b) = do+ definedA <- go a+ definedB <- go b+ definedC <- go c+ pure $ allEitherBool [definedA, definedB, definedC]+ go (ListE v) =+ case V.uncons v of+ Nothing -> pure . Right $ True+ Just (x, xs) -> do+ definedX <- go x+ definedXS <- go (ListE xs)+ pure $ allEitherBool [definedX, definedXS]+ go (DictE []) = pure . Right $ True+ go (DictE ((k, v):xs)) = do+ definedK <- go k+ definedV <- go v+ definedXS <- go (DictE xs)+ pure $ allEitherBool [definedK, definedV, definedXS]+ go (IsE {}) = pure . Right $ True+ go (StatementE {}) = pure . Right $ True+ go (FilterE posArg0 callee posArgs kwArgs) = do+ definedPosArg0 <- go posArg0+ definedCallee <- go callee+ definedPosArgs <- allEitherBool <$> mapM (\x -> go x) posArgs+ definedKWArgs <- allEitherBool <$> mapM (\(_, x) -> go x) kwArgs+ pure $ allEitherBool [definedPosArg0, definedCallee, definedPosArgs, definedKWArgs]+ go (CallE callee posArgs kwArgs) = do+ definedCallee <- go callee+ definedPosArgs <- allEitherBool <$> mapM (\x -> go x) posArgs+ definedKWArgs <- allEitherBool <$> mapM (\(_, x) -> go x) kwArgs+ pure $ allEitherBool [definedCallee, definedPosArgs, definedKWArgs] isUndefined :: Monad m => TestFunc m-isUndefined expr args ctx env = do- defined <- isDefined expr args ctx env+isUndefined expr args ctx env rng = do+ defined <- isDefined expr args ctx env rng pure $ not <$> defined isEqual :: Monad m => TestFunc m-isEqual expr args ctx env = runGingerT go ctx env+isEqual expr args ctx env rng =+ runGingerT go ctx env rng where go = do- definedLHS <- native $ isDefined expr args ctx env+ rng' <- splitRNG+ definedLHS <- native $ isDefined expr args ctx env rng' if definedLHS then do val <- eval expr equals <- mapM (valuesEqual val . snd) args
src/Language/Ginger/Interpret/Eval.hs view
@@ -22,11 +22,13 @@ , stringify , valuesEqual , asBool+, asTruth , getAttr , getAttrRaw , getItem , getItemRaw , loadTemplate+, splitRNG ) where @@ -36,8 +38,8 @@ import Language.Ginger.Parse (parseGinger) import qualified Language.Ginger.Parse as Parse import Language.Ginger.RuntimeError-import Language.Ginger.Value import Language.Ginger.SourcePosition+import Language.Ginger.Value import Control.Monad (foldM, forM, void) import Control.Monad.Except@@ -45,21 +47,22 @@ , throwError ) import Control.Monad.Reader (ask , asks, local, MonadReader (..))-import Control.Monad.State (gets)+import Control.Monad.State (gets, modify) import Control.Monad.Trans (lift, MonadTrans (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LBS+import Data.Digest.Pure.SHA (sha256, showDigest) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text+import Data.Text.Encoding (encodeUtf8) import Data.Vector (Vector) import qualified Data.Vector as V-import Data.Digest.Pure.SHA (sha256, showDigest)-import Data.Text.Encoding (encodeUtf8)+import qualified System.Random as R hashShow :: Show a => a -> Text hashShow = Text.pack . showDigest . sha256 . LBS.fromStrict . encodeUtf8 . Text.show@@ -134,6 +137,13 @@ namedArgs <- mapM evalNamedArg namedArgsExpr pure $ zip (repeat Nothing) posArgs ++ namedArgs +splitRNG :: Monad m => GingerT m SomePRNG+splitRNG = do+ rng <- gets evalPRNG+ let (rngL, rngR) = R.splitGen rng+ modify (\e -> e { evalPRNG = rngL })+ pure rngR+ callTest :: Monad m => Value m -> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m) callTest testV scrutinee posArgsExpr namedArgsExpr = do case testV of@@ -141,7 +151,8 @@ args <- evalCallArgs posArgsExpr namedArgsExpr ctx <- ask env <- gets evalEnv- BoolV <$> native (runTest t scrutinee args ctx env)+ rng <- splitRNG+ BoolV <$> native (runTest t scrutinee args ctx env rng) ScalarV {} -> do BoolV <$> (valuesEqual testV =<< evalE scrutinee)@@ -159,7 +170,8 @@ args <- evalCallArgs posArgsExpr namedArgsExpr ctx <- ask env <- gets evalEnv- native (runFilter f scrutinee args ctx env)+ rng <- splitRNG+ native (runFilter f scrutinee args ctx env rng) ScalarV {} -> do BoolV <$> (valuesEqual filterV =<< evalE scrutinee)@@ -178,7 +190,8 @@ ProcedureV (NativeProcedure _ _ f) -> withEnv mempty $ do ctx <- ask- native $ f args ctx+ rng <- splitRNG+ native $ f args ctx rng ProcedureV (GingerProcedure env argsSig f) -> do withEnv env $ do maybe (pure ()) (setVar "caller") callerMay@@ -263,7 +276,7 @@ f <- withJinjaFilters (eval filterE) callFilter f scrutinee args kwargs evalE' (TernaryE condExpr yesExpr noExpr) = do- cond <- evalE condExpr >>= asBool "condition"+ cond <- evalE condExpr >>= asTruth "condition" evalE (if cond then yesExpr else noExpr) evalE' (VarE name) = lookupVar name@@ -329,20 +342,20 @@ -> Maybe (Value m) -> GingerT m (Value m) sliceValue (ListV xs) startValMay endValMay = do- startMay <- mapM (native . pure . asIntVal) startValMay- endMay <- mapM (native . pure . asIntVal) endValMay+ startMay <- mapM (native . pure . asIntVal "slice start") startValMay+ endMay <- mapM (native . pure . asIntVal "slice end") endValMay pure . ListV $ sliceVector xs (fromIntegral <$> startMay) (fromIntegral <$> endMay) sliceValue (StringV xs) startValMay endValMay = do- startMay <- mapM (native . pure . asIntVal) startValMay- endMay <- mapM (native . pure . asIntVal) endValMay+ startMay <- mapM (native . pure . asIntVal "slice start") startValMay+ endMay <- mapM (native . pure . asIntVal "slice end") endValMay pure . StringV $ sliceText xs (fromIntegral <$> startMay) (fromIntegral <$> endMay) sliceValue (BytesV xs) startValMay endValMay = do- startMay <- mapM (native . pure . asIntVal) startValMay- endMay <- mapM (native . pure . asIntVal) endValMay+ startMay <- mapM (native . pure . asIntVal "slice start") startValMay+ endMay <- mapM (native . pure . asIntVal "slice end") endValMay pure . BytesV $ sliceByteString xs (fromIntegral <$> startMay) (fromIntegral <$> endMay) sliceValue (EncodedV (Encoded xs)) startValMay endValMay = do- startMay <- mapM (native . pure . asIntVal) startValMay- endMay <- mapM (native . pure . asIntVal) endValMay+ startMay <- mapM (native . pure . asIntVal "slice start") startValMay+ endMay <- mapM (native . pure . asIntVal "slice end") endValMay pure . EncodedV . Encoded $ sliceText xs (fromIntegral <$> startMay) (fromIntegral <$> endMay) sliceValue x _ _ = throwError $@@ -570,7 +583,7 @@ iteree <- evalE itereeE evalLoop loopKeyMay loopName iteree loopCondMay recursivity bodyS elseSMay 0 evalS (IfS condE yesS noSMay) = do- cond <- evalE condE >>= asBool "condition"+ cond <- evalE condE >>= asTruth "condition" if cond then evalS yesS else maybe (pure NoneV) evalS noSMay evalS (MacroS name argsSig body) = do env <- gets evalEnv@@ -601,7 +614,7 @@ "current macro." } )- (const . const . pure . Right $ callerVal)+ (const . const . const . pure . Right $ callerVal) call (Just caller) callee posArgsExpr namedArgsExpr evalS (FilterS name posArgsExpr namedArgsExpr bodyS) = whenOutputPolicy $ do callee <- lookupVar name@@ -718,6 +731,7 @@ makeSuper (Just lblock) = do ctx <- ask env <- gets evalEnv+ rng <- splitRNG parent <- makeSuper (loadedBlockParent lblock) pure $ dictV [ "__call__" .=@@ -730,15 +744,17 @@ (evalS . blockBody . loadedBlock $ lblock) ctx env+ rng ) , "super" .= parent ] asBool :: Monad m => Text -> Value m -> GingerT m Bool-asBool _ (BoolV b) = pure b-asBool _ NoneV = pure False-asBool context x = throwError $ TagError context "boolean" (tagNameOf x)+asBool context x = either throwError pure $ asBoolVal context x +asTruth :: Monad m => Text -> Value m -> GingerT m Bool+asTruth context x = either throwError pure $ asTruthVal context x+ evalLoop :: forall m. Monad m => Maybe Identifier -> Identifier@@ -777,7 +793,7 @@ -- Bind key and value maybe (pure ()) (\loopKey -> setVar loopKey k) loopKeyMay setVar loopName v- asBool "loop condition" =<< evalE condE+ asTruth "loop condition" =<< evalE condE rest <- goFilter xs condE if keep then pure $ V.cons (k, v) rest@@ -841,7 +857,7 @@ "Recurse one level deeper into the iteree" } )- $ \args ctx -> do+ $ \args ctx rng -> do case args of [(_, iteree')] -> runGingerT@@ -856,6 +872,7 @@ (succ recursionLevel)) ctx env+ rng [] -> pure . Left $ ArgumentError "loop()" "1" "argument" "end of arguments" _ -> pure . Left $@@ -882,7 +899,7 @@ "cycle(items) will return items[n % length(items)]." } )- $ \args _ctx -> do+ $ \args _ctx _rng -> do case args of [(_, items)] -> case items of
src/Language/Ginger/Interpret/Type.hs view
@@ -46,6 +46,7 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as Text+import System.Random (SplitGen (..)) -- | The Ginger interpreter monad. Provides error reporting / handling via -- 'MonadError', an execution context ('Context'), and an evaluation state@@ -64,6 +65,7 @@ , evalLoadedTemplates :: !(Map Text CachedTemplate) , evalBlocks :: !(Map Identifier LoadedBlock) , evalSourcePosition :: !(Maybe SourcePosition)+ , evalPRNG :: !SomePRNG } data LoadedBlock =@@ -82,6 +84,7 @@ , evalLoadedTemplates = evalLoadedTemplates a <> evalLoadedTemplates b , evalBlocks = evalBlocks a <> evalBlocks b , evalSourcePosition = evalSourcePosition a <|> evalSourcePosition b+ , evalPRNG = evalPRNG a } data CachedTemplate@@ -94,12 +97,26 @@ , loadedTemplateBody :: !Statement } -runGingerT :: Monad m => GingerT m a -> Context m -> Env m -> m (Either RuntimeError a)-runGingerT g ctx env =+runGingerT :: (Monad m, SplitGen g)+ => GingerT m a+ -> Context m+ -> Env m+ -> g+ -> m (Either RuntimeError a)+runGingerT g ctx env rng = runExceptT (evalStateT (runReaderT (unGingerT g) ctx)- (EvalState env { envRootMay = Just env } mempty (RefID 0) mempty mempty Nothing)+ (EvalState+ { evalEnv = env { envRootMay = Just env }+ , evalMutables = mempty+ , evalNextRefID = RefID 0+ , evalLoadedTemplates = mempty+ , evalBlocks = mempty+ , evalSourcePosition = Nothing+ , evalPRNG = SomePRNG rng+ }+ ) ) decorateError :: Monad m
src/Language/Ginger/Parse.hs view
@@ -662,9 +662,19 @@ where body = do yes <- statement- noMay <- optional $ flow_ "else" *> statement+ elifs <- many $ do+ cond' <- flow "elif" expr+ body' <- statement+ pure (cond', body')+ finalElseMay <- optional $ flow_ "else" *> statement+ let noMay = mergeElifs elifs finalElseMay pure (yes, noMay)- makeIf cond (yes, noMay) = IfS cond yes noMay+ makeIf cond (yes, noMay) = IfS cond yes noMay ++ mergeElifs :: [(Expr, Statement)] -> Maybe Statement -> Maybe Statement+ mergeElifs [] noMay = noMay+ mergeElifs ((cond', body'):elifs) noMay =+ Just $ IfS cond' body' (mergeElifs elifs noMay) forStatement :: P Statement forStatement = do
src/Language/Ginger/SourcePosition.hs view
@@ -10,7 +10,7 @@ , sourceLine :: !Int , sourceColumn :: !Int }- deriving (Show, Eq)+ deriving (Show, Eq, Ord) prettySourcePosition :: SourcePosition -> String prettySourcePosition s =
src/Language/Ginger/Value.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ExistentialQuantification #-} module Language.Ginger.Value where@@ -42,18 +43,39 @@ import qualified Data.Vector as V import Data.Word import GHC.Float (float2Double)+import System.Random (RandomGen (..), SplitGen (..)) import Test.Tasty.QuickCheck (Arbitrary (..)) import qualified Test.Tasty.QuickCheck as QC+import Text.Read (readMaybe) import Language.Ginger.AST import Language.Ginger.RuntimeError +data SomePRNG =+ forall g. (SplitGen g) => SomePRNG { unPRNG :: g }++instance RandomGen SomePRNG where+ genWord32 (SomePRNG g) =+ (i, SomePRNG g')+ where+ (i, g') = genWord32 g+ genWord64 (SomePRNG g) =+ (i, SomePRNG g')+ where+ (i, g') = genWord64 g++instance SplitGen SomePRNG where+ splitGen (SomePRNG g) =+ (SomePRNG a, SomePRNG b)+ where+ (a, b) = splitGen g+ data Env m = Env { envVars :: !(Map Identifier (Value m)) , envRootMay :: Maybe (Env m) }- deriving (Eq)+ deriving (Eq, Ord) envRoot :: Env m -> Env m envRoot e =@@ -168,6 +190,7 @@ | TestV !(Test m) | FilterV !(Filter m) | MutableRefV !RefID+ deriving (Ord) instance FromJSON (Value m) where parseJSON v@JSON.Object {} = DictV <$> parseJSON v@@ -192,9 +215,24 @@ show (ListV xs) = "ListV " ++ show xs show (DictV m) = "DictV " ++ show (Map.toAscList m) show (NativeV {}) = "<<native>>"+ show (ProcedureV (NativeProcedure oid _ _)) = "<<procedure:" ++ Text.unpack (unObjectID oid) ++ ">>" show (ProcedureV {}) = "<<procedure>>"- show (TestV {}) = "<<test>>"- show (FilterV {}) = "<<filter>>"+ show (TestV t) =+ "<<test" +++ Text.unpack (+ maybe ""+ ((":" <>) . procedureDocName)+ (testDoc t)+ ) +++ ">>"+ show (FilterV f) =+ "<<filter" +++ Text.unpack (+ maybe ""+ ((":" <>) . procedureDocName)+ (filterDoc f)+ ) +++ ">>" show (MutableRefV i) = show i instance Eq (Value m) where@@ -241,7 +279,7 @@ pattern FloatV v = ScalarV (FloatScalar v) newtype ObjectID = ObjectID { unObjectID :: Text }- deriving (Eq)+ deriving (Eq, Ord) instance IsString ObjectID where fromString = ObjectID . Text.pack@@ -251,7 +289,7 @@ | TypeDocAny | TypeDocSingle !Text | TypeDocAlternatives !(Vector Text)- deriving (Show)+ deriving (Show, Eq) instance ToValue TypeDoc m where toValue TypeDocNone = StringV "none"@@ -267,7 +305,7 @@ , argumentDocDefault :: !(Maybe Text) , argumentDocDescription :: !Text }- deriving (Show)+ deriving (Show, Eq) instance ToValue ArgumentDoc m where toValue a =@@ -285,8 +323,11 @@ , procedureDocReturnType :: !(Maybe TypeDoc) , procedureDocDescription :: !Text }- deriving (Show)+ deriving (Show, Eq) +instance Ord ProcedureDoc where+ compare = compareBy procedureDocName+ instance ToValue ProcedureDoc m where toValue d = dictV@@ -302,11 +343,23 @@ !(Maybe ProcedureDoc) !( [(Maybe Identifier, Value m)] -> Context m+ -> SomePRNG -> m (Either RuntimeError (Value m)) ) | GingerProcedure !(Env m) ![(Identifier, Maybe (Value m))] !Expr | NamespaceProcedure +instance Ord (Procedure m) where+ compare NamespaceProcedure NamespaceProcedure = EQ+ compare NamespaceProcedure _ = GT+ compare _ NamespaceProcedure = LT+ compare (GingerProcedure e1 args1 body1) (GingerProcedure e2 args2 body2) =+ compare (e1, args1, body1) (e2, args2, body2)+ compare GingerProcedure {} _ = GT+ compare _ GingerProcedure {} = LT+ compare (NativeProcedure oid1 _ _) (NativeProcedure oid2 _ _) =+ compare oid1 oid2+ instance Eq (Procedure m) where NativeProcedure a _ _ == NativeProcedure b _ _ = a == b@@ -321,7 +374,7 @@ -> ([(Maybe Identifier, Value m)] -> Either RuntimeError (Value m)) -> Procedure m pureNativeProcedure oid doc f =- NativeProcedure oid doc $ \args _ -> pure (f args)+ NativeProcedure oid doc $ \args _ _ -> pure (f args) nativeFunc :: (Monad m) => ObjectID@@ -329,7 +382,7 @@ -> (Value m -> m (Either RuntimeError (Value m))) -> Procedure m nativeFunc oid doc f =- NativeProcedure oid doc $ \args _ -> case args of+ NativeProcedure oid doc $ \args _ _ -> case args of [] -> pure . Left $ ArgumentError@@ -353,7 +406,7 @@ -> (Value m -> Either RuntimeError (Value m)) -> Procedure m pureNativeFunc oid doc f =- NativeProcedure oid doc $ \args _ -> case args of+ NativeProcedure oid doc $ \args _ _ -> case args of [] -> pure . Left $ ArgumentError@@ -377,7 +430,7 @@ -> (Value m -> Value m -> Either RuntimeError (Value m)) -> Procedure m pureNativeFunc2 oid doc f =- NativeProcedure oid doc $ \args _ -> case args of+ NativeProcedure oid doc $ \args _ _ -> case args of [] -> pure . Left $ ArgumentError@@ -407,6 +460,7 @@ -> [(Maybe Identifier, Value m)] -> Context m -> Env m+ -> SomePRNG -> m (Either RuntimeError a) type TestFunc m = MetaFunc m Bool@@ -419,15 +473,28 @@ , runTest :: !(TestFunc m) } +instance Eq (Test m) where+ a == b = compare a b == EQ++instance Ord (Test m) where+ compare = compareBy testDoc+ data Filter m = NativeFilter { filterDoc :: !(Maybe ProcedureDoc) , runFilter :: !(FilterFunc m) } +instance Ord (Filter m) where+ compare = compareBy filterDoc++instance Eq (Filter m) where+ a == b = compare a b == EQ+ data NativeObject m = NativeObject- { nativeObjectGetFieldNames :: m [Scalar]+ { nativeObjectID :: ObjectID+ , nativeObjectGetFieldNames :: m [Scalar] , nativeObjectGetField :: Scalar -> m (Maybe (Value m)) , nativeObjectGetAttribute :: Identifier -> m (Maybe (Value m)) , nativeObjectStringified :: m Text@@ -443,6 +510,15 @@ -> m (Either RuntimeError Bool) } +instance Eq (NativeObject m) where+ a == b = compare a b == EQ++instance Ord (NativeObject m) where+ compare = compareBy nativeObjectID++compareBy :: Ord b => (a -> b) -> a -> a -> Ordering+compareBy f a b = compare (f a) (f b)+ nativeObjectAsDict :: Monad m => NativeObject m -> m (Maybe (Map Scalar (Value m)))@@ -459,10 +535,11 @@ (-->) :: obj -> (obj -> obj -> a) -> a obj --> field = field obj obj -defNativeObject :: Monad m => NativeObject m-defNativeObject =+defNativeObject :: Monad m => ObjectID -> NativeObject m+defNativeObject oid = NativeObject- { nativeObjectGetFieldNames = pure []+ { nativeObjectID = oid+ , nativeObjectGetFieldNames = pure [] , nativeObjectGetField = \_ -> pure Nothing , nativeObjectGetAttribute = \_ -> pure Nothing , nativeObjectStringified = pure "<native object>"@@ -579,17 +656,20 @@ instance Applicative m => FromValue Text m where fromValue = pure . asTextVal +instance Applicative m => FromValue Identifier m where+ fromValue = pure . fmap Identifier . asTextVal+ instance Applicative m => FromValue Integer m where- fromValue = pure . asIntVal+ fromValue = pure . asIntVal "conversion to int" instance Applicative m => FromValue Int m where- fromValue = fmap (fmap fromInteger) . pure . asIntVal+ fromValue = fmap (fmap fromInteger) . pure . asIntVal "conversion to int" instance Applicative m => FromValue Double m where- fromValue = pure . asFloatVal+ fromValue = pure . asFloatVal "conversion to float" instance Applicative m => FromValue Bool m where- fromValue = pure . asBoolVal+ fromValue = pure . asBoolVal "conversion to bool" instance Applicative m => FromValue () m where fromValue NoneV = pure $ Right ()@@ -700,6 +780,9 @@ instance ToValue LBS.ByteString a where toValue = ScalarV . toScalar +instance ToValue Identifier a where+ toValue = ScalarV . toScalar+ -------------------------------------------------------------------------------- -- Compound / derived instances --------------------------------------------------------------------------------@@ -762,38 +845,42 @@ -------------------------------------------------------------------------------- class ToNativeProcedure m a where- toNativeProcedure :: a -> [(Maybe Identifier, Value m)] -> Context m -> m (Either RuntimeError (Value m))+ toNativeProcedure :: a+ -> [(Maybe Identifier, Value m)]+ -> Context m+ -> SomePRNG+ -> m (Either RuntimeError (Value m)) instance Applicative m => ToNativeProcedure m (Value m) where- toNativeProcedure val [] _ =+ toNativeProcedure val [] _ _ = pure (Right val)- toNativeProcedure _ _ _ =+ toNativeProcedure _ _ _ _ = pure . Left $ ArgumentError "<native function>" "<positional argument>" "end of arguments" "value" instance Applicative m => ToNativeProcedure m (m (Value m)) where- toNativeProcedure action [] _ =+ toNativeProcedure action [] _ _ = Right <$> action- toNativeProcedure _ _ _ =+ toNativeProcedure _ _ _ _ = pure . Left $ ArgumentError "<native function>" "<positional argument>" "end of arguments" "value" instance Applicative m => ToNativeProcedure m (m (Either RuntimeError (Value m))) where- toNativeProcedure action [] _ =+ toNativeProcedure action [] _ _ = action- toNativeProcedure _ _ _ =+ toNativeProcedure _ _ _ _ = pure . Left $ ArgumentError "<native function>" "<positional argument>" "end of arguments" "value" instance (Applicative m, ToNativeProcedure m a) => ToNativeProcedure m (Value m -> a) where- toNativeProcedure _ [] _ =+ toNativeProcedure _ [] _ _ = pure . Left $ ArgumentError "<native function>" "<positional argument>" "value" "end of arguments"- toNativeProcedure _ ((Just _, _):_) _ =+ toNativeProcedure _ ((Just _, _):_) _ _ = pure . Left $ ArgumentError "<native function>" "<positional argument>" "positional argument" "named argument"- toNativeProcedure f ((Nothing, v):xs) ctx =- toNativeProcedure (f v) xs ctx+ toNativeProcedure f ((Nothing, v):xs) ctx rng =+ toNativeProcedure (f v) xs ctx rng instance Applicative m => FnToValue (Value m -> Value m) m where@@ -928,20 +1015,40 @@ asOptionalVal _ NoneV = Right Nothing asOptionalVal asVal x = Just <$> asVal x -asIntVal :: Value m -> Either RuntimeError Integer-asIntVal (IntV a) = Right a-asIntVal x = Left $ TagError "conversion to int" "int" (tagNameOf x)+asIntVal :: Text -> Value m -> Either RuntimeError Integer+asIntVal _ (IntV a) = Right a+asIntVal context x = Left $ TagError context "int" (tagNameOf x) -asFloatVal :: Value m -> Either RuntimeError Double-asFloatVal (FloatV a) = Right a-asFloatVal (IntV a) = Right (fromInteger a)-asFloatVal x = Left $ TagError "conversion to float" "float" (tagNameOf x)+asFloatVal :: Text -> Value m -> Either RuntimeError Double+asFloatVal _ (FloatV a) = Right a+asFloatVal _ (IntV a) = Right (fromInteger a)+asFloatVal context x = Left $ TagError context "float" (tagNameOf x) -asBoolVal :: Value m -> Either RuntimeError Bool-asBoolVal (BoolV a) = Right a-asBoolVal NoneV = Right False-asBoolVal x = Left $ TagError "conversion to bool" "bool" (tagNameOf x)+asFloatValLenient :: Double -> Value m -> Double+asFloatValLenient _ (FloatV a) = a+asFloatValLenient _ (IntV a) = fromInteger a+asFloatValLenient def (StringV a) = fromMaybe def $ readMaybe (Text.unpack a)+asFloatValLenient def _ = def +asBoolVal :: Text -> Value m -> Either RuntimeError Bool+asBoolVal _ (BoolV a) = Right a+asBoolVal _ NoneV = Right False+asBoolVal context x = Left $ TagError context "bool" (tagNameOf x)++-- | Lenient version of 'asBoolVal', will also work on strings, numbers, lists,+-- and dicts.+asTruthVal :: Text -> Value m -> Either RuntimeError Bool+asTruthVal _ (BoolV a) = Right a+asTruthVal _ NoneV = Right False+asTruthVal _ (StringV t) = Right . not . Text.null $ t+asTruthVal _ (BytesV t) = Right . not . BS.null $ t+asTruthVal _ (EncodedV (Encoded t)) = Right . not . Text.null $ t+asTruthVal _ (IntV i) = Right (i /= 0)+asTruthVal _ (FloatV i) = Right (i /= 0)+asTruthVal _ (ListV xs) = Right . not . V.null $ xs+asTruthVal _ (DictV xs) = Right . not . Map.null $ xs+asTruthVal context x = Left $ TagError context"bool" (tagNameOf x)+ asVectorVal :: Monad m => Value m -> m (Either RuntimeError (Vector (Value m))) asVectorVal (ListV a) = pure . Right $ a asVectorVal (NativeV n) =@@ -985,13 +1092,13 @@ => (Integer -> Either RuntimeError a) -> Value m -> Either RuntimeError (Value m)-intFunc f a = toValue <$> (asIntVal a >>= f)+intFunc f a = toValue <$> (asIntVal "conversion to int" a >>= f) floatFunc :: (Monad m, ToValue a m) => (Double -> Either RuntimeError a) -> Value m -> Either RuntimeError (Value m)-floatFunc f a = toValue <$> (asFloatVal a >>= f)+floatFunc f a = toValue <$> (asFloatVal "conversion to float" a >>= f) boolFunc :: (Monad m, ToValue a m) => (Bool -> a)@@ -1011,6 +1118,13 @@ textFunc f NoneV = toValue <$> f "" textFunc _ a = Left (TagError "text function" "int" (tagNameOf a)) +dictFunc :: (Monad m, ToValue a m)+ => (Map Scalar (Value m) -> Either RuntimeError a)+ -> Value m+ -> Either RuntimeError (Value m)+dictFunc f (DictV a) = toValue <$> f a+dictFunc _ a = Left (TagError "dict function" "dict" (tagNameOf a))+ numericFunc2 :: Monad m => (Integer -> Integer -> Integer) -> (Double -> Double -> Double)@@ -1043,8 +1157,8 @@ -> Value m -> Either RuntimeError (Value m) intFunc2 f a b = do- x <- asIntVal a- y <- asIntVal b+ x <- asIntVal "argument conversion to int" a+ y <- asIntVal "argument conversion to int" b IntV <$> f x y floatFunc2 :: Monad m@@ -1063,7 +1177,7 @@ -> Value m -> Value m -> Either RuntimeError (Value m)-boolFunc2 f a b = BoolV <$> (f <$> asBoolVal a <*> asBoolVal b)+boolFunc2 f a b = BoolV <$> (f <$> asBoolVal "conversion to bool" a <*> asBoolVal "conversion to bool" b) native :: (Monad m, MonadTrans t, MonadError RuntimeError (t m)) => m (Either RuntimeError a)@@ -1145,12 +1259,8 @@ pure $ Text.intercalate ", " elems stringify (NativeV n) = native (Right <$> nativeObjectStringified n)-stringify (ProcedureV (NativeProcedure oid _ _)) =- pure $ "[[procedure " <> unObjectID oid <> "]]"-stringify (ProcedureV (GingerProcedure {})) =+stringify (ProcedureV {}) = pure $ "[[procedure]]"-stringify (ProcedureV NamespaceProcedure) =- pure $ "[[procedure namespace]]" stringify (TestV _) = pure "[[test]]" stringify (FilterV _) =@@ -1226,17 +1336,17 @@ arbitraryNativeProcedure = do retval <- QC.scale (`div` 2) arbitrary oid <- ObjectID . ("arbitrary:" <>) . identifierName <$> arbitrary- pure $ NativeProcedure oid Nothing (\_ _ -> pure (Right retval))+ pure $ NativeProcedure oid Nothing (\_ _ _ -> pure (Right retval)) arbitraryNative :: Monad m => QC.Gen (NativeObject m) arbitraryNative = do- objectID <- arbitrary- pure defNativeObject+ objectID <- ObjectID . identifierName <$> arbitrary+ pure (defNativeObject objectID) { nativeObjectGetFieldNames = pure ["id"] , nativeObjectGetField = \case- "id" -> pure . Just . toValue . identifierName $ objectID+ "id" -> pure . Just . toValue . unObjectID $ objectID _ -> pure Nothing- , nativeObjectStringified = pure $ identifierName objectID+ , nativeObjectStringified = pure $ unObjectID objectID , nativeObjectEq = \self other -> do otherID <- nativeObjectGetField other "id" selfID <- nativeObjectGetField self "id"
test/Language/Ginger/Interpret/Tests.hs view
@@ -25,23 +25,25 @@ import Data.Maybe (isJust, isNothing) import Data.Monoid (Any (..)) import Data.Proxy (Proxy (..))+import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Vector (Vector) import qualified Data.Vector as V import Data.Word (Word8, Word16, Word32, Word64)+import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.QuickCheck hiding ((.&.))-import Test.QuickCheck.Instances ()+import System.Random (mkStdGen, splitGen, uniformR) import Language.Ginger.AST import Language.Ginger.Interpret import Language.Ginger.Interpret.DefEnv (htmlEncode) import Language.Ginger.Render+import Language.Ginger.SourcePosition import Language.Ginger.TestUtils import Language.Ginger.Value-import Language.Ginger.SourcePosition tests :: TestTree tests = testGroup "Language.Ginger.Interpret"@@ -263,6 +265,24 @@ "kiB" ) ]+ , testProperty "min" $+ prop_eval+ (\xs ->+ FilterE (ListE (V.fromList . map IntLitE $ xs)) (VarE "min") [] []+ )+ (\xs -> if null xs then NoneV else IntV (minimum xs))+ , testProperty "max" $+ prop_eval+ (\xs ->+ FilterE (ListE (V.fromList . map IntLitE $ xs)) (VarE "max") [] []+ )+ (\xs -> if null xs then NoneV else IntV (maximum xs))+ , testProperty "sum" $+ prop_eval+ (\xs ->+ FilterE (ListE (V.fromList . map IntLitE $ xs)) (VarE "sum") [] []+ )+ (\xs -> if null xs then NoneV else IntV (sum xs)) , testProperty "length (string)" $ prop_eval (\(ArbitraryText t) ->@@ -286,6 +306,21 @@ ) (\(PositiveInt i) -> toValue i) + , testGroup "random"+ [ testProperty "random pick" $+ prop_evalRNG+ (\(xs :: Vector Integer) ->+ FilterE (ListE (V.map IntLitE xs)) (VarE "random") [] []+ )+ (\seed xs ->+ let rng = mkStdGen seed+ (_rngL, rngR) = splitGen rng+ (i, _) = uniformR (0, V.length xs - 1) rngR+ in if V.null xs then+ NoneV+ else (V.map IntV xs) V.! i+ )+ ] , testGroup "escape" [ testProperty "string" $ prop_eval@@ -1003,7 +1038,10 @@ [ testProperty "Immediate statement outputs itself" prop_immediateStatementOutput , testProperty "Interpolation statement outputs its argument" prop_interpolationStatementOutput , testProperty "Comment statement outputs None" prop_commentStatementOutput- , testProperty "IfS outputs the correct branch" prop_ifStatementOutput+ , testGroup "IfS"+ [ testProperty "simple boolean condition" prop_ifStatementOutput+ , testProperty "string as condition" prop_ifStatementString+ ] , testGroup "ForS" [ testProperty "simple loop" prop_forStatementSimple , testProperty "simple loop with key" prop_forStatementWithKey@@ -1049,7 +1087,7 @@ prop_noBottoms :: (Eval Identity a, Arbitrary a) => a -> Bool prop_noBottoms e =- runGingerIdentityEither (eval e) `seq` True+ runGingerIdentityEither 0 (eval e) `seq` True isProcedure :: Value m -> Bool isProcedure ProcedureV {} = True@@ -1057,7 +1095,7 @@ prop_setVarLookupVar :: Identifier -> Value Identity -> Property prop_setVarLookupVar k v =- let (w, equal) = runGingerIdentity program+ let (w, equal) = runGingerIdentity 0 program program :: GingerT Identity (Value Identity, Bool) program = do@@ -1073,18 +1111,18 @@ prop_stringifyString :: String -> Property prop_stringifyString str = let expected = Text.pack str- actual = runGingerIdentity (stringify (StringV expected))+ actual = runGingerIdentity 0 (stringify (StringV expected)) in expected === actual prop_stringifyNone :: Property prop_stringifyNone =- runGingerIdentity (stringify NoneV) === ""+ runGingerIdentity 0 (stringify NoneV) === "" prop_stringifyShow :: (ToValue a Identity, Show a) => Proxy a -> a -> Property prop_stringifyShow _ i = let expected = Text.show i- actual = runGingerIdentity (stringify $ toValue i)+ actual = runGingerIdentity 0 (stringify $ toValue i) in expected === actual @@ -1093,7 +1131,9 @@ -> Property prop_scopedVarsDisappear (name1, val1) (name2, val2) = name1 /= name2 ==>- property . runGingerIdentity $ do+ varOK name1 ==>+ varOK name2 ==>+ property . runGingerIdentity 0 $ do setVar name1 val1 exists1a <- isJust <$> lookupVarMaybe name1 exists2 <- scoped $ do@@ -1115,7 +1155,7 @@ toValue $ drop (length items + start) items else toValue $ drop start items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "start" (toValue start) eval (SliceE (VarE "items") (Just $ VarE "start") Nothing)@@ -1130,7 +1170,7 @@ toValue $ take (length items + end) items else toValue $ take end items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "end" (toValue end) eval (SliceE (VarE "items") Nothing (Just $ VarE "end"))@@ -1145,7 +1185,7 @@ let start' = if start < 0 then length items + start else start end' = if end < 0 then length items - start' + end else end expected = toValue . take end' . drop start' $ items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "start" (toValue start) setVar "end" (toValue end)@@ -1161,7 +1201,7 @@ toValue $ Text.drop (Text.length items + start) items else toValue $ Text.drop start items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "start" (toValue start) eval (SliceE (VarE "items") (Just $ VarE "start") Nothing)@@ -1176,7 +1216,7 @@ toValue $ Text.take (Text.length items + end) items else toValue $ Text.take end items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "end" (toValue end) eval (SliceE (VarE "items") Nothing (Just $ VarE "end"))@@ -1191,7 +1231,7 @@ let start' = if start < 0 then Text.length items + start else start end' = if end < 0 then Text.length items - start' + end else end expected = toValue . Text.take end' . Text.drop start' $ items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "start" (toValue start) setVar "end" (toValue end)@@ -1207,7 +1247,7 @@ toValue $ BS.drop (BS.length items + start) items else toValue $ BS.drop start items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "start" (toValue start) eval (SliceE (VarE "items") (Just $ VarE "start") Nothing)@@ -1222,7 +1262,7 @@ toValue $ BS.take (BS.length items + end) items else toValue $ BS.take end items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "end" (toValue end) eval (SliceE (VarE "items") Nothing (Just $ VarE "end"))@@ -1237,7 +1277,7 @@ let start' = if start < 0 then BS.length items + start else start end' = if end < 0 then BS.length items - start' + end else end expected = toValue . BS.take end' . BS.drop start' $ items- actual = runGingerIdentity $ do+ actual = runGingerIdentity 0 $ do setVar "items" (toValue items) setVar "start" (toValue start) setVar "end" (toValue end)@@ -1260,7 +1300,7 @@ -> Property prop_unopCond fX unop f x' = let x = fX x'- resultG = runGingerIdentity $ do+ resultG = runGingerIdentity 0 $ do setVar "a" (toValue x) eval (UnaryE unop (VarE "a")) resultH = toValue $ f <$> x@@ -1287,7 +1327,7 @@ prop_binopCond fX fY binop f x' y' = let x = fX x' y = fY y'- resultG = runGingerIdentity $ do+ resultG = runGingerIdentity 0 $ do setVar "a" (toValue x) setVar "b" (toValue y) eval (BinaryE binop (VarE "a") (VarE "b"))@@ -1299,7 +1339,7 @@ prop_intDivByZero :: Integer -> Property prop_intDivByZero i =- let result = runGingerIdentityEither $ do+ let result = runGingerIdentityEither 0 $ do setVar "i" (toValue i) eval (BinaryE BinopIntDiv (IntLitE i) (IntLitE 0)) in@@ -1308,7 +1348,7 @@ prop_divByZero :: Double -> Property prop_divByZero d =- let result = runGingerIdentityEither $ do+ let result = runGingerIdentityEither 0 $ do setVar "d" (toValue d) eval (BinaryE BinopDiv (FloatLitE d) (FloatLitE 0)) in@@ -1317,7 +1357,7 @@ prop_divToNaN :: Property prop_divToNaN =- let result = runGingerIdentityEither $ do+ let result = runGingerIdentityEither 0 $ do eval (BinaryE BinopDiv (FloatLitE 0) (FloatLitE 0)) in result === leftPRE (NumericError "/" "not a number")@@ -1328,14 +1368,14 @@ prop_literalWith :: ToValue b Identity => (a -> b) -> (b -> Expr) -> a -> Property prop_literalWith f mkExpr val = let expr = mkExpr (f val)- result = runGingerIdentity (eval expr)+ result = runGingerIdentity 0 (eval expr) in result === toValue (f val) prop_ternary :: Bool -> Integer -> Integer -> Property prop_ternary cond yes no = let expr = TernaryE (BoolE cond) (IntLitE yes) (IntLitE no)- resultG = runGingerIdentity (eval expr)+ resultG = runGingerIdentity 0 (eval expr) resultH = if cond then yes else no in resultG === toValue resultH@@ -1343,14 +1383,14 @@ prop_var :: Identifier -> Integer -> Property prop_var name val = let expr = VarE name- resultG = runGingerIdentity (setVar name (toValue val) >> eval expr)+ resultG = runGingerIdentity 0 (setVar name (toValue val) >> eval expr) in resultG === toValue val prop_varNeg :: Identifier -> Integer -> Identifier -> Property prop_varNeg name1 val1 name2 = let expr = VarE name2- resultG = runGingerIdentityEither (setVar name1 (toValue val1) >> eval expr)+ resultG = runGingerIdentityEither 0 (setVar name1 (toValue val1) >> eval expr) in name1 /= name2 ==> resultG === leftPRE (NotInScopeError (identifierName name2))@@ -1358,9 +1398,9 @@ prop_nativeNullary :: Identifier -> Integer -> Property prop_nativeNullary varName constVal = let fVal = ProcedureV . NativeProcedure "testsuite:nativeNullary" Nothing $- const . const . pure @Identity . Right . toValue $ constVal+ const . const . const . pure @Identity . Right . toValue $ constVal expr = CallE (VarE varName) [] []- result = runGingerIdentity (setVar varName fVal >> eval expr)+ result = runGingerIdentity 0 (setVar varName fVal >> eval expr) in result === toValue constVal @@ -1372,7 +1412,7 @@ (id :: Value Identity -> Value Identity) argVal = toValue arg expr = CallE (VarE varName) [VarE argVarName] []- result = runGingerIdentity $ do+ result = runGingerIdentity 0 $ do setVar varName fVal setVar argVarName argVal eval expr@@ -1385,10 +1425,10 @@ prop_userNullary :: Identifier -> Expr -> Property prop_userNullary varName bodyExpr = let fVal = ProcedureV $ GingerProcedure mempty [] bodyExpr- resultCall = runGingerIdentityEither $ do+ resultCall = runGingerIdentityEither 0 $ do setVar varName fVal eval $ CallE (VarE varName) [] []- resultDirect = runGingerIdentityEither $ do+ resultDirect = runGingerIdentityEither 0 $ do eval bodyExpr in resultCall === resultDirect@@ -1403,14 +1443,14 @@ , PositionedS (SourcePosition "test" 3 1) $ InterpolationS (DotE (VarE nsName) attrName) ]- result = runGingerIdentity $ eval program+ result = runGingerIdentity 0 $ eval program in counterexample (Text.unpack $ renderSyntaxText program) $ result === IntV val prop_isDefinedTrue :: Identifier -> Integer -> Property prop_isDefinedTrue name val =- let result = runGingerIdentity $ do+ let result = runGingerIdentity 0 $ do setVar name (toValue val) eval $ IsE (VarE name) (VarE "defined") [] [] in@@ -1418,15 +1458,15 @@ prop_isDefinedFalse :: Identifier -> Property prop_isDefinedFalse name =- let result = runGingerIdentity $ do+ let result = runGingerIdentity 0 $ do eval $ IsE (VarE name) (VarE "defined") [] [] in- not (name `Map.member` envVars (defEnv @Identity)) ==>+ varOK name ==> result === FalseV prop_isDefinedTrueDict :: Identifier -> Identifier -> Integer -> Property prop_isDefinedTrueDict name selector val =- let result = runGingerIdentity $ do+ let result = runGingerIdentity 0 $ do setVar name (dictV [toScalar (identifierName selector) .= val]) eval $ IsE (IndexE (VarE name) (StringLitE $ identifierName selector)) (VarE "defined") [] [] in@@ -1439,17 +1479,26 @@ "true" -> TrueE "false" -> FalseE t -> VarE t- result = runGingerIdentity $ do+ result = runGingerIdentity 0 $ do setVar "v" (toValue val) eval $ IsE (VarE "v") testE [] [] in result === BoolV expected prop_eval :: (Arbitrary a, Show a, Show e, Eval Identity e) => (a -> e) -> (a -> Value Identity) -> a -> Property-prop_eval mkEvaluable mkExpected x =+prop_eval mkEvaluable mkExpected =+ prop_evalRNG mkEvaluable (const mkExpected) 0++prop_evalRNG :: (Arbitrary a, Show a, Show e, Eval Identity e)+ => (a -> e)+ -> (Int -> a -> Value Identity)+ -> Int+ -> a+ -> Property+prop_evalRNG mkEvaluable mkExpected seed x = let e = mkEvaluable x- expected = mkExpected x- result = runGingerIdentity $ eval e+ expected = mkExpected seed x+ result = runGingerIdentity seed $ eval e in counterexample (show e) $ result === expected@@ -1495,21 +1544,21 @@ prop_immediateStatementOutput :: Encoded -> Property prop_immediateStatementOutput str = let stmt = ImmediateS str- result = runGingerIdentity (eval stmt)+ result = runGingerIdentity 0 (eval stmt) in result === EncodedV str prop_commentStatementOutput :: String -> Property prop_commentStatementOutput str = let stmt = CommentS (Text.pack str)- result = runGingerIdentity (eval stmt)+ result = runGingerIdentity 0 (eval stmt) in result === NoneV prop_interpolationStatementOutput :: Expr -> Property prop_interpolationStatementOutput expr =- let resultS = runGingerIdentityEither (eval $ InterpolationS expr)- resultE = runGingerIdentityEither (eval expr)+ let resultS = runGingerIdentityEither 0 (eval $ InterpolationS expr)+ resultE = runGingerIdentityEither 0 (eval expr) in isRight resultE ==> either (const True) (not . getAny . traverseValue (Any . isProcedure)) resultE ==>@@ -1517,10 +1566,10 @@ prop_ifStatementOutput :: Bool -> Statement -> Statement -> Property prop_ifStatementOutput cond yes no =- let resultYes = runGingerIdentityEither (eval yes)- resultNo = runGingerIdentityEither (eval no)+ let resultYes = runGingerIdentityEither 0 (eval yes)+ resultNo = runGingerIdentityEither 0 (eval no) resultE = if cond then resultYes else resultNo- resultIf = runGingerIdentityEither (eval $ IfS (BoolE cond) yes (Just no))+ resultIf = runGingerIdentityEither 0 (eval $ IfS (BoolE cond) yes (Just no)) hasProcedure = case resultE of Left _ -> False Right v -> getAny (traverseValue (Any . isProcedure) v)@@ -1529,11 +1578,25 @@ not hasProcedure ==> resultIf === resultE +prop_ifStatementString :: ArbitraryText -> Statement -> Statement -> Property+prop_ifStatementString (ArbitraryText condText) yes no =+ let resultYes = runGingerIdentityEither 0 (eval yes)+ resultNo = runGingerIdentityEither 0 (eval no)+ resultE = if not (Text.null condText) then resultYes else resultNo+ resultIf = runGingerIdentityEither 0 (eval $ IfS (StringLitE condText) yes (Just no))+ hasProcedure = case resultE of+ Left _ -> False+ Right v -> getAny (traverseValue (Any . isProcedure) v)+ in+ -- exclude procedures, because we cannot compare those+ not hasProcedure ==>+ resultIf === resultE+ prop_forStatementSimple :: Identifier -> Identifier -> [String] -> Property prop_forStatementSimple itereeName varName strItems = let items = ListV . V.fromList $ map (StringV . Text.pack) strItems expected = StringV . Text.pack . mconcat $ strItems- resultFor = runGingerIdentity $ do+ resultFor = runGingerIdentity 0 $ do setVar itereeName items eval $ ForS Nothing -- loop key var@@ -1552,7 +1615,7 @@ let items = ListV . V.fromList $ map (StringV . Text.pack) strItems expected = StringV . Text.pack . mconcat $ [ show k ++ v | (k, v) <- zip [(0 :: Int) ..] strItems ]- resultFor = runGingerIdentity $ do+ resultFor = runGingerIdentity 0 $ do setVar itereeName items eval $ ForS (Just keyName) -- loop key var@@ -1573,8 +1636,8 @@ prop_forStatementEmpty :: Statement -> Property prop_forStatementEmpty body =- let resultDirect = runGingerIdentityEither (eval body)- resultFor = runGingerIdentityEither+ let resultDirect = runGingerIdentityEither 0 (eval body)+ resultFor = runGingerIdentityEither 0 (eval $ ForS Nothing "item"@@ -1591,7 +1654,7 @@ prop_forStatementFilter intItems = let items = ListV . V.fromList $ map IntV intItems expected = StringV . Text.pack . mconcat $ [ show i | i <- intItems, i > 0 ]- resultFor = runGingerIdentity $ do+ resultFor = runGingerIdentity 0 $ do setVar "items" items eval $ ForS Nothing@@ -1612,7 +1675,7 @@ [ show (succ i) ++ show (i :: Int) ++ show v | (i, v) <- zip [0..] intItems ]- resultFor = runGingerIdentity $ do+ resultFor = runGingerIdentity 0 $ do setVar "items" items eval $ ForS Nothing@@ -1652,7 +1715,7 @@ Nothing , InterpolationS (DotE (VarE "ns") "sum") ]- resultFor = runGingerIdentity $ do+ resultFor = runGingerIdentity 0 $ do setVar "items" items eval program in@@ -1662,9 +1725,9 @@ prop_callNoArgs :: Expr -> Property prop_callNoArgs body =- let resultDirect = runGingerIdentityEither $ do+ let resultDirect = runGingerIdentityEither 0 $ do eval body- resultCall = runGingerIdentityEither $ do+ resultCall = runGingerIdentityEither 0 $ do setVar "f" $ ProcedureV (GingerProcedure mempty [] body) eval $ CallS "f" [] [] (InterpolationS NoneE) cat = case resultDirect of@@ -1683,9 +1746,9 @@ [ SetS (SetVar "f") NoneE , InterpolationS body ]- resultDirect = runGingerIdentityEither $+ resultDirect = runGingerIdentityEither 0 $ eval body'- resultCall = runGingerIdentityEither $ do+ resultCall = runGingerIdentityEither 0 $ do setVar "f" $ fnToValue "testsuite:callIdentity"@@ -1708,9 +1771,9 @@ [ SetS (SetVar "f") NoneE , InterpolationS body ]- resultDirect = runGingerIdentityEither $+ resultDirect = runGingerIdentityEither 0 $ eval body'- resultCall = runGingerIdentityEither $ do+ resultCall = runGingerIdentityEither 0 $ do env <- gets evalEnv setVar "f" $ ProcedureV $@@ -1732,12 +1795,12 @@ [ SetS (SetVar "f") NoneE , body ]- resultDirect = runGingerIdentityEither $+ resultDirect = runGingerIdentityEither 0 $ eval $ GroupS [ ImmediateS $ Encoded "Hello, " , body' ]- resultCall = runGingerIdentityEither $+ resultCall = runGingerIdentityEither 0 $ eval $ GroupS [ MacroS "f" [] $ GroupS@@ -1757,13 +1820,13 @@ prop_include :: ArbitraryText -> Statement -> Property prop_include (ArbitraryText name) body = let bodySrc = renderSyntaxText body- resultDirect = runGingerIdentityEither $- eval body+ resultDirect = runGingerIdentityEither 0 $+ encode =<< eval body loader = mockLoader [(name, bodySrc)] includeS = IncludeS (StringLitE name) RequireMissing WithContext includeSrc = renderSyntaxText includeS- resultInclude = runGingerIdentityEitherWithLoader loader $- eval includeS+ resultInclude = runGingerIdentityEitherWithLoader loader 0 $+ encode =<< eval includeS in counterexample ("BODY:\n" ++ Text.unpack bodySrc) $ counterexample ("INCLUDER:\n" ++ Text.unpack includeSrc) $@@ -1773,10 +1836,10 @@ prop_includeInto :: ArbitraryText -> Statement -> Statement -> Property prop_includeInto (ArbitraryText name) body parent = let bodySrc = renderSyntaxText body- resultDirect = runGingerIdentityEither $+ resultDirect = runGingerIdentityEither 0 $ eval (GroupS [ body, parent ]) loader = mockLoader [(name, bodySrc)]- resultInclude = runGingerIdentityEitherWithLoader loader $+ resultInclude = runGingerIdentityEitherWithLoader loader 0 $ eval ( GroupS [ IncludeS (StringLitE name) RequireMissing WithContext@@ -1791,28 +1854,29 @@ prop_includeMacro (ArbitraryText name) macroName body = let bodySrc = renderSyntaxText $ MacroS macroName [] body- resultDirect = runGingerIdentityEither $- eval body+ resultDirect = runGingerIdentityEither 0 $+ encode =<< eval body loader = mockLoader [(name, bodySrc)] includeS = GroupS [ IncludeS (StringLitE name) RequireMissing WithContext , CallS macroName [] [] (InterpolationS NoneE) ] includeSrc = renderSyntaxText includeS- resultInclude = runGingerIdentityEitherWithLoader loader $- eval includeS+ resultInclude = runGingerIdentityEitherWithLoader loader 0 $+ encode =<< eval includeS in counterexample ("BODY:\n" ++ Text.unpack bodySrc) $ counterexample ("INCLUDER:\n" ++ Text.unpack includeSrc) $ isRight resultDirect ==>+ varOK macroName ==> resultInclude === resultDirect prop_includeMacroWithoutContext :: ArbitraryText -> Identifier -> Statement -> Property prop_includeMacroWithoutContext (ArbitraryText name) macroName body = let bodySrc = renderSyntaxText $ MacroS macroName [] body- resultDirect = runGingerIdentityEither $- eval body+ resultDirect = runGingerIdentityEither 0 $+ encode =<< eval body loader = mockLoader [(name, bodySrc)] includeS = GroupS@@ -1820,12 +1884,13 @@ , CallS macroName [] [] (InterpolationS NoneE) ] includeSrc = renderSyntaxText includeS- resultInclude = runGingerIdentityEitherWithLoader loader $- eval includeS+ resultInclude = runGingerIdentityEitherWithLoader loader 0 $+ encode =<< eval includeS in counterexample ("BODY:\n" ++ Text.unpack bodySrc) $ counterexample ("INCLUDER:\n" ++ Text.unpack includeSrc) $ name /= identifierName macroName ==>+ varOK macroName ==> isRight resultDirect ==> resultInclude === resultDirect @@ -1833,10 +1898,10 @@ prop_includeSet (ArbitraryText name) varName (ArbitraryText varValue) = let bodySrc = renderSyntaxText $ SetS (SetVar varName) (StringLitE varValue)- resultDirect = runGingerIdentityEither $+ resultDirect = runGingerIdentityEither 0 $ eval (StringLitE varValue) loader = mockLoader [(name, bodySrc)]- resultInclude = runGingerIdentityEitherWithLoader loader $+ resultInclude = runGingerIdentityEitherWithLoader loader 0 $ eval ( GroupS [ IncludeS (StringLitE name) RequireMissing WithContext@@ -1851,7 +1916,7 @@ prop_includeWithContext (ArbitraryText name) varName (ArbitraryText varValue) = let bodySrc = renderSyntaxText $ InterpolationS (VarE varName)- resultDirect = runGingerIdentityEither $+ resultDirect = runGingerIdentityEither 0 $ eval (StringLitE varValue) loader = mockLoader [(name, bodySrc)] includeS = GroupS@@ -1859,11 +1924,12 @@ , IncludeS (StringLitE name) RequireMissing WithContext ] includeSrc = renderSyntaxText includeS- resultInclude = runGingerIdentityEitherWithLoader loader $+ resultInclude = runGingerIdentityEitherWithLoader loader 0 $ eval includeS in counterexample ("BODY:\n" ++ Text.unpack bodySrc) $ counterexample ("INCLUDER:\n" ++ Text.unpack includeSrc) $+ varOK varName ==> resultInclude === resultDirect prop_includeWithoutContext :: ArbitraryText -> Identifier -> ArbitraryText -> Property@@ -1876,34 +1942,36 @@ , IncludeS (StringLitE name) RequireMissing WithoutContext ] includeSrc = renderSyntaxText includeS- resultInclude = runGingerIdentityEitherWithLoader loader $+ resultInclude = runGingerIdentityEitherWithLoader loader 0 $ eval includeS expected = Left . PrettyRuntimeError $ NotInScopeError (identifierName varName) in counterexample ("BODY:\n" ++ Text.unpack bodySrc) $ counterexample ("INCLUDER:\n" ++ Text.unpack includeSrc) $+ varOK varName ==> resultInclude === expected prop_importValue :: ArbitraryText -> Identifier -> Expr -> Property prop_importValue (ArbitraryText name) varName valE = let bodySrc = renderSyntaxText (SetS (SetVar varName) valE)- resultDirect = runGingerIdentityEither $ eval valE+ resultDirect = runGingerIdentityEither 0 $ eval valE loader = mockLoader [(name, bodySrc)]- resultImport = runGingerIdentityEitherWithLoader loader . eval $+ resultImport = runGingerIdentityEitherWithLoader loader 0 . eval $ GroupS [ ImportS (StringLitE name) Nothing Nothing RequireMissing WithoutContext , InterpolationS (VarE varName) ] in counterexample ("SOURCE:\n" ++ Text.unpack bodySrc) $+ varOK varName ==> resultImport === resultDirect prop_importValueAlias :: ArbitraryText -> Identifier -> Identifier -> Expr -> Property prop_importValueAlias (ArbitraryText name) alias varName valE = let bodySrc = renderSyntaxText (SetS (SetVar varName) valE)- resultDirect = runGingerIdentityEither $ eval valE+ resultDirect = runGingerIdentityEither 0 $ eval valE loader = mockLoader [(name, bodySrc)]- resultImport = runGingerIdentityEitherWithLoader loader . eval $+ resultImport = runGingerIdentityEitherWithLoader loader 0 . eval $ GroupS [ ImportS (StringLitE name) (Just alias) Nothing RequireMissing WithoutContext , InterpolationS $@@ -1914,44 +1982,55 @@ in counterexample ("SOURCE:\n" ++ Text.unpack bodySrc) $ isRight resultDirect ==>+ varOK varName ==>+ varOK alias ==> resultImport === resultDirect prop_importMacro :: ArbitraryText -> Identifier -> Statement -> Property prop_importMacro (ArbitraryText name) varName bodyS = let bodySrc = renderSyntaxText (MacroS varName [] bodyS)- resultDirect = runGingerIdentityEither $ eval bodyS+ resultDirect = runGingerIdentityEither 0 $ encode =<< eval bodyS loader = mockLoader [(name, bodySrc)] importS = GroupS [ ImportS (StringLitE name) Nothing Nothing RequireMissing WithoutContext , CallS varName [] [] (InterpolationS NoneE) ] importSrc = renderSyntaxText importS- resultImport = runGingerIdentityEitherWithLoader loader . eval $ importS+ resultImport = runGingerIdentityEitherWithLoader loader 0 $ encode =<< eval importS in counterexample ("BODY:\n" ++ Text.unpack bodySrc) $ counterexample ("IMPORTER:\n" ++ Text.unpack importSrc) $ isRight resultDirect ==>+ varOK varName ==> resultImport === resultDirect +varOK :: Identifier -> Bool+varOK varName =+ not (varName `Map.member` envVars (defEnv @Identity)) &&+ not (varName `Set.member` ["e", "loop", "caller"])+ prop_importWithoutContext :: ArbitraryText -> Identifier -> Identifier -> Expr -> Property prop_importWithoutContext (ArbitraryText name) macroName varName bodyE = let bodySrc = renderSyntaxText $ (MacroS macroName [] (InterpolationS (VarE varName)))- resultDirect = runGingerIdentityEither $ do+ resultDirect = runGingerIdentityEither 0 $ do void $ eval bodyE throwError $ NotInScopeError (identifierName varName) loader = mockLoader [(name, bodySrc)]- resultImport = runGingerIdentityEitherWithLoader loader . eval $- GroupS- [ SetS (SetVar varName) bodyE- , ImportS (StringLitE name) Nothing Nothing RequireMissing WithoutContext- , CallS macroName [] [] (InterpolationS NoneE)- ]+ resultImport = runGingerIdentityEitherWithLoader loader 0 $ do+ encode =<< eval (+ GroupS+ [ SetS (SetVar varName) bodyE+ , ImportS (StringLitE name) Nothing Nothing RequireMissing WithoutContext+ , CallS macroName [] [] (InterpolationS NoneE)+ ]) in counterexample ("SOURCE:\n" ++ Text.unpack bodySrc) $ macroName /= varName ==>+ varOK varName ==>+ varOK macroName ==> resultImport === resultDirect prop_importWithContext :: ArbitraryText -> Identifier -> Identifier -> Expr -> Property@@ -1960,9 +2039,9 @@ (MacroS macroName [] (InterpolationS (VarE varName)))- resultDirect = runGingerIdentityEither $ eval bodyE+ resultDirect = runGingerIdentityEither 0 $ eval bodyE loader = mockLoader [(name, bodySrc)]- resultImport = runGingerIdentityEitherWithLoader loader . eval $+ resultImport = runGingerIdentityEitherWithLoader loader 0 . eval $ GroupS [ SetS (SetVar varName) bodyE , ImportS (StringLitE name) Nothing Nothing RequireMissing WithContext@@ -1971,6 +2050,8 @@ in counterexample ("SOURCE:\n" ++ Text.unpack bodySrc) $ macroName /= varName ==>+ varOK varName ==>+ varOK macroName ==> resultImport === resultDirect prop_importExplicit :: NonEmptyText@@ -1991,7 +2072,7 @@ [ InterpolationS body2E , InterpolationS body3E ]- resultDirect = runGingerIdentityEither $ do+ resultDirect = runGingerIdentityEither 0 $ do void $ eval $ InterpolationS body3E void $ eval $ InterpolationS body1E eval $ directS@@ -2004,13 +2085,15 @@ , InterpolationS (VarE varName2) , InterpolationS (VarE varName1) ]- resultImport = runGingerIdentityEitherWithLoader loader . eval $ mainS+ resultImport = runGingerIdentityEitherWithLoader loader 0 . eval $ mainS importerSrc = renderSyntaxText $ mainS in counterexample ("DIRECT SOURCE:\n" ++ Text.unpack directSrc) $ counterexample ("IMPORTED SOURCE:\n" ++ Text.unpack bodySrc) $ counterexample ("MAIN SOURCE:\n" ++ Text.unpack importerSrc) $ varName1 /= varName2 ==>+ varOK varName1 ==>+ varOK varName2 ==> resultImport === resultDirect prop_extendSimple :: NonEmptyText@@ -2038,9 +2121,9 @@ mainSrc = renderSyntaxText $ templateBody mainT loader = mockLoader [(parentName, parentSrc)]- resultDirect = runGingerIdentityEither $ do+ resultDirect = runGingerIdentityEither 0 $ do evalS directS- resultExtends = runGingerIdentityEitherWithLoader loader $ do+ resultExtends = runGingerIdentityEitherWithLoader loader 0 $ do evalT mainT cat = case resultDirect of Left err -> unwords . take 1 . words $ show err@@ -2086,9 +2169,9 @@ mainSrc = renderSyntaxText $ templateBody mainT loader = mockLoader [(parentName, parentSrc)]- resultDirect = runGingerIdentityEither $ do+ resultDirect = runGingerIdentityEither 0 $ do evalS directS- resultExtends = runGingerIdentityEitherWithLoader loader $ do+ resultExtends = runGingerIdentityEitherWithLoader loader 0 $ do evalT mainT cat = case resultDirect of Left err -> unwords . take 1 . words $ show err@@ -2130,9 +2213,9 @@ loader = mockLoader [(parentName, parentSrc)] - resultDirect = runGingerIdentityEither $ do+ resultDirect = runGingerIdentityEither 0 $ do evalS directS- resultExtends = runGingerIdentityEitherWithLoader loader $ do+ resultExtends = runGingerIdentityEitherWithLoader loader 0 $ do evalT childT cat = case resultDirect of Left err -> unwords . take 1 . words $ show err@@ -2142,6 +2225,7 @@ counterexample ("PARENT SOURCE:\n" ++ Text.unpack parentSrc) $ counterexample ("CHILD SOURCE:\n" ++ Text.unpack childSrc) $ counterexample ("DIRECT SOURCE:\n" ++ Text.unpack directSrc) $+ varOK varName ==> resultExtends === resultDirect prop_extendWithoutContext :: NonEmptyText@@ -2174,9 +2258,9 @@ loader = mockLoader [(parentName, parentSrc)] - resultDirect = runGingerIdentityEither $ do+ resultDirect = runGingerIdentityEither 0 $ do evalS directS- resultExtends = runGingerIdentityEitherWithLoader loader $ do+ resultExtends = runGingerIdentityEitherWithLoader loader 0 $ do evalT childT cat = case resultDirect of Left (PrettyRuntimeError (NotInScopeError n)) | Identifier n == varName -> "OK (NotInScope, expected)"@@ -2188,4 +2272,5 @@ counterexample ("CHILD SOURCE:\n" ++ Text.unpack childSrc) $ counterexample ("DIRECT SOURCE:\n" ++ Text.unpack directSrc) $ varName /= dummyVarName ==>+ varOK varName ==> resultExtends === resultDirect
test/Language/Ginger/Parse/Tests.hs view
@@ -304,6 +304,24 @@ test_parser statementUP "{% if foo %}blah{% else %}pizza{% endif %}" (IfS (VarE "foo") (ImmediateS $ Encoded "blah") (Just (ImmediateS $ Encoded "pizza")))+ , testCase "if-elif" $+ test_parser statementUP+ "{% if foo %}blah{% elif bar %}olives{% endif %}"+ (IfS (VarE "foo")+ (ImmediateS $ Encoded "blah")+ (Just $+ (IfS (VarE "bar")+ (ImmediateS $ Encoded "olives")+ Nothing)))+ , testCase "if-elif-else" $+ test_parser statementUP+ "{% if foo %}blah{% elif bar %}olives{% else %}pizza{% endif %}"+ (IfS (VarE "foo")+ (ImmediateS $ Encoded "blah")+ (Just $+ (IfS (VarE "bar")+ (ImmediateS $ Encoded "olives")+ (Just (ImmediateS $ Encoded "pizza"))))) ] , testGroup "SetS, SetBlockS" [ testCase "set" $
test/Language/Ginger/TestUtils.hs view
@@ -12,6 +12,7 @@ import qualified Data.Text as Text import qualified Data.Map.Strict as Map import Test.Tasty.QuickCheck+import System.Random (mkStdGen) import Language.Ginger.Interpret import Language.Ginger.Value@@ -97,27 +98,34 @@ show (PrettyRuntimeError (TemplateParseError _ err)) = Text.unpack err show (PrettyRuntimeError e) = show e -runGingerIdentity :: GingerT Identity a -> a-runGingerIdentity action =- either (error . show) id $ runGingerIdentityEither action+runGingerIdentity :: Int -> GingerT Identity a -> a+runGingerIdentity rngSeed action =+ either (error . show) id $ runGingerIdentityEither rngSeed action -runGingerIdentityEither :: GingerT Identity a -> Either PrettyRuntimeError a-runGingerIdentityEither action =+runGingerIdentityEither :: Int -> GingerT Identity a -> Either PrettyRuntimeError a+runGingerIdentityEither rngSeed action = mapLeft (PrettyRuntimeError . unPositionedError) $- runIdentity (runGingerT action defContext defEnv)+ runIdentity (runGingerT action defContext defEnv (mkStdGen rngSeed)) runGingerIdentityWithLoader :: TemplateLoader Identity- -> GingerT Identity a- -> a-runGingerIdentityWithLoader loader action =- either (error . show) id $ runGingerIdentityEitherWithLoader loader action+ -> Int+ -> GingerT Identity a+ -> a+runGingerIdentityWithLoader loader rngSeed action =+ either (error . show) id $ runGingerIdentityEitherWithLoader loader rngSeed action runGingerIdentityEitherWithLoader :: TemplateLoader Identity+ -> Int -> GingerT Identity a -> Either PrettyRuntimeError a-runGingerIdentityEitherWithLoader loader action =+runGingerIdentityEitherWithLoader loader rngSeed action = mapLeft (PrettyRuntimeError . unPositionedError) $- runIdentity (runGingerT action defContext { contextLoadTemplateFile = loader } defEnv)+ runIdentity+ (runGingerT+ action+ defContext { contextLoadTemplateFile = loader }+ defEnv+ (mkStdGen rngSeed)) mockLoader :: [(Text, Text)] -> TemplateLoader Identity mockLoader entries name =