diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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. diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -2,13 +2,13 @@ ![](http://ginger.tobiasdammers.nl/static/img/ginger-leaf.svg) -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 @@ -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` diff --git a/cli/Main.hs b/cli/Main.hs --- a/cli/Main.hs +++ b/cli/Main.hs @@ -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) diff --git a/ginger2.cabal b/ginger2.cabal --- a/ginger2.cabal +++ b/ginger2.cabal @@ -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 diff --git a/src/Language/Ginger.haddock b/src/Language/Ginger.haddock new file mode 100644 --- /dev/null +++ b/src/Language/Ginger.haddock @@ -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__ + +> +> +> +> {{ title }} +> +> {# This is a comment. Comments are removed from the output. #} +> +> +> {% for item in navigation %} +>
  • {{ item.label }}
    • +> {% endfor %} +>     +>
    +>

    {{ title }}

    +> {{ body }} +>
    +> +> + +== __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 %} +>

    {{ user.username }}

    +> {% else %} +>

    No users found.

    +> {% 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 %} +>
    +>

    {{ branch.name }}

    +>

    {{ branch.description }}

    +> {% 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) %} +>
    +>

    {{ user.username }}

    +>

    Role: {{ user.role }}

    +>

    Status: {% if user.active %}active{% else %}inactive{% endif %} +> {% if extraInfo is not none %} +> {{ extraInfo }} +> {% endif %} +>

    +> {% 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) %} +>
    +>

    {{ title }}

    +> {{ caller() }} +>
    +> {% 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: + +>
    +>

    Some Section

    +> Lorem ipsum dolor sit amet. +>
    + +=== @{% 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@) + +> +> +> +> +> {% block "title" %}Unnamed Page{% endblock %} +> +> +> +> {% include "mainnav.html" %} +>
    +> {% block content %} +> Nothing to see here. +> {% endblock } +>
    +> +> + +(@userlist.html@) + +> {% extends "skeleton.html" %} +> {% block "title" %}Users{% endblock %} +> {% block "content" %} +>

    Users

    +> +> {% endblock %} diff --git a/src/Language/Ginger.hs b/src/Language/Ginger.hs --- a/src/Language/Ginger.hs +++ b/src/Language/Ginger.hs @@ -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) diff --git a/src/Language/Ginger/AST.hs b/src/Language/Ginger/AST.hs --- a/src/Language/Ginger/AST.hs +++ b/src/Language/Ginger/AST.hs @@ -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 diff --git a/src/Language/Ginger/BuiltinsAutodoc.hs b/src/Language/Ginger/BuiltinsAutodoc.hs new file mode 100644 --- /dev/null +++ b/src/Language/Ginger/BuiltinsAutodoc.hs @@ -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) diff --git a/src/Language/Ginger/Interpret/Builtins.hs b/src/Language/Ginger/Interpret/Builtins.hs --- a/src/Language/Ginger/Interpret/Builtins.hs +++ b/src/Language/Ginger/Interpret/Builtins.hs @@ -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) diff --git a/src/Language/Ginger/Interpret/DefEnv.hs b/src/Language/Ginger/Interpret/DefEnv.hs --- a/src/Language/Ginger/Interpret/DefEnv.hs +++ b/src/Language/Ginger/Interpret/DefEnv.hs @@ -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 diff --git a/src/Language/Ginger/Interpret/Eval.hs b/src/Language/Ginger/Interpret/Eval.hs --- a/src/Language/Ginger/Interpret/Eval.hs +++ b/src/Language/Ginger/Interpret/Eval.hs @@ -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 diff --git a/src/Language/Ginger/Interpret/Type.hs b/src/Language/Ginger/Interpret/Type.hs --- a/src/Language/Ginger/Interpret/Type.hs +++ b/src/Language/Ginger/Interpret/Type.hs @@ -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 diff --git a/src/Language/Ginger/Parse.hs b/src/Language/Ginger/Parse.hs --- a/src/Language/Ginger/Parse.hs +++ b/src/Language/Ginger/Parse.hs @@ -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 diff --git a/src/Language/Ginger/SourcePosition.hs b/src/Language/Ginger/SourcePosition.hs --- a/src/Language/Ginger/SourcePosition.hs +++ b/src/Language/Ginger/SourcePosition.hs @@ -10,7 +10,7 @@ , sourceLine :: !Int , sourceColumn :: !Int } - deriving (Show, Eq) + deriving (Show, Eq, Ord) prettySourcePosition :: SourcePosition -> String prettySourcePosition s = diff --git a/src/Language/Ginger/Value.hs b/src/Language/Ginger/Value.hs --- a/src/Language/Ginger/Value.hs +++ b/src/Language/Ginger/Value.hs @@ -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 {}) = "<>" + show (ProcedureV (NativeProcedure oid _ _)) = "<>" show (ProcedureV {}) = "<>" - show (TestV {}) = "<>" - show (FilterV {}) = "<>" + show (TestV t) = + "<) . procedureDocName) + (testDoc t) + ) ++ + ">>" + show (FilterV f) = + "<) . 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 "" @@ -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 "" "" "end of arguments" "value" instance Applicative m => ToNativeProcedure m (m (Value m)) where - toNativeProcedure action [] _ = + toNativeProcedure action [] _ _ = Right <$> action - toNativeProcedure _ _ _ = + toNativeProcedure _ _ _ _ = pure . Left $ ArgumentError "" "" "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 "" "" "end of arguments" "value" instance (Applicative m, ToNativeProcedure m a) => ToNativeProcedure m (Value m -> a) where - toNativeProcedure _ [] _ = + toNativeProcedure _ [] _ _ = pure . Left $ ArgumentError "" "" "value" "end of arguments" - toNativeProcedure _ ((Just _, _):_) _ = + toNativeProcedure _ ((Just _, _):_) _ _ = pure . Left $ ArgumentError "" "" "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" diff --git a/test/Language/Ginger/Interpret/Tests.hs b/test/Language/Ginger/Interpret/Tests.hs --- a/test/Language/Ginger/Interpret/Tests.hs +++ b/test/Language/Ginger/Interpret/Tests.hs @@ -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 diff --git a/test/Language/Ginger/Parse/Tests.hs b/test/Language/Ginger/Parse/Tests.hs --- a/test/Language/Ginger/Parse/Tests.hs +++ b/test/Language/Ginger/Parse/Tests.hs @@ -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" $ diff --git a/test/Language/Ginger/TestUtils.hs b/test/Language/Ginger/TestUtils.hs --- a/test/Language/Ginger/TestUtils.hs +++ b/test/Language/Ginger/TestUtils.hs @@ -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 =