bricks 0.0.0.2 → 0.0.0.4

raw patch · 24 files changed

+1348/−3002 lines, 24 filesdep +bricks-internaldep +bricks-internal-testdep +bricks-parsecdep ~basedep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bricks-internal, bricks-internal-test, bricks-parsec, bricks-rendering, bricks-syntax, mtl, transformers

Dependency ranges changed: base, template-haskell

API changes (from Hackage documentation)

Files

• bricks.cabal +50/−57
• src/Bricks.hs +395/−62
• src/Bricks/BuiltinFunctions.hs +150/−0
• src/Bricks/Evaluation.hs +286/−0
• src/Bricks/Expression.hs +0/−583
• src/Bricks/Expression/Construction.hs +0/−233
• src/Bricks/ExpressionToTerm.hs +181/−0
• src/Bricks/IndentedString.hs +0/−120
• src/Bricks/Internal/Monad.hs +16/−0
• src/Bricks/Internal/Prelude.hs +0/−43
• src/Bricks/Internal/Seq.hs +0/−47
• src/Bricks/Internal/Text.hs +0/−35
• src/Bricks/Keyword.hs +0/−67
• src/Bricks/Parsing.hs +0/−679
• src/Bricks/Prelude.hs +42/−0
• src/Bricks/Rendering.hs +0/−281
• src/Bricks/Term.hs +117/−0
• src/Bricks/Type.hs +43/−0
• src/Bricks/UnquotedString.hs +0/−83
• test/Bricks/Test/Hedgehog.hs +0/−23
• test/Bricks/Test/QQ.hs +0/−39
• test/evaluation.hs +68/−0
• test/parsing.hs +0/−527
• test/rendering.hs +0/−123

@@ -1,14 +1,16 @@--- This file has been generated from package.yaml by hpack version 0.18.1.+-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack+--+-- hash: edb5a78c7015968892083343d6c79fc374ae3408d793f8921575ed36fe3a3803  name:           bricks-version:        0.0.0.2+version:        0.0.0.4 synopsis:       Bricks is a lazy functional language based on Nix.  description:    Bricks is a lazy functional language based on Nix.                 This package provides parsing, rendering, and-                evaluation (forthcoming) for the Bricks language.+                evaluation for the Bricks language. category:       Language homepage:       https://github.com/chris-martin/bricks#readme bug-reports:    https://github.com/chris-martin/bricks/issues@@ -28,22 +30,25 @@       src   ghc-options: -Wall   build-depends:-      base       >= 4.9   && < 4.10-    , containers >= 0.5.7 && < 0.6-    , parsec     >= 3.1.6 && < 3.2-    , text       >= 1.2.2 && < 1.3+      base >=4.9 && <4.11+    , bricks-internal+    , bricks-parsec+    , bricks-rendering+    , bricks-syntax+    , containers >=0.5.7 && <0.6+    , mtl+    , parsec >=3.1.6 && <3.2+    , text >=1.2.2 && <1.3+    , transformers   exposed-modules:       Bricks-      Bricks.Expression-      Bricks.Expression.Construction-      Bricks.IndentedString-      Bricks.Keyword-      Bricks.Parsing-      Bricks.Rendering-      Bricks.UnquotedString-      Bricks.Internal.Prelude-      Bricks.Internal.Seq-      Bricks.Internal.Text+      Bricks.BuiltinFunctions+      Bricks.Evaluation+      Bricks.ExpressionToTerm+      Bricks.Prelude+      Bricks.Term+      Bricks.Type+      Bricks.Internal.Monad   other-modules:       Paths_bricks   default-language: Haskell2010@@ -55,54 +60,42 @@       test   ghc-options: -Wall -threaded   build-depends:-      base       >= 4.9   && < 4.10-    , containers >= 0.5.7 && < 0.6-    , parsec     >= 3.1.6 && < 3.2-    , text       >= 1.2.2 && < 1.3-    , bricks-    , base    >= 4.9  && < 4.10-    , doctest >= 0.11 && < 0.14-  other-modules:-      Bricks.Test.Hedgehog-      Bricks.Test.QQ-  default-language: Haskell2010--test-suite parsing-  type: exitcode-stdio-1.0-  main-is: parsing.hs-  hs-source-dirs:-      test-  ghc-options: -Wall -threaded-  build-depends:-      base       >= 4.9   && < 4.10-    , containers >= 0.5.7 && < 0.6-    , parsec     >= 3.1.6 && < 3.2-    , text       >= 1.2.2 && < 1.3-    , bricks-    , base             >= 4.9 && < 4.10-    , hedgehog         >= 0.5 && < 0.6-    , template-haskell >= 2.2 && < 2.12+      base >=4.9 && <4.11+    , bricks-internal+    , bricks-parsec+    , bricks-rendering+    , bricks-syntax+    , containers >=0.5.7 && <0.6+    , doctest >=0.11 && <0.14+    , mtl+    , parsec >=3.1.6 && <3.2+    , text >=1.2.2 && <1.3+    , transformers   other-modules:-      Bricks.Test.Hedgehog-      Bricks.Test.QQ+      Paths_bricks   default-language: Haskell2010 -test-suite rendering+test-suite evaluation   type: exitcode-stdio-1.0-  main-is: rendering.hs+  main-is: evaluation.hs   hs-source-dirs:       test   ghc-options: -Wall -threaded   build-depends:-      base       >= 4.9   && < 4.10-    , containers >= 0.5.7 && < 0.6-    , parsec     >= 3.1.6 && < 3.2-    , text       >= 1.2.2 && < 1.3+      base >=4.9 && <4.11     , bricks-    , base             >= 4.9 && < 4.10-    , hedgehog         >= 0.5 && < 0.6-    , template-haskell >= 2.2 && < 2.12+    , bricks-internal+    , bricks-internal-test+    , bricks-parsec+    , bricks-rendering+    , bricks-syntax+    , containers >=0.5.7 && <0.6+    , hedgehog >=0.5 && <0.6+    , mtl+    , parsec >=3.1.6 && <3.2+    , template-haskell >=2.2 && <2.13+    , text >=1.2.2 && <1.3+    , transformers   other-modules:-      Bricks.Test.Hedgehog-      Bricks.Test.QQ+      Paths_bricks   default-language: Haskell2010

@@ -1,41 +1,42 @@-{- | __Bricks__ is a lazy functional language that strongly resembles Nix.--Notable differences from Nix:+{- | -- No built-in null, integer, or boolean types-- No @builtins@ and no infix operators (@+@, @-@, @//@)-- No URI literals-- No escape sequences in indented strings (@''@...@''@)-- The inline comment keyword is @--@ rather than @#@-- There are block comments in the form @{\-@...@-\}@-- The concept of "set" is referred to as "dict" (this is not actually a language-  difference, we just use a different word to talk about the same concept)+__Bricks__ is a lazy functional language that resembles+<https://nixos.org/nix/manual/#ch-expression-language Nix>. -The following modules are re-exported from this module in their entireties:+This module serves as fairly exhaustive overview of the entire package, and+should usually serve as your go-to place to start when reading the Bricks+documentation if you want an /in-depth/ understanding of how everything works.+It is a fairly /large/ module, and probably ought to be used via a qualified+import. -- "Bricks.Expression" - Defines most of the types, notably 'Expression'-- "Bricks.IndentedString" - Deals with the whitespace cleanup performed when-  parsing indented strings (@''@...@''@)-- "Bricks.Keyword" - Enumerates the language's keywords-- "Bricks.Parsing" - Defines all of the Parsec parsers for parsing Bricks code-  into 'Expression's-- "Bricks.Rendering" - Defines all of the renderers for turning 'Expression's-  into Bricks code-- "Bricks.UnquotedString" - Defines the rules for what strings are allowed to-  appear unquoted in Bricks code+> import qualified Bricks -Other modules:+If you just want to use Bricks for common cases, look at the simple API in+"Bricks.Prelude" instead. That module is much smaller and is designed to be+imported unqualified. -- "Bricks.Expression.Construction" - Functions for constructing 'Expression's-  in a way that matches their 'Show' implementations.+> import Bricks.Prelude  -} module Bricks    (   -------------------------------------------------++  -- * Module overview+  -- $module-overview++  -------------------------------------------------++  -- * Differences from Nix+  -- $differences-from-nix++  -------------------------------------------------+   -- * Expressions     Expression (..)+  , expression'source+  , expression'discardSource   -- ** Rendering expressions   , render'expression   , render'expression'listContext@@ -47,18 +48,35 @@   -- ** Parsing expressions   , parse'expression   , parse'expression'paren+  , parse'expression'antiquote   , parse'expression'dictKey   -- ** Parsing lists of expressions   , parse'expressionList   , parse'expressionList'1   , parse'expressionList'1'noDot+   -------------------------------------------------++  -- * Variables+  , Var (..)+  , var'text+  , render'var+  , parse'var+  , var'to'str'static+  , var'to'str'dynamic+  , var'discardSource++  -------------------------------------------------+   -- * Strings   , str'escape   , parse'str'within'normalQ   , parse'str'escape'normalQ   -- ** Static strings-  , Str'Static+  , Str'Static (..)+  , str'static'append+  , str'static'discardSource+  , str'static'to'dynamic   , render'strStatic'unquotedIfPossible   , render'strStatic'quoted   , parse'strStatic@@ -67,137 +85,452 @@   -- ** Dynamic strings   , Str'Dynamic (..)   , Str'1 (..)-  , strDynamic'toList-  , strDynamic'fromList-  , strDynamic'singleton+  , str'1'discardSource+  , str'dynamic'append+  , str'dynamic'normalize+  , str'dynamic'discardSource+  , str'dynamic'to'static   , render'strDynamic'unquotedIfPossible   , render'strDynamic'quoted-  , parse'strDynamic'quoted-  , parse'strDynamic'normalQ-  , parse'strDynamic'indentedQ+  , render'str'1+  , parse'str'dynamic   -- ** Unquoted strings-  , Str'Unquoted (..)-  , str'tryUnquoted-  , str'unquoted'orThrow-  , str'canRenderUnquoted-  , char'canRenderUnquoted-  , render'strUnquoted+  , UnquotedString+  , unquotedString'try+  , unquotedString'orThrow+  , unquotedString'text+  , text'canBeUnquoted+  , char'canBeUnquoted   , parse'strUnquoted-  -- ** String conversions-  , str'dynamicToStatic-  , str'staticToDynamic-  , str'unquotedToDynamic   -- ** Indented strings   , InStr (..)+  , InStr'1 (..)+  , inStr'1'toStrParts   , inStr'toList-  , inStr'join+  , inStr'to'strDynamic   , inStr'level   , inStr'dedent   , inStr'trim-  , render'inStr'1+  , inStr'discardSource+  , inStr'1'discardSource+  , render'str'indented+  , render'str'indented'1   , parse'inStr   , parse'inStr'1-  -- ** Single line of an indented string-  , InStr'1 (..)-  , inStr'1'nonEmpty-  , inStr'1'empty-  , inStr'1'modifyLevel+   -------------------------------------------------+   -- * Lists   , List (..)+  , list'discardSource   , render'list   , parse'list+   -------------------------------------------------+   -- * Dicts   , Dict (..)   , keyword'rec+  , dict'discardSource   , render'dict   , parse'dict   , parse'dict'rec   , parse'dict'noRec   -- ** Dict bindings   , DictBinding (..)+  , dictBinding'discardSource   , render'dictBinding   , parse'dictBinding   , parse'dictBinding'inherit   , parse'dictBinding'eq   -- ** Dict lookup (dot)   , Dot (..)+  , dot'discardSource   , expression'applyDots   , render'dot   , parse'dot'rhs'chain+   -------------------------------------------------+   -- * Functions   -- ** Lambdas   , Lambda (..)+  , lambda'discardSource   , render'lambda   , parse'lambda   -- ** Function parameters   , Param (..)+  , param'discardSource   , render'param   , parse'param   , parse'param'var   , parse'param'noVar   -- ** Dict patterns   , DictPattern (..)+  , dictPattern'discardSource   , DictPattern'1 (..)+  , dictPattern'1'discardSource   , render'dictPattern   , render'dictPattern'1   , parse'dictPattern   , parse'dictPattern'start   -- ** Function application   , Apply (..)+  , apply'discardSource   , expression'applyArgs   , render'apply+   -------------------------------------------------+   -- * @let@   , Let (..)+  , let'discardSource   , keyword'let   , keyword'in   , render'let   , parse'let   -- ** @let@ bindings   , LetBinding (..)+  , letBinding'discardSource   , render'letBinding   , parse'letBinding   , parse'letBinding'eq   , parse'letBinding'inherit-  --------------------------------------------------  -- * @with@-  , With (..)-  , keyword'with-  , render'with-  , parse'with+   -------------------------------------------------+   -- * @inherit@-  , Inherit (..)   , keyword'inherit-  , render'inherit-  , parse'inherit+   -------------------------------------------------+   -- * Keywords   , Keyword   , keywords   , keywordString   , keywordText   , parse'keyword+   -------------------------------------------------+   -- * Comments and whitespace   , keyword'inlineComment   , parse'spaces   , parse'comment   , parse'comment'inline   , parse'comment'block+   --------------------------------------------------  -- * Miscellanea++  -- * Rendering   , Render-  , parse'antiquote+  , RenderContext (..)+  , renderContext'default+  , renderContext'terse+   -------------------------------------------------+   ) where  import Bricks.Expression-import Bricks.IndentedString import Bricks.Keyword-import Bricks.Parsing+import Bricks.Parsec import Bricks.Rendering import Bricks.UnquotedString++{- $module-overview++== Modules that are re-exported from "Bricks"++The following modules are re-exported from this top-level "Bricks" module in+their entireties.++Modules related to syntax:++  - "Bricks.Keyword" - Enumerates the language's keywords+  - "Bricks.UnquotedString" - Defines the rules for what strings are allowed to+    appear unquoted in Bricks code+  - "Bricks.Expression" - Defines most of the types related to the AST, notably+    'Expression'+  - "Bricks.Parsec" - Defines all of the Parsec parsers for parsing Bricks code+    into 'Expression's+  - "Bricks.Rendering" - Defines all of the renderers for turning 'Expression's+    into Bricks code++Modules related to evaluation:++  - "Bricks.Term" - ...+  - "Bricks.ExpressionToTerm" - ...+  - "Bricks.Evaluation" - ...++== Modules that are /not/ re-exported from "Bricks"++  - "Bricks.Expression.Construction" - Functions for constructing 'Expression's+    in a way that matches their 'Show' implementations.++-}++{- $differences-from-nix++Bricks is heavily based on+<https://nixos.org/nix/manual/#ch-expression-language the Nix language>,+but there are a number of significant differences. Most of the differences+involve the /removal/ of some feature for the sake of simplicity in both+implementation and use.++This list is not comprehensive.++== Top-level Bricks expressions may contain no free variables++There are a number of cases where variables are allowed to appear free in a+top-level Nix expression: @true@, @false@, @null@, @builtins@, and anything+within the body of a @with@ expression (sort of - we'll elaborate on that+complicated issue further below). None of those cases are present in Bricks:+__/All variables must be explicitly bound/__.++Throughout this section we will more thoroughly address specific Nix built-in+variables and how to translate Nix expressions that use them into equivalent+Bricks code.++== Bricks has no built-in Boolean values++Nix has built-in @true@ and @false@ variables, a handful of operators on them+(@&&@, @||@, @!@), and an @if@-@then@-@else@ construct.++> nix-repl> true && false+> false++> nix-repl> true || false+> true++> nix-repl> !true+> false++> nix-repl> if true then "a" else "b"+> "a"++None of these features are present in Bricks.++__todo:__ Show how we can use the standard library instead.++== Bricks has no built-in @null@++__todo:__ Show how we can use the standard library instead.++== Bricks has no integer literals++__todo:__ Show how we can use the standard library instead.++== Bricks has no built-in @builtins@++__todo:__ Show how we can use the standard library instead.++== Bricks has no infix operators (@+@, @-@, @//@, et cetera)++__todo:__ Show how we can use the standard library instead.++== Bricks has no @with@ expression++The Nix language has a @with@ construct which introduces the contents of a dict+into the lexical scope.++The simple reason for omitting this feature is that it can easily lead to code+that is difficult to trace. When @with@ expressions are nested, it is often+unclear where a variable has come into scope from.++The more subtle reason not to include the @with@ construct is that it introduces+a significant departure from the lambda calulus. Consider the expression @(with+d; x)@. In this expression, is @x@ free or bound? It is neither; it exists in+some state of uncertainty where it /may or may not be/ bound, depending on the+value of @d@.++This has a practical consequence: When you use a @with@ expression, you+sacrifice referential transparency. Consider the following Nix expression:++> nix-repl> let v = (with { x = "a"; }; x); in (x: v) "b"+> "a"++If we attempt to reduce this expression by replacing @v@ with its definition,++> nix-repl> (x: (with { x = "a"; }; x)) "b"+> "b"++then it no longer evaluates to the same value. We find this unacceptable.+Bricks avoids the problem by simply not implementing this feature.++== Bricks allows a list on the right-hand side of the @.@ operator++The following example is syntactically valid Nix code, but it fails to evaluate:++> nix-repl> { x = "a"; y = "b"; }.${[ "x" "y" ]}+> error: value is a list while a string was expected++We expand the meaning of the @.@ operator such that if the expression on the+right-hand side evaluates to a list, then the entire expression evaluates to a+list:++> bricks-repl> { x = "a"; y = "b"; }.${[ "x" "y" ]}+> [ "a" "b" ]++Furthermore, when the expression on the right-hand side is a list literal (an+expression of the form @[@ ... @]@), the antiquotation (wrapping the expression+in @${@ ... @}@) may be omitted:++> bricks-repl> { x = "a"; y = "b"; }.[ "x" "y" ]+> [ "a" "b" ]++This provides a convenient alternative to many situations in which one might use+the @with@ keyword in Nix. For example, where in Nix we might write++> ghcWithPackages (p: with p; [ base containers text ]);++we may write this equivalently in Bricks as++> ghcWithPackages (p: p.[ "base" "containers" "text" ]);++== Bricks does not have URI literals++If a string literal is a URI, it can be written in Nix without quotes.++We have chosen not to include this feature because it provides very little+convenience and steals some syntax from lambda expressions. Consider the+following Nix example:++> nix-repl> (let x = "a"; in y: x) "b"+> "a"++If we remove the space between after the colon (@:@), we get something entirely+different:++> nix-repl> (let x = "a"; in y:x) "b"+> error: attempt to call something which is not+> a function but a string, at (string):1:1++Because @y:x@ contains a colon, Nix interprets it as a URI and parses it as the+string @"y:x"@ (this is the "string" to which the error message refers), rather+than as a lambda.++In Bricks, by contrast, the colon in a lambda is /not/ required to be followed+by whitespace, and the previous example works as we would like.++> bricks-repl> (let x = "a"; in y:x) "b"+> "a"++== Bricks does not have path literals++In Nix, an unquoted string that contains a slash is interpreted as a filesystem+path.++Path literals have some subtle syntax rules. A common mistake is forgetting+to always include a slash in the path. For an example, @./foo.nix@ is a URI:++> nix-repl> ./foo.nix+> /home/chris/foo.nix++But @foo.nix@, without the leading @./@, is parsed differently:++> nix-repl> foo.nix+> error: undefined variable ‘foo’ at (string):1:1++As with URI literals, we find that the unquoted form for paths does not provide+enough convenience to compensate for its potential for confusion, so we have+opted to omit it.++== Bricks does not have a built-in @import@ function++In Nix, a path literal that does not start with a slash (such as @./foo.nix@) is+interpreted as a /relative/ path, and the Nix parser immediately resolves it+with respect to the directory in which the Nix file resides (as we saw in the+example above, where it resolved to @\/home\/chris\/foo.nix@).++We love being able to use relative imports, but we don't like needing a built-in+language feature to do it. Fortunately, Bricks can achieve the same effect by+using an ordinary function instead.++__todo:__ Explain how imports work in the standard library, once it is+implemented.++In doing this, we buy back some purity that Nix's @import@ lacks. By passing the+path argument through a function parameter, rather than deriving it implicitly+from the context of "which file did the expression /come from/?" we eliminate a+case where an expression's meaning depends on something other than the values of+the formal parameters that bind its free variables.++There is another benefit to the Bricks approach: While Nix import syntax is+restricted to static paths only (the argument to @import@ cannot contain free+variables), Bricks has no such limitation.++== Bricks uses Haskell-style comments++The Bricks inline comment keyword is @--@; in Nix it is @#@.++The Bricks block comment form is @{\-@ ... @-\}@; in Nix it is @/*@ ... @*/@.++This decision was made merely due to the Bricks authors' aesthetic preference+and affinity for Haskell.++== Bricks block comments may be nested++Although Nix does have block comments,++> nix-repl> /* */ "a"+> "a"++Nix does not support /nested/ block comments:++> nix-repl> /* /* */ */ "a"+> error: syntax error, unexpected '*', at (string):1:10++Bricks does:++@+bricks-repl> {\- {\- -\} -\} "a"+"a"+@++== Bricks does not support escape sequences in indented strings++Within the indented string form (@''@ ... @''@), Nix supports the following+unorthodox escape sequences:++  - @''${@ → @${@+  - @'''@ → @''@+  - @''\\n@ → newline+  - @''\\r@ → carriage return+  - @''\\t@ → tab++> nix-repl> ''ab''\ncd''+> "ab\ncd"++Bricks does not support any of these. If you want to include any of these+strings within an indented string, you can use antiquotation:++> bricks-repl> ''ab${"\n"}cd''+> "ab\ncd"++Or you can interpret escape sequences at runtime by passing your string through+some function in the standard library that does this sort of thing (__todo:__+discuss said function, once it exists).++== Bricks does not allow quotes in /let/ bindings++In Nix, the left-hand side of a /let/ binding is allowed to be a quoted string.+This lets you create variables that aren't valid as variable expressions (when+you /refer to/ a variable, it may /not/ be quoted), which puts you in a weird+sitation where there is a variable in scope which can only be referred to by+inheriting it into a dict.++> nix-repl> let "a b" = "c"; in { inherit "a b"; }+> { "a b" = "c"; }++This oddity does not seem to serve any real purpose, so we have omitted it.++== The Nix "set" concept is renamed to "dict" in Bricks++The Nix concept of "set" is referred to as "dict" in Bricks. This is not+actually a language difference; we just use a different word to talk about the+same thing. We believe that "dict" is a more familiar term for this data+structure, and that Nix's use of "set" conflicts unnecessarily with the more+common usage of the word.++-}

@@ -0,0 +1,150 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeApplications           #-}++module Bricks.BuiltinFunctions where++import Bricks.Term+import Bricks.Type++-- Bricks internal+import           Bricks.Internal.Prelude+import           Bricks.Internal.Text    (Text)+import qualified Bricks.Internal.Text    as Text++-- Containers+import qualified Data.Map as Map+import           Data.Set (Set)++-- Base+import Data.Dynamic  (fromDynamic, toDyn)+import Data.Typeable (Typeable)+import Prelude       (Integer, Num (..))+import Text.Read     (readMaybe)++term'data :: forall a. Typeable a => Type a -> a -> Term+term'data (Type n) = Term'Data n . toDyn @a++fn'pure'parametric'arity1 :: (Term -> Term) -> Term+fn'pure'parametric'arity1 f =+  Term'Function $ \x -> pure $+  f x++fn'pure'parametric'arity2 :: (Term -> Term -> Term) -> Term+fn'pure'parametric'arity2 f =+  Term'Function $ \x -> pure $+  fn'pure'parametric'arity1 $ f x++fn'pure'parametric'arity3 :: (Term -> Term -> Term -> Term) -> Term+fn'pure'parametric'arity3 f =+  Term'Function $ \x -> pure $+  fn'pure'parametric'arity2 $ f x++fn'id :: Term+fn'id = fn'pure'parametric'arity1 id++fn'const :: Term+fn'const = fn'pure'parametric'arity2 const++{- | Function composition, in the traditional "backwards" order.++Read @f `fn'comp` g@ as "/f/ after /g/." -}++fn'comp :: Term+fn'comp = fn'pure'parametric'arity3 $ \f g x -> f /@\ (g /@\ x)++fn'flip :: Term+fn'flip = fn'pure'parametric'arity3 $ \f x y -> f /@@\ (y, x)++fn'dict'lookup :: Term+fn'dict'lookup =+  Term'Function $ \x -> do+    map <- reduce'dict'keys x+    pure $ Term'Function $ \y -> do+      key <- cast'data type'string y+      case Map.lookup key map of+        Nothing -> bottom . Bottom $ "Key " <> key <> " not found in dict"+        Just a -> pure a++fn'or :: Term+fn'or =+  Term'Function $ \x -> cast'data type'boolean x <&>+  \case+    True -> fn'const /@\ term'data type'boolean True+    False -> assert'type type'boolean++fn'and :: Term+fn'and =+  Term'Function $ \x -> cast'data type'boolean x <&>+  \case+    False -> fn'const /@\ term'data type'boolean False+    True -> assert'type type'boolean++fn'string'append :: Term+fn'string'append =+  Term'Function $ \x -> cast'data type'string x <&> \x' ->+  Term'Function $ \y -> cast'data type'string y <&> \y' ->+  term'data type'string (Text.append x' y')++fn'dict'disallowExtraKeys :: Set Text -> Term+fn'dict'disallowExtraKeys _allowedKeys =+  Term'Function $ undefined++fn'dict'merge'preferLeft :: Term+fn'dict'merge'preferLeft =+  Term'Function $ \x -> reduce'dict'keys x <&> \x' ->+  Term'Function $ \y -> reduce'dict'keys y <&> \y' ->+  Term'Dict'ReducedKeys $ Map.union x' y'++fn'dict'merge'preferRight :: Term+fn'dict'merge'preferRight = fn'flip /@\ fn'dict'merge'preferLeft++cast'data :: (MonadEval m, Typeable a) => Type a -> Term -> m a+cast'data = req fst++-- | Like 'fn'id', but fails if the argument is not of the given type.+assert'type :: Typeable a => Type a -> Term+assert'type t = Term'Function $ req snd t++req :: forall a b m. (MonadEval m, Typeable a)+  => ((a, Term) -> b)+  -> Type a+  -> Term+  -> m b+req s (Type n) = reduce'term >=> \case+  t@(Term'Data n' x) ->+    case fromDynamic @a x of+      Nothing -> bottom . Bottom $ "Expected " <> n <> ", got " <> n'+      Just a -> pure (s (a, t))+  x ->+    termTypeName x >>= \n' ->+      bottom . Bottom $ "Expected " <> n <> ", got " <> n'++fn'int'add :: Term+fn'int'add =+  Term'Function $ \x -> cast'data type'integer x <&> \x' ->+  Term'Function $ \y -> cast'data type'integer y <&> \y' ->+  term'data type'integer (x' + y')++fn'int'constructor :: Term+fn'int'constructor =+  Term'Function $ cast'data type'string >=> (+    Text.unpack >>> readMaybe @Integer >>>+    maybe (bottom . Bottom $ "invalid integer")+          (pure . term'data type'integer)+  )++standard'library :: Term+standard'library =+  Term'Dict'ReducedKeys . Map.fromList $+    [ ("add", fn'int'add)+    , ("integer", fn'int'constructor)+    , ("and", fn'and)+    , ("or", fn'or)+    , ("id", fn'id)+    , ("const", fn'const)+    ]

@@ -0,0 +1,286 @@+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs               #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TupleSections              #-}+{-# LANGUAGE TypeApplications           #-}++{- |++This module lets you evaluate Bricks expressions. First 'expression'to'term's+converts the abstract syntax tree ('Expression') into an enriched version of the+lambda calculus ('Term'). Then we perform /graph reduction/, repeatedly applying+simplifications until we arrive at an irreducible term.++When we substitute an argument into a lambda body to perform beta-conversion, we+do so by substituting a 'Pointer' of the argument rather than the term itself.+This gives rise to /sharing/, thus turning the tree into a general graph, and+helps avoid reducing the same expression more than once.++= /The Implementation of Functional Programming Languages/++The design of Bricks evaluation is in large part based on Simon Peyton Jones's+1987 book+<https://www.microsoft.com/en-us/research/publication/the-implementation-of-functional-programming-languages/ The Implementation of Functional Programming Languages>.+In attempt to keep the Bricks API documentation mostly self-contained, we avoid+making frequent references to this work throughout. Instead, here we give a list+of some important connections to the book:++  - The rationale for immediately converting the AST into another data structure+    rather than performing any transformations directly on the AST comes from+    page 38.++  - A Bricks function defined using a dict pattern turns into a+    "pattern-matching lambda abstraction"; this term is introduced on page 61.++  - Page 185 introduces the style of drawing ASTs to which the '/@\' operator+    alludes.++  - /Pointer substitution/ is described on page 208.++  - The implementation of 'term'substitute' closely follows the description of+    /Instantiate/, page 210.++  - Page 20 introduces the name capture problem. Pages 199 and 210 discuss how+    we avoid it by only reducing the top-level redex, which has no free+    variables.++  - On page 233 starts the discussion of how letrec expressions are instantiated+    as cyclic graphcs.++-}+module Bricks.Evaluation where++-- Bricks+import Bricks.BuiltinFunctions+import Bricks.Term+import Bricks.Type++-- Bricks internal+import           Bricks.Internal.Map     (Map)+import qualified Bricks.Internal.Map     as Map+import           Bricks.Internal.Monad+import           Bricks.Internal.Prelude+import           Bricks.Internal.Text    (Text)+import qualified Bricks.Internal.Text    as Text++-- Containers+import qualified Data.Set as Set++-- Base+import Data.Typeable (Typeable)+import Prelude       (error)+import System.IO     (IO)++newtype Eval a = Eval { unEval :: ExceptT Bottom IO a }+  deriving (Functor, Applicative, Monad, MonadError Bottom, MonadIO)++instance MonadEval Eval+  where++    reduce'term :: Term -> Eval Term+    reduce'term =+      \case+        Term'Pointer p ->+          readTermPtr p >>= reduce'term++        t@(Term'Data _ _) -> pure t+        t@(Term'Function _) -> pure t+        t@(Term'Lambda _ _) -> pure t+        t@(Term'List _) -> pure t+        t@(Term'Dict _) -> pure t+        t@(Term'Dict'ReducedKeys _) -> pure t+        Term'Var x ->+          bottom . Bottom $ "Free variable: " <> x++        Term'LetRec map body -> do+          -- Create a pointer for each of the let bindings+          map' <- traverse create'pointer map :: Eval (Map Text Term)+          -- Substitute each of the bindings into each of the others+          traverse_ (instantiate'many map') map'+          -- Substitute all of the bindings into the body+          instantiate'many map' body >>= reduce'term++        Term'Apply f value ->+          reduce'term f >>= \case++            Term'Function f' ->+              f' value >>= reduce'term++            -- The function is a lambda, so it can be applied to an argument.+            Term'Lambda pattern body ->+              case pattern of++                -- A simple single-variable pattern+                TermPattern'Simple var ->+                  create'pointer value >>= \value'ptr ->+                    instantiate'one var value'ptr body++                -- A dict pattern+                TermPattern'Dict vars ->+                  reduce'dict'keys value >>= \values ->+                    case Map.exactKeys values vars of+                      Left missingKeys -> bottom . Bottom $+                        "Dict lookup failed: " <>+                        Text.show (Set.toList missingKeys)+                      Right values' -> instantiate'many values' body++            t ->+              termTypeName t >>= \n ->+                bottom . Bottom $ "Expected function, got " <> n++    reduce'dict'keys :: Term -> Eval (Map Text Term)+    reduce'dict'keys = reduce'term >=> \case+      Term'Dict _ ->+        undefined+      Term'Dict'ReducedKeys x ->+        pure x+      x ->+        termTypeName x >>= \n' ->+          bottom . Bottom $ "Expected dict, got " <> n'++does'termPattern'bind :: Text -> TermPattern -> Bool+does'termPattern'bind n = \case+  TermPattern'Simple x  -> n == x+  TermPattern'Dict   xs -> n `Set.member` xs++{- | @instantiate var value body@ produces a copy of the term @body@,+substituting @value@ for free occurrences of @var@. -}++instantiate'one+  :: forall m. MonadEval m+  => Text  -- ^ @var@   - Variable name+  -> Term  -- ^ @value@ - The argument being substituted. We assume that this+           --             term has no free variables; or else we will suffer+           --             the /name capture problem/.+  -> Term  -- ^ @body@  - The term being copied ("instantiated")+  -> m Term++-- The numbered comments within this definition are nearly verbatim from+-- page 210 of /The Implementation of Functional Programming Languages/.+-- There SPJ denotes this construction as body[value/var].++instantiate'one var value =+  go+  where+    go :: Term -> m Term+    go body = case body of+      Term'Var x ->++        -- 1. If /body/ is a variable x and /var/ = x, then return /value/+        --    (here we substitute /value/ for an occurrence of /var/).+        if x == var then pure value++        -- 2. If /body/ is a variable x and /var/ ≠ x, then return /body/.+        else pure body++      -- 3. If /body/ is a constant or built-in function, then return /body/.+      Term'Data _ _   -> pure body -- constant+      Term'Function _ -> pure body -- built-in function++      -- 4. If /body/ is an application (e1 e2), then return the application+      --    (e1[value/var] e2[value/var]).+      Term'Apply a b -> Term'Apply <$> go a <*> go b++      Term'Lambda a b ->+        -- 5. If /body/ is a lambda abstraction λx.E and /var/ = x, then return+        --    /body/ - the new lambda abstraction binds /var/ anew, so no+        --    substitutions should occur inside it, and hence we can avoid+        --    instantiating it altogether.+        if does'termPattern'bind var a then pure body++        -- 6. If /body/ is a lambda abstraction λx.E and /var/ ≠ x, then return+        --    λx.E[value/var] - we must instantiate the body in case there are+        --    any free occurrences of /var/ inside it.+        else Term'Lambda a <$> go b++      Term'LetRec a b ->+        -- The same reasoning as (5) and (6) - If the let expression binds+        -- /var/, then we do nothing. Otherwise we substitute everywhere.+        if Map.member var a then pure body+        else Term'LetRec <$> traverse go a <*> go b++      Term'List xs -> Term'List <$> traverse go xs++      Term'Dict _ -> Term'Dict <$> undefined++      Term'Dict'ReducedKeys x -> Term'Dict'ReducedKeys <$> traverse go x++      Term'Pointer p -> go =<< readTermPtr p+        -- todo - let this function return whether it made any substitutions.+        -- If it didn't, then just return the pointer.++instantiate'many+  :: forall m. MonadEval m+  => Map Text Term -- ^ @values@+  -> Term          -- ^ @body@+  -> m Term+instantiate'many values body =+  foldr f (pure body) (Map.toList values)+  where+    f :: (Text, Term) -> m Term -> m Term+    f (var, value) bod = instantiate'one var value =<< bod++reduce'to'type :: Typeable a => Type a -> Term -> IO (Either Bottom a)+reduce'to'type typ =+  (reduce'term >=> cast'data typ) >>> unEval >>> runExceptT++reduce'to'type'or'throw :: (HasCallStack, Typeable a) => Type a -> Term -> IO a+reduce'to'type'or'throw typ =+  reduce'to'type typ >=>+  either (error . Text.unpack . displayBottom) pure++{-+        -- The function is a lambda with a dict pattern.+        Term'Lambda'DictPattern dp body ->++          -- Reduce the argument, and require it to be a dict.+          reduce'term value >>= \case+            Term'Dict dict -> undefined+            x -> termTypeName x >>= \n -> evalError ("Expected dict, got " <> n)+-}++{-+    t@(Term'Pointer p) ->+      (readTermPtr p >>= reduce >>= writeTermPtr p) $> t+    x -> pure x+-}++{-+  case t of++    Term'Apply f x ->+      create'pointer x >>= \value ->+      reduce'term f >>= \case+        Term'Lambda var body -> term'substitute var value body+        Term'Lambda'DictPattern pattern body ->+          -- Reduce the argument, and require it to be a dict.+          reduce'term value >>= \case+            Term'Dict dict -> undefined+              -- Reduce all of the dict's keys.++            _ -> pure $ Term'Error "Expected dict, got something else"++          -- todo:+          --  -+          --  - fail if there are extra keys and no ellipsis+          --  - fail if there are missing keys+          --  - perform substitutions+        _ -> pure $ Term'Error "Expected function, got something else"++    Term'Var x -> pure $ Term'Error $+      "Unbound variable: " <> render'strStatic'unquotedIfPossible x++    Term'Pointer (Pointer ref) -> do+      t' <- readIORef ref+      t'' <- reduce'term t'+      writeIORef ref t''+      pure t''++    _ -> pure t++-}

@@ -1,583 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE TypeApplications           #-}--module Bricks.Expression-  (-  -- * Expressions-    Expression (..)--  -- * Strings-  , Str'Static-  , Str'Dynamic (..)-  , Str'1 (..)-  , strDynamic'toList-  , strDynamic'fromList-  , strDynamic'singleton--  -- * String conversions-  , str'dynamicToStatic-  , str'staticToDynamic-  , str'unquotedToDynamic--  -- * Lists-  , List (..)--  -- * Dicts-  , Dict (..)-  , DictBinding (..)--  -- * Dict lookup-  , Dot (..)-  , expression'applyDots--  -- * Lambdas-  , Lambda (..)--  -- * Function parameters-  , Param (..)-  , DictPattern (..)-  , DictPattern'1 (..)--  -- * Function application-  , Apply (..)-  , expression'applyArgs--  -- * @let@-  , Let (..)-  , LetBinding (..)--  -- * @with@-  , With (..)--  -- * @inherit@-  , Inherit (..)--  ) where---- Bricks-import Bricks.UnquotedString---- Bricks internal-import           Bricks.Internal.Prelude-import           Bricks.Internal.Seq     (Seq)-import qualified Bricks.Internal.Seq     as Seq-import           Bricks.Internal.Text    (Text)-import qualified Bricks.Internal.Text    as Text---- Base-import           Data.Foldable (Foldable)-import qualified Data.Foldable as Foldable-import           Prelude       (Int)--data Expression-  = Expr'Var Str'Unquoted-      -- ^ A /variable/, such as @x@.-  | Expr'Str Str'Dynamic-      -- ^ A /string/ may be quoted either in the traditional form using a-      -- single double-quote (@"@...@"@):-      ---      -- > "one\ntwo"-      ---      -- or in the "indented string" form using two single-quotes (@''@...@''@):-      ---      -- > ''-      -- >   one-      -- >   two-      -- > ''-      ---      -- Both of these examples reduce to the same value, because leading-      -- whitespace is stripped from indented strings.-      ---      -- Either may contain "antiquotation" (also known as "string-      -- interpolation") to conveniently concatenate string-valued variables-      -- into the string.-      ---      -- > "Hello, my name is ${name}!"-      ---      -- Normal strings may contain the following escape sequences:-      ---      --  - @\\\\@ → @\\@-      --  - @\\"@  → @"@-      --  - @\\${@ → @${@-      --  - @\\n@  → newline-      --  - @\\r@  → carriage return-      --  - @\\t@  → tab-      ---      -- The indented string form does not interpret any escape sequences.-  | Expr'List List-      -- ^ A /list/ is an ordered collection of expressions.-      ---      -- The empty list:-      ---      -- > [ ]-      ---      -- A list containing three variables:-      ---      -- > [ a b c ]-      ---      -- Lambdas, function applications, @let@-@in@ expressions, and @with@-      -- expressions must be parenthesized when in a list.-      ---      -- > [-      -- >   (x: f x y)-      -- >   (g y)-      -- >   (let a = y; in f a a)-      -- >   (with d; f x a)-      -- > ]-  | Expr'Dict Dict-      -- ^ A /dict/ is an unordered extensional mapping from strings.-      ---      -- The empty dict (with no bindings):-      ---      -- > { }-      ---      -- A dict with two bindings:-      ---      -- > {-      -- >   a = "one";-      -- >   b = "one two";-      -- > }-      ---      -- By default, dict bindings cannot refer to each other. For that, you-      -- need the @rec@ keyword to create a /recursive/ dict.-      ---      -- > rec {-      -- >   a = "one";-      -- >   b = "${a} two";-      -- > }-      ---      -- In either case, the order of the bindings does not matter.-      ---      -- The left-hand side of a dict binding may be a quoted string (in the-      -- traditional @"@...@"@ style, not the indented-string @''@ style),-      -- which make it possible for them to be strings that otherwise couldn't-      -- be expressed unquoted, such as strings containing spaces:-      ---      -- > { "a b" = "c"; }-      ---      -- The left-hand side of a dict may even be an arbitrary expression,-      -- using the @${@ ... @}@ form:-      ---      -- > let x = "a b"; in { ${x} = "c"; }-      ---      -- Dicts also support the @inherit@ keyword:-      ---      -- > { inherit a; inherit (x) c d; }-      ---      -- The previous expression is equivalent to:-      ---      -- > { a = a; c = x.c; d = x.d; }-  | Expr'Dot Dot-      -- ^ A /dot/ expression (named after the @.@ character it contains)-      -- looks up the value in a dict.-      ---      -- The examples in this section all reduce to "Z".-      ---      -- > { a = "Z"; }.a-      ---      -- > let x = { a = "Z"; }; in x.a-      ---      -- > { x = { a = "Z"; }; }.x.a-      ---      -- The right-hand side of a dot may be a quoted string (in the-      -- traditional @"@...@"@ style, not the indented-string @''@ style):-      ---      -- > { a = "Z"; }."a"-      ---      -- The right-hand side of a dot may even be an arbitrary expression,-      -- using the @${@ ... @}@ form:-      ---      -- > { a = "Z"; }.${ let b = "a"; in b }-  | Expr'Lambda Lambda-      -- ^ A /lambda/ expression @x: y@ where @x@ is the parameter.-      ---      -- This is a function that turns a name into a greeting:-      ---      -- > name: "Hello, ${name}!"-      ---      -- The function parameter can also be a /dict pattern/, which looks like-      -- this:-      ---      -- > { a, b, c ? "another" }: "Hello, ${a}, ${b}, and ${c}!"-      ---      -- That function accepts a dict and looks up the keys @a@, @b@, and @c@-      -- from it, applying the default value @"another"@ to @c@ if it is not-      -- present in the dict. Dict patterns therefore give us something that-      -- resembles functions with named parameters and default arguments.-      ---      -- By default, a lambda defined with a dict pattern fails to evaluate if-      -- the dict argument contains keys that are not listed in the pattern.-      -- To prevent it from failing, you can end the pattern with @...@:-      ---      -- > ({ a, ... }: x) { a = "1"; b = "2"; }-      ---      -- Every function has a single parameter. If you need multiple-      -- parameters, you have to curry:-      ---      -- > a: b: [ a b ]-  | Expr'Apply Apply-      -- ^ Function /application/:-      ---      -- > f x-      ---      -- If a function has multiple (curried) parameters, you can chain them-      -- together like so:-      ---      -- > f x y z-  | Expr'Let Let-      -- ^ A /let/-/in/ expression:-      ---      -- > let-      -- >   greet = x: "Hello, ${x}!";-      -- >   name = "Chris";-      -- > in-      -- >   greet name-      ---      -- /Let/ bindings, like dict bindings, may also use the @inherit@ keyword.-      ---      -- > let-      -- >   d = { greet = x: "Hello, ${x}!"; name = "Chris"; }-      -- >   inherit (d) greet name;-      -- > in-      -- >   greet name-      ---      -- The previous example also demonstrates how the bindings in a /let/-      -- expression may refer to each other (much like a dict with the @rec@-      -- keyword). As with dicts, the order of the bindings does not matter.-  | Expr'With With-      -- ^ A /with/ expression is similar to a /let/-/in/ expression, but the-      -- bindings come from a dict.-      ---      -- > with {-      -- >   greet = x: "Hello, ${x}!";-      -- >   name = "Chris";-      -- > };-      -- >   greet name--{- | A fixed string value. We use the description "static" to mean the string-may not contain antiquotation, in contrast with 'Str'Dynamic' which can. -}-type Str'Static = Text--{- | A quoted string expression, which may be a simple string like @"hello"@ or-a more complex string containing antiquotation like @"Hello, my name is-${name}!"@. See 'Expr'Str'.--We use the description "dynamic" to mean the string may contain antiquotation,-in contrast with 'Str'Static' which cannot. -}-newtype Str'Dynamic = Str'Dynamic { strDynamic'toSeq :: Seq Str'1 }-  deriving (Monoid, Semigroup)--strDynamic'toList :: Str'Dynamic -> [Str'1]-strDynamic'toList =-  Seq.toList . strDynamic'toSeq--strDynamic'fromList :: [Str'1] -> Str'Dynamic-strDynamic'fromList =-  Str'Dynamic . Seq.fromList--strDynamic'singleton :: Str'1 -> Str'Dynamic-strDynamic'singleton =-  Str'Dynamic . Seq.singleton--str'dynamicToStatic :: Str'Dynamic -> Maybe Str'Static-str'dynamicToStatic = strDynamic'toList >>> \case-  [Str'1'Literal x] -> Just x-  _                 -> Nothing--str'staticToDynamic :: Str'Static -> Str'Dynamic-str'staticToDynamic =-  strDynamic'singleton . Str'1'Literal--str'unquotedToDynamic :: Str'Unquoted -> Str'Dynamic-str'unquotedToDynamic =-  str'staticToDynamic . str'unquotedToStatic---- | One part of a 'Str'Dynamic'.-data Str'1-  = Str'1'Literal Str'Static-  | Str'1'Antiquote Expression---- | A function expression. See 'Expr'Lambda'.-data Lambda =-  Lambda-    { lambda'head :: Param-        -- ^ Declaration of the function's parameter-    , lambda'body :: Expression-        -- ^ Body of the function; what it evaluates to-    }---- | A function application expression. See 'Expr'Apply'.-data Apply =-  Apply-    { apply'func :: Expression-        -- ^ The function being called-    , apply'arg :: Expression-        -- ^ The argument to the function-    }--{- | A parameter to a 'Lambda'. All functions have a single parameter, but it's-more complicated than that because it may also include dict destructuring. -}-data Param-  = Param'Name Str'Unquoted-      -- ^ A simple single-parameter function-  | Param'DictPattern DictPattern-      -- ^ Dict destructuring, which gives you something resembling multiple-      -- named parameters with default values-  | Param'Both Str'Unquoted DictPattern-      -- ^ Both a param name /and/ a dict pattern, separated by the @\@@-      -- keyword---- | A type of function parameter ('Param') that does dict destructuring.-data DictPattern =-  DictPattern-    { dictPattern'items :: Seq DictPattern'1-        -- ^ The list of keys to pull out of the dict, along with any default-        -- value each may have-    , dictPattern'ellipsis :: Bool-        -- ^ Whether to allow additional keys beyond what is listed in the-        -- items, corresponding to the @...@ keyword-    }---- | One item within a 'DictPattern'.-data DictPattern'1 =-  DictPattern'1-    { dictPattern'1'name :: Str'Unquoted-        -- ^ The name of the key to pull out of the dict-    , dictPattern'1'default :: Maybe Expression-        -- ^ The default value to be used if the key is not present in the dict-    }--{- | A list literal expression, starting with @[@ and ending with @]@.-See 'Expr'List'. -}-newtype List = List (Seq Expression)-  deriving (Monoid, Semigroup)--{- | A dict literal expression, starting with @{@ or @rec {@ and ending with-@}@. See 'Expr'Dict'. -}-data Dict =-  Dict-    { dict'rec :: Bool-        -- ^ Whether the dict is recursive (denoted by the @rec@ keyword)-    , dict'bindings :: Seq DictBinding-        -- ^ The bindings (everything between @{@ and @}@)-    }---- | A binding of the form @x = y;@ within a 'DictLiteral' or 'LetExpr'.-data DictBinding-  = DictBinding'Eq Expression Expression-  | DictBinding'Inherit Inherit--{- | An expression of the form @person.name@ that looks up a key from a dict.-See 'Expr'Dot'. -}-data Dot =-  Dot-    { dot'dict :: Expression-    , dot'key  :: Expression-    }---- | A @let@-@in@ expression. See 'Expr'Let'.-data Let =-  Let-    { let'bindings :: Seq LetBinding-        -- ^ The bindings (everything between the @let@ and @in@ keywords)-    , let'value :: Expression-        -- ^ The value (everything after the @in@ keyword)-    }--{- | A semicolon-terminated binding within the binding list of a 'Let'-expression. -}-data LetBinding-  = LetBinding'Eq Str'Static Expression-      -- ^ A binding with an equals sign, of the form @x = y;@-  | LetBinding'Inherit Inherit-      -- ^ A binding using the @inherit@ keyword, of the form @inherit a b;@-      -- or @inherit (x) a b;@---- | A @with@ expression. See 'Expr'With'.-data With =-  With-    { with'context :: Expression-    , with'value :: Expression-    }--data Inherit =-  Inherit-    { inherit'source :: Maybe Expression-    , inherit'names :: Seq Str'Static-    }--expression'applyArgs-  :: Expression   -- ^ Function-  -> [Expression] -- ^ Args-  -> Expression   -- ^ Function application-expression'applyArgs =-  foldl (\acc b -> Expr'Apply (Apply acc b))--expression'applyDots-  :: Expression   -- ^ Dict-  -> [Expression] -- ^ Lookups-  -> Expression   -- ^ Dot expression-expression'applyDots =-  foldl (\acc b -> Expr'Dot (Dot acc b))-------------------------------------------------------------------------------------  Show-----------------------------------------------------------------------------------{- | This instance is designed for doctests and REPL experimentation. The-format is designed to strike a balance in verbosity between the derived 'Show'-implementations (which are unwieldily long) and the Bricks language itself-(which is quite terse but unsuitable for demonstrating the parser, as-outputting a Bricks rendering of parse result wouldn't illumunate anyone's-understanding of the AST that the 'Show' instances are here to depict). -}-instance Show Expression        where showsPrec = showsPrec'--instance Show Str'Dynamic       where showsPrec = showsPrec'-instance Show Str'1             where showsPrec = showsPrec'-instance Show List              where showsPrec = showsPrec'-instance Show Dict              where showsPrec = showsPrec'-instance Show DictBinding       where showsPrec = showsPrec'-instance Show Dot               where showsPrec = showsPrec'-instance Show Lambda            where showsPrec = showsPrec'-instance Show Param             where showsPrec = showsPrec'-instance Show DictPattern       where showsPrec = showsPrec'-instance Show DictPattern'1     where showsPrec = showsPrec'-instance Show Apply             where showsPrec = showsPrec'-instance Show Let               where showsPrec = showsPrec'-instance Show LetBinding        where showsPrec = showsPrec'-instance Show With              where showsPrec = showsPrec'-instance Show Inherit           where showsPrec = showsPrec'--showsPrec' :: Show' a => Int -> a -> String -> String-showsPrec' _ x = (Text.unpack (show' x) <>)--class Show' a-  where-    show' :: a -> Text--instance Show' Expression-  where-    show' = \case-      Expr'Var x    -> show'var x-      Expr'Str x    -> show' x-      Expr'List x   -> show' x-      Expr'Dict x   -> show' x-      Expr'Dot x    -> show' x-      Expr'Lambda x -> show' x-      Expr'Apply x  -> show' x-      Expr'Let x    -> show' x-      Expr'With x   -> show' x--instance Show' Str'Dynamic-  where-    show' x =-      Text.unwords ["str", show'list (strDynamic'toList x)]--instance Show' Str'1-  where-    show' = \case-      Str'1'Literal x -> show'quoted' x-      Str'1'Antiquote x -> Text.unwords ["antiquote", show'paren x]--instance Show' List-  where-    show' (List xs) = Text.unwords ["list", show'list xs]--instance Show' Dict-  where-    show' (Dict r bs) =-      Text.unwords-        [if r then "rec'dict" else "dict", show'list bs]--instance Show' DictBinding-  where-    show' = \case-      DictBinding'Eq a b -> Text.unwords ["binding", show'paren a, show'paren b]-      DictBinding'Inherit x -> show' x--instance Show' Dot-  where-    show' (Dot a b) = Text.unwords ["dot", show'paren a, show'paren b]--instance Show' Lambda-  where-    show' (Lambda a b) = Text.unwords ["lambda", show'paren a, show'paren b]--instance Show' Param-  where-    show' = \case-      Param'Name a -> show'param a-      Param'DictPattern b -> show' b-      Param'Both a b -> Text.intercalate " <> " [ show'param a, show' b ]--instance Show' DictPattern-  where-    show' = \case-      DictPattern xs e ->-        Text.intercalate " <> " $-        [Text.unwords ["pattern", show'list xs]] <>-        (if e then ["ellipsis"] else [])--instance Show' DictPattern'1-  where-    show' (DictPattern'1 a mb) =-      Text.unwords $-        show'param a :-        maybe [] (\b -> [Text.unwords ["& def", show'paren b]]) mb--instance Show' Apply-  where-    show' (Apply a b) = Text.unwords ["apply", show'paren a, show'paren b]--instance Show' Let-  where-    show' (Let xs y) = Text.unwords ["let'in", show'list xs, show'paren y]--instance Show' LetBinding-  where-    show' = \case-      LetBinding'Eq a b -> Text.unwords ["binding", show'static a, show'paren b]-      LetBinding'Inherit x -> show' x--instance Show' With-  where-    show' = \case-      With a b -> Text.unwords ["with", show'paren a, show'paren b]--instance Show' Inherit-  where-    show' (Inherit mf xs) =-      Text.unwords $-        (maybe ("inherit":) (\a -> ("inherit'from" :) . (show'paren a :)) mf) $-        [show'list' $ fmap show'quoted' xs]--show'list :: (Foldable f, Show' a) => f a -> Text-show'list =-  show'list' . fmap show' . Foldable.toList--show'list' :: Foldable f => f Text -> Text-show'list' x =-  "[" <> Text.intercalate ", " x <> "]"--show'quoted' :: Text -> Text-show'quoted' =-  Text.pack . show @Text--show'paren :: Show' a => a -> Text-show'paren x =-  "(" <> show' x <> ")"--show'static :: Str'Static -> Text-show'static x =-  Text.unwords ["str", show'quoted' x]--show'param :: Str'Unquoted -> Text-show'param x =-  Text.unwords ["param", show'quoted' (str'unquotedToStatic x)]--show'var :: Str'Unquoted -> Text-show'var x =-  Text.unwords ["var", show'quoted' (str'unquotedToStatic x)]

@@ -1,233 +0,0 @@-{-# LANGUAGE FunctionalDependencies     #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NoImplicitPrelude          #-}--{- | Functions for constructing 'Expression's that match the 'Show'-implementations.--This module is only designed for testing and REPL use. It isn't re-exported-into the main Bricks API because it's a bit messy:--- It introduces some superfluous typeclasses for the sake of brevity.-- There are a lot of terse function names here that would clash with other-  things easily.-- Some functions are partial, such as those that require strings that can be-  rendered unquoted.-- It uses string overloading in a way that the regular API probably shouldn't.-- The functions are oriented toward constructing 'Expression's, skipping over-  the intermediary types they're composed of, which is convenient but may make-  them insufficient for some use cases.---}-module Bricks.Expression.Construction where---- Bricks-import Bricks.Expression-import Bricks.UnquotedString---- Bricks internal-import           Bricks.Internal.Prelude-import qualified Bricks.Internal.Seq     as Seq-import           Bricks.Internal.Text    (Text)-import qualified Bricks.Internal.Text    as Text---- Base-import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.String        (IsString (fromString))--------------------------------------------------------------------------------------  Lambdas-----------------------------------------------------------------------------------lambda :: Param'Builder -> Expression -> Expression-lambda a b =-  Expr'Lambda $ Lambda (buildParam a) b--------------------------------------------------------------------------------------  Function application-----------------------------------------------------------------------------------apply :: Expression -> Expression -> Expression-apply a b =-  Expr'Apply $ Apply a b--------------------------------------------------------------------------------------  Variables-----------------------------------------------------------------------------------var :: Text -> Expression-var =-  Expr'Var . str'unquoted'orThrow--------------------------------------------------------------------------------------  Dots-----------------------------------------------------------------------------------dot :: Expression -> Expression -> Expression-dot a b =-  Expr'Dot $ Dot a b--------------------------------------------------------------------------------------  Let-----------------------------------------------------------------------------------let'in :: [LetBinding] -> Expression -> Expression-let'in a b =-  Expr'Let $ Let (Seq.fromList a) b--------------------------------------------------------------------------------------  Dicts-----------------------------------------------------------------------------------dict :: [DictBinding] -> Expression-dict =-  Expr'Dict . Dict False . Seq.fromList--rec'dict :: [DictBinding] -> Expression-rec'dict =-  Expr'Dict . Dict False . Seq.fromList--------------------------------------------------------------------------------------  Overloaded 'binding' function-----------------------------------------------------------------------------------class Binding a b | b -> a-  where-    binding :: a -> Expression -> b--instance Binding Expression DictBinding-  where-    binding = DictBinding'Eq--instance Binding Text LetBinding-  where-    binding = LetBinding'Eq--------------------------------------------------------------------------------------  Overloaded 'inherit' functions-----------------------------------------------------------------------------------class IsInherit a-  where-    fromInherit :: Inherit -> a--instance IsInherit DictBinding-  where-    fromInherit = DictBinding'Inherit--instance IsInherit LetBinding-  where-    fromInherit = LetBinding'Inherit--inherit :: IsInherit a => [Text] -> a-inherit =-  fromInherit . Inherit Nothing . Seq.fromList--inherit'from :: IsInherit a => Expression -> [Text] -> a-inherit'from x y =-  fromInherit $ Inherit (Just x) (Seq.fromList y)--------------------------------------------------------------------------------------  Dynamic strings-----------------------------------------------------------------------------------str :: [Str'1'] -> Expression-str =-  Expr'Str . Str'Dynamic . Seq.fromList . fmap unStr'1'--antiquote :: Expression -> Str'1'-antiquote =-  Str'1' . Str'1'Antiquote---- | A newtype for 'Str'1' just so we can give it the 'IsString' instance--- which would be dubiously appropriate for the actual 'Str'1' type.-newtype Str'1' = Str'1' { unStr'1' :: Str'1 }--instance IsString Str'1'-  where-    fromString = Str'1' . Str'1'Literal . Text.pack--------------------------------------------------------------------------------------  Overloaded 'param' function-----------------------------------------------------------------------------------class IsParam a-  where-    param :: Text -> a--instance IsParam Param'Builder-  where-    param x = paramBuilder $ Param'Name $ str'unquoted'orThrow x--instance IsParam DictPattern'1-  where-    param x = DictPattern'1 (str'unquoted'orThrow x) Nothing--------------------------------------------------------------------------------------  Param builder-----------------------------------------------------------------------------------newtype Param'Builder = Param'Builder (NonEmpty Param)-  deriving Semigroup--buildParam :: Param'Builder -> Param-buildParam (Param'Builder xs) =-  foldr1 mergeParams xs--paramBuilder :: Param -> Param'Builder-paramBuilder x =-  Param'Builder (x :| [])--pattern :: [DictPattern'1] -> Param'Builder-pattern xs =-  paramBuilder $ Param'DictPattern $ DictPattern (Seq.fromList xs) False--def :: Expression -> DictPattern'1 -> DictPattern'1-def b (DictPattern'1 a _) =-  DictPattern'1 a (Just b)--ellipsis :: Param'Builder-ellipsis =-  paramBuilder $ Param'DictPattern $ DictPattern Seq.empty True--{- | Combine two params, merging dict patterns with 'mergeDictPatterns' and-preferring the right-hand-side when names conflict. -}-mergeParams :: Param -> Param -> Param-mergeParams = (+)-  where-    (+) :: Param -> Param -> Param-    -- A name on the right overrides a name on the left-    Param'Both _n1 p1 + Param'Name n2 = Param'Both n2 p1-    -- The simplest combinations: turning one or the other into both-    Param'Name n + Param'DictPattern p = Param'Both n p-    Param'DictPattern p + Param'Name n = Param'Both n p-    -- Otherwise a name on the left gets overridden by anything on the right-    Param'Name _n + x = x-    -- Combinations that require merging the dict patterns-    Param'DictPattern p1 + Param'DictPattern p2 =-      Param'DictPattern (mergeDictPatterns p1 p2)-    Param'DictPattern p1 + Param'Both n p2 =-      Param'Both n (mergeDictPatterns p1 p2)-    Param'Both _n1 p1 + Param'Both n2 p2 =-      Param'Both n2 (mergeDictPatterns p1 p2)-    Param'Both n p1 + Param'DictPattern p2 =-      Param'Both n (mergeDictPatterns p1 p2)--{- | Combine two dict patterns, taking the concatenation of the item list, and-the Boolean /or/ of the ellipsis flag. -}-mergeDictPatterns :: DictPattern -> DictPattern -> DictPattern-mergeDictPatterns = (+)-  where-    DictPattern xs1 e1 + DictPattern xs2 e2 =-      DictPattern (xs1 <> xs2) (e1 || e2)

@@ -0,0 +1,181 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++{- |++Conversion from 'Expression' (the AST produced by the parser) to 'Term'+(an augmented form of the lambda calculus used for evaluation).++-}+module Bricks.ExpressionToTerm where++-- Bricks+import Bricks.BuiltinFunctions+import Bricks.Expression+import Bricks.Term+import Bricks.Type++-- Bricks internal+import qualified Bricks.Internal.List    as List+import           Bricks.Internal.Prelude+import qualified Bricks.Internal.Seq     as Seq+import           Bricks.Internal.Text    (Text)++-- Containers+import           Data.Map (Map)+import qualified Data.Map as Map+import           Data.Set (Set)+import qualified Data.Set as Set++-- Base+import Control.Applicative (liftA2)+import System.IO           (IO)++expression'to'term :: Expression -> IO Term+expression'to'term =+  \case+    Expr'Var x -> var'to'term x+    Expr'Str x -> str'to'term x+    Expr'Str'Indented x -> str'to'term (inStr'to'strDynamic x)+    Expr'List x -> list'to'term x+    Expr'Dict x -> dict'to'term x+    Expr'Dot x -> dot'to'term x+    Expr'Lambda x -> lambda'to'term x+    Expr'Apply x -> apply'to'term x+    Expr'Let x -> let'to'term x++var'to'term :: Var -> IO Term+var'to'term = pure . Term'Var . var'text++apply'to'term :: Apply -> IO Term+apply'to'term x =+  do+    a <- expression'to'term (apply'func x)+    b <- expression'to'term (apply'arg x)+    pure $ a /@\ b++str'to'term :: Str'Dynamic -> IO Term+str'to'term x =+  case Seq.toList (strDynamic'toSeq x) of+    [] -> pure $ term'data type'string ""+    ys -> foldr1 (liftA2 f) $ fmap str'1'to'term ys+  where+    f a b = fn'string'append /@@\ (a, b)++str'1'to'term :: Str'1 -> IO Term+str'1'to'term = \case+  Str'1'Literal x -> pure $ term'data type'string (str'static'text x)+  Str'1'Antiquote x -> expression'to'term x++list'to'term :: List -> IO Term+list'to'term x =+  Term'List <$> traverse expression'to'term (list'expressions x)++dict'to'term :: Dict -> IO Term+dict'to'term = undefined++dot'to'term :: Dot -> IO Term+dot'to'term x =+  do+    a <- expression'to'term (dot'dict x)+    b <- expression'to'term (dot'key x)+    pure $ fn'dict'lookup /@@\ (a, b)++let'to'term :: Let -> IO Term+let'to'term x =+  Term'LetRec <$> bindings <*> body++  where+    bindings :: IO (Map Text Term)+    bindings =+      Map.fromList . List.concat <$>+      traverse letBinding'to'term (let'bindings x)++    body :: IO Term+    body =+      expression'to'term $ let'value x++letBinding'to'term :: LetBinding -> IO [(Text, Term)]+letBinding'to'term =+  \case+    LetBinding'Eq a b ->+      do+        b' <- expression'to'term b+        pure [(var'text a, b')]+    LetBinding'Inherit d xs ->+      do+        -- Use a pointer for the dict we're inheriting from, to avoid+        -- having to reduce it more than once.+        p <- newTermPtr =<< expression'to'term d++        pure+          $ fmap (\x ->+            ( var'text x+            , fn'dict'lookup /@@\ (p, term'data type'string (var'text x))+            ))+          $ Seq.toList xs+++--------------------------------------------------------------------------------+--  Converting a lambda expression to a lambda term+--------------------------------------------------------------------------------++lambda'to'term :: Lambda -> IO Term+lambda'to'term x =+  do+    body <- expression'to'term (lambda'body x)+    case lambda'head x of+      Param'Name var       -> lambda'to'term'simple var body+      Param'DictPattern dp -> lambda'to'term'dictPattern dp body+      Param'Both var dp    -> lambda'to'term'both var dp body++lambda'to'term'simple :: Var -> Term -> IO Term+lambda'to'term'simple var body =+  -- For a simple named parameter, the AST translates directly into the+  -- lambda calculus.+  pure $ TermPattern'Simple (var'text var) |-> body++lambda'to'term'dictPattern :: DictPattern -> Term -> IO Term+lambda'to'term'dictPattern dp body = do+  -- For dict patterns, we have to do a few more things:+  let names = dictPattern'names dp++    -- 1. If there is no ellipsis, add a check to fail if there are+    --    extra keys in the argument.+  let h = if dictPattern'ellipsis dp then fn'id+          else fn'dict'disallowExtraKeys names++  defs <- dictPattern'defaults dp++    -- 2. Insert a dict-merging function to apply default arguments.+  let g = fn'dict'merge'preferLeft /@\ Term'Dict'ReducedKeys defs++  let f = TermPattern'Dict names |-> body++  pure $ fn'comp /@@\ (fn'comp /@@\ (f, g), h)++lambda'to'term'both :: Var -> DictPattern -> Term -> IO Term+lambda'to'term'both var dp body =+  -- For a named parameter /and/ a dict pattern, we nest the dict pattern+  -- lambda inside a regular lambda.+  lambda'to'term'simple var =<< lambda'to'term'dictPattern dp body++dictPattern'names :: DictPattern -> Set Text+dictPattern'names (DictPattern xs _) =+  Set.fromList . fmap f . Seq.toList $ xs+  where+    f = var'text . dictPattern'1'name++dictPattern'defaults :: DictPattern -> IO (Map Text Term)+dictPattern'defaults (DictPattern xs _) =+  Map.fromList . catMaybes <$> traverse f (Seq.toList xs)+  where+    f :: DictPattern'1 -> IO (Maybe (Text, Term))+    f x =+      case dictPattern'1'default x of+        Nothing -> pure Nothing+        Just d ->+          do+            a <- expression'to'term d+            pure $ Just (var'text (dictPattern'1'name x), a)

@@ -1,120 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE OverloadedStrings          #-}--module Bricks.IndentedString-  (-  -- * Indented string-    InStr (..)-  , inStr'join-  , inStr'level-  , inStr'dedent-  , inStr'trim-  , inStr'toList--  -- * Single line of an indented string-  , InStr'1 (..)-  , inStr'1'nonEmpty-  , inStr'1'empty-  , inStr'1'modifyLevel--  ) where---- Bricks-import Bricks.Expression---- Bricks internal-import           Bricks.Internal.Prelude-import           Bricks.Internal.Seq     (Seq, (<|))-import qualified Bricks.Internal.Seq     as Seq-import qualified Bricks.Internal.Text    as Text--{- | An "indented string literal," delimited by two single-quotes @''@.--This type of literal is called "indented" because the parser automatically-removes leading whitespace from the string ('inStr'dedent'), which makes it-convenient to use these literals for multi-line strings within an indented-expression without the whitespace from indentation ending up as part of the-string. -}-newtype InStr = InStr { inStr'toSeq :: Seq InStr'1 }-  deriving (Monoid, Semigroup)--instance Show InStr-  where-    show = show . inStr'toList--inStr'toList :: InStr -> [InStr'1]-inStr'toList =-  Seq.toList . inStr'toSeq---- | One line of an 'InStr'.-data InStr'1 =-  InStr'1-    { inStr'1'level :: Natural-        -- ^ The number of leading space characters. We store this separately-        -- for easier implementation of 'inStr'dedent'.-    , inStr'1'str :: Str'Dynamic-        -- ^ The rest of the line after any leading spaces.-    }--instance Show InStr'1-  where-    show (InStr'1 n s) = "indent-" <> show n <> " " <> show s--{- | Join 'InStr's with newlines interspersed. -}-inStr'join :: InStr -> Str'Dynamic-inStr'join xs =-  Str'Dynamic . Seq.concat $-    Seq.intersperse-      (Seq.singleton (Str'1'Literal "\n"))-      (f <$> inStr'toSeq xs)-  where-    f :: InStr'1 -> Seq Str'1-    f (InStr'1 n parts) = Str'1'Literal (Text.replicate (fromIntegral n) " ")-                          <| strDynamic'toSeq parts--{- | Determines whether an 'InStr'1' contains any non-space-characters. The opposite of 'inStr'1'nonEmpty'.--This is used to determine whether this line should be considered when-calculating the number of space characters to strip in 'inStr'dedent'. -}-inStr'1'nonEmpty :: InStr'1 -> Bool-inStr'1'nonEmpty =-  not . inStr'1'empty---- | The opposite of 'inStr'1'nonEmpty'.-inStr'1'empty :: InStr'1 -> Bool-inStr'1'empty (InStr'1{ inStr'1'str = Str'Dynamic x }) =-  Seq.null x--{- | Determine how many characters of whitespace to strip from an indented-string. -}-inStr'level :: InStr -> Natural-inStr'level =-  maybe 0 id-  . Seq.minimum-  . Seq.map inStr'1'level-  . Seq.filter inStr'1'nonEmpty-  . inStr'toSeq---- | Modify an 'InStr' by applying a function to its number of leading spaces.-inStr'1'modifyLevel :: (Natural -> Natural) -> (InStr'1 -> InStr'1)-inStr'1'modifyLevel f x@InStr'1{inStr'1'level = a} =-  x{ inStr'1'level = f a }--{- | Determine the minimum indentation of any nonempty line, and remove that-many space characters from the front of every line. -}-inStr'dedent :: InStr -> InStr-inStr'dedent xs =-  let-    b = inStr'level xs-    f a = if a >= b then a - b else 0-  in-    InStr $ inStr'1'modifyLevel f <$> inStr'toSeq xs---- | Remove any empty lines from the beginning or end of an indented string.-inStr'trim :: InStr -> InStr-inStr'trim =-  InStr . trimWhile inStr'1'empty . inStr'toSeq-  where-    trimWhile f = Seq.dropWhileL f . Seq.dropWhileR f

@@ -0,0 +1,16 @@+module Bricks.Internal.Monad+  (+  -- * IO+    MonadIO (..)++  -- * Error+  , MonadError (..), ExceptT (..), runExceptT++  -- * Reader+  , ReaderT (..)++  ) where++-- mtl+import Control.Monad.Except+import Control.Monad.Reader

@@ -1,43 +0,0 @@-module Bricks.Internal.Prelude--  ( (<&>)--  , module Control.Applicative-  , module Control.Arrow-  , module Control.Monad-  , module Data.Bool-  , module Data.Char-  , module Data.Either-  , module Data.Eq-  , module Data.Foldable-  , module Data.Function-  , module Data.Functor-  , module Data.Maybe-  , module Data.Monoid-  , module Data.Semigroup-  , module Data.String-  , module Numeric.Natural-  , module Text.Show--  ) where--import Control.Applicative (pure, (*>), (<*), (<*>), (<|>))-import Control.Arrow       ((>>>))-import Control.Monad       ((>>=))-import Data.Bool           (Bool (False, True), not, (&&), (||))-import Data.Char           (Char)-import Data.Either         (Either (..))-import Data.Eq             (Eq ((/=), (==)))-import Data.Foldable       (asum, fold, foldMap, foldl, foldl1, foldr, foldr1)-import Data.Function       (id, ($), (&), (.))-import Data.Functor        (Functor, fmap, void, ($>), (<$), (<$>))-import Data.Maybe          (Maybe (Just, Nothing), catMaybes, maybe)-import Data.Monoid         (Monoid (mappend, mempty))-import Data.Semigroup      (Semigroup ((<>)))-import Data.String         (String)-import Numeric.Natural     (Natural)-import Text.Show           (Show (show, showList, showsPrec), shows)--(<&>) :: Functor f => f a -> (a -> b) -> f b-(<&>) = flip fmap-infixl 1 <&>

@@ -1,47 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Bricks.Internal.Seq--  ( Seq--  , (<|), (|>)--  , concat-  , dropWhileL-  , dropWhileR-  , empty-  , filter-  , fromList-  , intersperse-  , map-  , minimum-  , null-  , toList-  , singleton--  ) where---- Containers-import Data.Sequence (Seq, dropWhileL, dropWhileR, empty, filter, fromList,-                      null, singleton, (<|), (|>))---- Base-import           Data.Foldable (Foldable, fold, toList)-import           Data.Functor  (fmap)-import qualified Data.List     as List-import           Data.Maybe    (Maybe (..))-import           Data.Ord      (Ord)--intersperse :: a -> Seq a -> Seq a-intersperse x xs =-  fromList (List.intersperse x (toList xs))--concat :: Foldable f => f (Seq a) -> Seq a-concat = fold--minimum :: Ord a => Seq a -> Maybe a-minimum xs =-  if null xs then Nothing else Just (List.minimum (toList xs))--map :: (a -> b) -> Seq a -> Seq b-map = fmap

@@ -1,35 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Bricks.Internal.Text--  ( Text--  , all-  , concat-  , intercalate-  , null-  , pack-  , replace-  , replicate-  , singleton-  , unpack-  , unwords--  ) where---- Text-import           Data.Text (Text, all, null, pack, replace, replicate,-                            singleton, unpack, unwords)-import qualified Data.Text as Text---- Base-import Data.Foldable (Foldable, toList)-import Data.Function ((.))--concat :: Foldable f => f Text -> Text-concat =-  Text.concat . toList--intercalate :: Foldable f => Text -> f Text -> Text-intercalate x =-  Text.intercalate x . toList

@@ -1,67 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Bricks.Keyword-  (-  -- * Type-    Keyword--  -- * List of keywords-  , keywords--  -- * The keywords-  , keyword'rec-  , keyword'let-  , keyword'in-  , keyword'with-  , keyword'inherit-  , keyword'inlineComment--  -- * Type conversion-  , keywordString-  , keywordText--  ) where---- Bricks internal-import           Bricks.Internal.Prelude-import           Bricks.Internal.Text    (Text)-import qualified Bricks.Internal.Text    as Text--newtype Keyword =-  Keyword-    { keywordText :: Text-    }--{- | All of the keywords. This list is used when parsing and rendering because-an unquoted string cannot have a name that is exactly the same as a keyword. -}-keywords :: [Keyword]-keywords =-  [ keyword'rec-  , keyword'let-  , keyword'in-  , keyword'with-  , keyword'inherit-  , keyword'inlineComment-  ]--keywordString :: Keyword -> String-keywordString = Text.unpack . keywordText--keyword'rec :: Keyword-keyword'rec = Keyword "rec"--keyword'let :: Keyword-keyword'let = Keyword "let"--keyword'in :: Keyword-keyword'in = Keyword "in"--keyword'with :: Keyword-keyword'with = Keyword "with"--keyword'inherit :: Keyword-keyword'inherit = Keyword "inherit"--keyword'inlineComment :: Keyword-keyword'inlineComment = Keyword "--"

@@ -1,679 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--{- | Parsec 'Parser's for the Bricks language.--Most parsers consume trailing whitespace, except ones that operate within-quoted string environments where whitespace is significant.---}-module Bricks.Parsing-  (-  -- * Expressions-    parse'expression-  , parse'expression'paren-  , parse'expression'dictKey--  -- * Expression lists-  , parse'expressionList-  , parse'expressionList'1-  , parse'expressionList'1'noDot--  -- * Strings-  , parse'strUnquoted-  , parse'strStatic-  , parse'strStatic'quoted-  , parse'strStatic'unquoted-  , parse'strDynamic'quoted-  , parse'strDynamic'normalQ-  , parse'strDynamic'indentedQ-  , parse'str'within'normalQ-  , parse'str'escape'normalQ-  , parse'inStr-  , parse'inStr'1--  -- * Lists-  , parse'list--  -- * Dicts-  , parse'dict-  , parse'dict'rec-  , parse'dict'noRec-  , parse'dictBinding-  , parse'dictBinding'inherit-  , parse'dictBinding'eq--  -- * Dict lookup-  , parse'dot'rhs'chain--  -- * Lambdas-  , parse'lambda--  -- * Function parameters-  , parse'param-  , parse'param'var-  , parse'param'noVar-  , parse'dictPattern-  , parse'dictPattern'start--  -- * @let@-  , parse'let-  , parse'letBinding-  , parse'letBinding'eq-  , parse'letBinding'inherit--  -- * @with@-  , parse'with--  -- * @inherit@-  , parse'inherit--  -- * Comments and whitespace-  , parse'spaces-  , parse'comment-  , parse'comment'inline-  , parse'comment'block--  -- * Keywords-  , parse'keyword--  -- * Antiquotation-  , parse'antiquote--  ) where---- Bricks-import Bricks.Expression-import Bricks.IndentedString-import Bricks.Keyword-import Bricks.UnquotedString---- Bricks internal-import           Bricks.Internal.Prelude-import           Bricks.Internal.Seq     (Seq, (|>))-import qualified Bricks.Internal.Seq     as Seq-import           Bricks.Internal.Text    (Text)-import qualified Bricks.Internal.Text    as Text---- Parsec-import           Text.Parsec      ((<?>))-import qualified Text.Parsec      as P-import           Text.Parsec.Text (Parser)---- Base-import Control.Monad (fail)-import Prelude       (succ)--{- $setup-->>> import Data.Foldable (length)->>> import Text.Parsec (parseTest)---}--parse'spaces :: Parser ()-parse'spaces =-  (void $ P.many (void (P.space <?> "") <|> parse'comment))--parse'comment :: Parser ()-parse'comment =-  parse'comment'inline <|> parse'comment'block--parse'comment'inline :: Parser ()-parse'comment'inline =-  void $ P.try (P.string "--" <?> "") *> P.manyTill P.anyChar (P.char '\n')--parse'comment'block :: Parser ()-parse'comment'block =-  start <* P.manyTill middle end-  where-    start  = void $ P.try (P.string "{-" <?> "")-    middle = parse'comment'block <|> void P.anyChar-    end    = P.try (P.string "-}")---- | Backtracking parser for a particular keyword.-parse'keyword :: Keyword -> Parser ()-parse'keyword k =-  P.try $ do-    -- Consume the keyword-    _ <- P.string (keywordString k)--    -- Do /not/ consume any subsequent character that are allowed to be part-    -- of a valid identifier. For example, this prevents this parser from-    -- interpreting the beginning of an identifier named "letter" as the-    -- keyword "let".-    _ <- P.notFollowedBy (P.satisfy char'canRenderUnquoted)--    -- As usual, consume trailing spaces.-    _ <- parse'spaces--    pure ()--{- | Parser for an unquoted string. Unquoted strings are restricted to a-conservative set of characters, and they may not be any of the keywords.-->>> parseTest parse'strUnquoted "abc"-unquoted "abc"-->>> parseTest parse'strUnquoted "x{y"-unquoted "x"-->>> parseTest parse'strUnquoted "let"-parse error at (line 1, column 4):-unexpected end of input---}-parse'strUnquoted :: Parser Str'Unquoted-parse'strUnquoted =-  do-    -- Consume at least one character-    a <- Text.pack <$> P.many1 (P.satisfy char'canRenderUnquoted)--    -- Fail if what we just parsed isn't a valid unquoted string-    case str'tryUnquoted a of-      Nothing -> P.parserZero-      Just b  -> parse'spaces $> b--{- | Parser for a static string which may be either quoted or unquoted.-->>> parseTest parse'strStatic "\"hello\""-"hello"-->>> parseTest parse'strStatic "hello"-"hello"-->>> parseTest parse'strStatic "\"a b\""-"a b"-->>> parseTest parse'strStatic "a b"-"a"--By "static," we mean that the string may /not/ contain antiquotation.-->>> parseTest parse'strStatic "\"a${x}b\" xyz"-parse error at (line 1, column 5):-antiquotation is not allowed in this context---}-parse'strStatic :: Parser Str'Static-parse'strStatic =-  (parse'strStatic'quoted <|> parse'strStatic'unquoted) <?> "static string"---- | Parser for a static string that is quoted.-parse'strStatic'quoted :: Parser Str'Static-parse'strStatic'quoted =-  P.char '"' *> parse'str'within'normalQ <* asum-    [ P.char '"' *> parse'spaces-    , P.string "${" *> fail "antiquotation is not allowed in this context"-    ]---- | Parser for an unquoted static string.-parse'strStatic'unquoted :: Parser Str'Static-parse'strStatic'unquoted =-  parse'strUnquoted <&> str'unquotedToStatic--{- | Parser for a dynamic string that is quoted. It may be a "normal" quoted-string delimited by one double-quote @"@...@"@ ('parse'strDynamic'normalQ') or-an "indented" string delimited by two single-quotes @''@...@''@-('parse'strDynamic'indentedQ'). -}-parse'strDynamic'quoted :: Parser Str'Dynamic-parse'strDynamic'quoted =-  parse'strDynamic'normalQ <|> parse'strDynamic'indentedQ---- | Parser for a dynamic string enclosed in "normal" quotes (@"@...@"@).-parse'strDynamic'normalQ :: Parser Str'Dynamic-parse'strDynamic'normalQ =-  P.char '"' *> go Seq.empty-  where-    go :: Seq Str'1 -> Parser Str'Dynamic-    go previousParts =-      asum-        [ end $> Str'Dynamic previousParts-        , asum-            [ parse'str'within'normalQ <&> Str'1'Literal-            , anti-            ]-          >>= \x -> go $ previousParts |> x-        ]--    -- Read the closing " character-    end = P.char '"' *> parse'spaces--    -- Read an antiquote-    anti = fmap Str'1'Antiquote $-      P.try (P.string "${") *> parse'spaces *> parse'expression <* P.char '}'--{- | Parser for at least one normal character, within a normally-quoted string-context, up to but not including the end of the string or the start of an-antiquotation. -}-parse'str'within'normalQ :: Parser Text-parse'str'within'normalQ = do-  fmap Text.concat $ P.many1 $ asum-    [ P.satisfy (\c -> c /= '$' && c /= '"' && c /= '\\') <&> Text.singleton-    , P.try $ P.char '$' <* P.notFollowedBy (P.char '{')  <&> Text.singleton-    , parse'str'escape'normalQ-    ]--parse'str'escape'normalQ :: Parser Text-parse'str'escape'normalQ =-  P.char '\\' *> asum-    [ P.char '\\'   $> "\\"-    , P.char '"'    $> "\""-    , P.char 'n'    $> "\n"-    , P.char 'r'    $> "\r"-    , P.char 't'    $> "\t"-    , P.string "${" $> "${"-    ]--{- | Parser for a dynamic string enclosed in "indented string" format,-delimited by two single-quotes @''@...@''@. This form of string does not have-any escape sequences. -}-parse'strDynamic'indentedQ :: Parser Str'Dynamic-parse'strDynamic'indentedQ =-  inStr'join . inStr'dedent . inStr'trim <$> parse'inStr--{- | Parser for an indented string. This parser produces a representation of-the lines from the source as-is, before the whitespace is cleaned up. -}-parse'inStr :: Parser InStr-parse'inStr =-  P.string "''" *> go Seq.empty-  where-    go :: Seq InStr'1 -> Parser InStr-    go previousLines =-      do-        line <- parse'inStr'1-        let newLines = previousLines |> line-        asum-          [ P.string "''" *> parse'spaces $> InStr newLines-          , P.char '\n'   *> go newLines-          ]---- | Parser for a single line of an 'InStr'.-parse'inStr'1 :: Parser InStr'1-parse'inStr'1 =-  do-    a <- parse'count (P.char ' ')-    b <- go Seq.empty-    pure $ InStr'1 a b-  where-    go :: Seq Str'1 -> Parser Str'Dynamic-    go previousParts =-      asum-        [ end              $> Str'Dynamic previousParts-        , chars           >>= \x                -> go (previousParts |> x)-        , parse'antiquote >>= \(Str'Dynamic xs) -> go (previousParts <> xs)-        ]--    end = P.lookAhead $ asum-      [ void $ P.char '\n'-      , void $ P.try (P.string "''")-      ]--    chars = fmap (Str'1'Literal . Text.pack) $ P.many1 $ asum-      [ P.satisfy (\c -> c /= '$' && c /= '\'' && c /= '\n')-      , P.try $ P.char '$'  <* P.notFollowedBy (P.char '{')-      , P.try $ P.char '\'' <* P.notFollowedBy (P.char '\'')-      ]--parse'antiquote :: Parser Str'Dynamic-parse'antiquote =-  (P.try (P.string "${") *> parse'spaces *> parse'expression <* P.char '}')-  <&> \case-    Expr'Str x -> x-    x -> strDynamic'singleton (Str'1'Antiquote x)--{- | Parser for a function parameter (the beginning of a 'Lambda'), including-the colon. This forms part of 'parse'expression', so it backtracks in places-where it has overlap with other types of expressions. -}-parse'param :: Parser Param-parse'param =-  parse'param'var <|> parse'param'noVar--{- | Parser for a parameter that starts with a variable. This could be a simple-param that consists only of /only/ the variable, or the variable may be-followed by a dict pattern. -}-parse'param'var :: Parser Param-parse'param'var = do-  -- This part backtracks because until we get to the : or @, we don't-  -- know whether the variable name we're reading is a lambda parameter-  -- or just the name by itself (and not part of a lambda).-  (a, b) <- P.try $ do-    a <- parse'strUnquoted <* parse'spaces-    b <- ((P.char ':' $> False) <|> (P.char '@' $> True)) <* parse'spaces-    pure (a, b)-  if b-    -- If we read an @, then the next thing is a pattern.-    then parse'dictPattern <* P.char ':' <* parse'spaces <&> Param'Both a-    -- Otherwise it's just the variable and we're done.-    else pure $ Param'Name a--{- | Parser for a param that has no variable, only a a dict pattern. This-parser backtracks because the beginning of a dict pattern looks like the-beginning of a dict expression. -}-parse'param'noVar :: Parser Param-parse'param'noVar = Param'DictPattern <$> do-  -- First we look ahead to determine whether it looks like a lambda.-  _ <- P.try . P.lookAhead $ parse'dictPattern'start--  -- And if so, then we go on and parse the dict pattern with no-  -- further backtracking.-  parse'dictPattern <* P.char ':' <* parse'spaces--{- | Parser for a dict pattern (the type of lambda parameter that does dict-destructuring. This parser does not backtrack. -}-parse'dictPattern :: Parser DictPattern-parse'dictPattern =-  P.char '{' *> parse'spaces *> go Seq.empty-  where-    go :: Seq DictPattern'1 -> Parser DictPattern-    go previousItems =-      asum-        [ end $> DictPattern previousItems False-        , ellipsis $> DictPattern previousItems True-        , do-            newItems <- item <&> \x -> previousItems |> x-            asum-              [ P.char ',' *> parse'spaces *> go newItems-              , end $> DictPattern newItems False-              ]-        ]--    item = DictPattern'1 <$> parse'strUnquoted <*> P.optionMaybe def--    ellipsis = P.string "..." *> parse'spaces *> end--    def = P.char '?' *> parse'spaces *> parse'expression--    end = P.char '}' *> parse'spaces--{- | This is used in a lookahead by 'parse'param' to determine whether we're-about to start parsing a 'DictPattern'. -}-parse'dictPattern'start :: Parser ()-parse'dictPattern'start =-  P.char '{' *> parse'spaces *> asum-    [ void $ P.string "..."-    , void $ P.char '}' *> parse'spaces *> P.char ':'-    , void $ parse'strUnquoted *> (P.char ',' <|> P.char '?' <|> P.char '}')-    ]--{- | Parser for a lambda expression (@x: y@).-->>> parseTest parse'lambda "x: [x x \"a\"]"-lambda (param "x") (list [var "x", var "x", str ["a"]])-->>> parseTest parse'lambda "{a,b}:a"-lambda (pattern [param "a", param "b"]) (var "a")-->>> parseTest parse'lambda "{ ... }: \"x\""-lambda (pattern [] <> ellipsis) (str ["x"])-->>> parseTest parse'lambda "a@{ f, b ? g x, ... }: f b"-lambda (param "a" <> pattern [param "f", param "b" & def (apply (var "g") (var "x"))] <> ellipsis) (apply (var "f") (var "b"))-->>> parseTest parse'lambda "a: b: \"x\""-lambda (param "a") (lambda (param "b") (str ["x"]))---}-parse'lambda :: Parser Lambda-parse'lambda =-  Lambda <$> parse'param <*> parse'expression--{- | Parser for a list expression (@[ ... ]@).-->>> parseTest parse'list "[]"-list []-->>> parseTest parse'list "[x \"one\" (a: b) (c d)]"-list [var "x", str ["one"], lambda (param "a") (var "b"), apply (var "c") (var "d")]---}-parse'list :: Parser List-parse'list =-  (start *> parse'expressionList <* end) <&> List . Seq.fromList-  where-    start = P.char '[' *> parse'spaces-    end   = P.char ']' <* parse'spaces--{- | Parser for a dict expression, either recursive (@rec@ keyword) or not.-->>> parseTest parse'dict "{}"-dict []-->>> parseTest parse'dict "rec {  }"-rec'dict []-->>> parseTest parse'dict "{ a = b; inherit (x) y z \"s t\"; }"-dict [binding (str ["a"]) (var "b"), inherit'from (var "x") ["y", "z", "s t"]]---}-parse'dict :: Parser Dict-parse'dict =-  asum-    [ parse'dict'noRec <&> Dict False-    , parse'dict'rec   <&> Dict True-    ]--{- | Parser for a recursive (@rec@ keyword) dict.-->>> parseTest parse'dict "rec {  }"-rec'dict []-->>> parseTest parse'dict "rec { a = \"1\"; b = \"${a}2\"; }"-rec'dict [binding (str ["a"]) (str ["1"]), binding (str ["b"]) (str [antiquote (var "a"), "2"])]---}-parse'dict'rec :: Parser (Seq DictBinding)-parse'dict'rec =-  parse'keyword keyword'rec *> parse'dict'noRec--{- | Parser for a non-recursive (no @rec@ keyword) dict.-->>> parseTest parse'dict "{  }"-dict []-->>> parseTest parse'dict "{ a = \"1\"; b = \"${a}2\"; }"-dict [binding (str ["a"]) (str ["1"]), binding (str ["b"]) (str [antiquote (var "a"), "2"])]---}-parse'dict'noRec :: Parser (Seq DictBinding)-parse'dict'noRec =-  P.char '{' *> parse'spaces *> go Seq.empty-  where-    go :: Seq DictBinding -> Parser (Seq DictBinding)-    go previousBindings = asum-      [ P.char '}' *> parse'spaces $> previousBindings-      , parse'dictBinding >>= \a -> go (previousBindings |> a)-      ]--{- | Parser for a chain of dict lookups (like @.a.b.c@) on the right-hand side-of a 'Dot' expression.-->>> parseTest parse'dot'rhs'chain ""-[]-->>> parseTest parse'dot'rhs'chain ".abc"-[str ["abc"]]-->>> parseTest parse'dot'rhs'chain ".a.${b}.\"c\".\"d${e}\""-[str ["a"],var "b",str ["c"],str ["d", antiquote (var "e")]]---}-parse'dot'rhs'chain :: Parser [Expression]-parse'dot'rhs'chain =-  P.many $-  P.char '.' *> parse'spaces *> parse'expression'dictKey <* parse'spaces--parse'let :: Parser Let-parse'let =-  parse'keyword keyword'let *> go Seq.empty-  where-    go :: Seq LetBinding -> Parser Let-    go previousBindings =-      asum-        [ end              <&> Let previousBindings-        , parse'letBinding >>= \a -> go (previousBindings |> a)-        ]--    end = parse'keyword keyword'in *> parse'expression--parse'with :: Parser With-parse'with =-  With-    <$> (parse'keyword keyword'with *> parse'expression)-    <*> (P.char ';' *> parse'spaces *> parse'expression)--parse'dictBinding :: Parser DictBinding-parse'dictBinding =-  parse'dictBinding'inherit <|> parse'dictBinding'eq--parse'dictBinding'inherit :: Parser DictBinding-parse'dictBinding'inherit =-  DictBinding'Inherit <$> parse'inherit--parse'dictBinding'eq :: Parser DictBinding-parse'dictBinding'eq =-  DictBinding'Eq-    <$> (parse'expression'dictKey <* parse'spaces <* P.char '=' <* parse'spaces)-    <*> (parse'expression         <* parse'spaces <* P.char ';' <* parse'spaces)--parse'letBinding :: Parser LetBinding-parse'letBinding =-  parse'letBinding'inherit <|> parse'letBinding'eq--parse'letBinding'eq :: Parser LetBinding-parse'letBinding'eq =-  LetBinding'Eq-    <$> (parse'strStatic  <* parse'spaces <* P.char '=' <* parse'spaces)-    <*> (parse'expression <* parse'spaces <* P.char ';' <* parse'spaces)--parse'letBinding'inherit :: Parser LetBinding-parse'letBinding'inherit =-  LetBinding'Inherit <$> parse'inherit--parse'inherit :: Parser Inherit-parse'inherit =-  Inherit-    <$> (parse'keyword keyword'inherit *> P.optionMaybe parse'expression'paren)-    <*> go Seq.empty-  where-    go :: Seq Str'Static -> Parser (Seq Str'Static)-    go previousList =-      asum-        [ P.char ';' *> parse'spaces $> previousList-        , parse'strStatic >>= \x -> go (previousList |> x)-        ]--{- | The primary, top-level expression parser. This is what you use to parse a-@.nix@ file.-->>> parseTest parse'expression ""-parse error at (line 1, column 1):-unexpected end of input-expecting expression---}-parse'expression :: Parser Expression-parse'expression =-  p <?> "expression"-  where-    p = asum-      [ parse'let    <&> Expr'Let-      , parse'with   <&> Expr'With-      , parse'lambda <&> Expr'Lambda-      , parse'expressionList >>= \case-          [] -> P.parserZero-          f : args -> pure $ expression'applyArgs f args-      ]--{- | Parser for a list of expressions in a list literal (@[ x y z ]@) or in a-chain of function arguments (@f x y z@).-->>> parseTest parse'expressionList ""-[]-->>> parseTest (length <$> parse'expressionList) "x \"one two\" (a: b) (c d)"-4-->>> parseTest (length <$> parse'expressionList) "(x \"one two\" (a: b) (c d))"-1---}-parse'expressionList :: Parser [Expression]-parse'expressionList =-  P.many parse'expressionList'1 <?> "expression list"--{- | Parser for a single item within an expression list ('expressionListP').-This expression is not a lambda, a function application, a @let@-@in@-expression, or a @with@ expression.-->>> parseTest parse'expressionList'1 "ab.xy"-dot (var "ab") (str ["xy"])-->>> parseTest parse'expressionList'1 "(x: f x x) y z"-lambda (param "x") (apply (apply (var "f") (var "x")) (var "x"))-->>> parseTest parse'expressionList'1 "{ a = b; }.a y"-dot (dict [binding (str ["a"]) (var "b")]) (str ["a"])---}-parse'expressionList'1 :: Parser Expression-parse'expressionList'1 =-  expression'applyDots-    <$> parse'expressionList'1'noDot-    <*> parse'dot'rhs'chain-    <?> "expression list item"--{- | Like 'parse'expressionList'1', but with the further restriction that the-expression may not be a 'Dot'.-->>> parseTest parse'expressionList'1'noDot "ab.xy"-var "ab"-->>> parseTest parse'expressionList'1'noDot "(x: f x x) y z"-lambda (param "x") (apply (apply (var "f") (var "x")) (var "x"))-->>> parseTest parse'expressionList'1'noDot "{ a = b; }.a y"-dict [binding (str ["a"]) (var "b")]---}-parse'expressionList'1'noDot :: Parser Expression-parse'expressionList'1'noDot =-  asum-    [ parse'strDynamic'quoted <&> Expr'Str-    , parse'list              <&> Expr'List-    , parse'dict              <&> Expr'Dict-    , parse'strUnquoted       <&> Expr'Var-    , parse'expression'paren-    ]-    <?> "expression list item without a dot"--{- | Parser for a parenthesized expression, from opening parenthesis to closing-parenthesis. -}-parse'expression'paren :: Parser Expression-parse'expression'paren =-  P.char '(' *> parse'spaces *> parse'expression <* P.char ')' <* parse'spaces--{- | Parser for an expression in a context that is expecting a dict key.--One of:--- an unquoted string-- a quoted dynamic string-- an arbitrary expression wrapped in antiquotes (@${@...@}@)---}-parse'expression'dictKey :: Parser Expression-parse'expression'dictKey =-  asum-    [ parse'strDynamic'quoted <&> Expr'Str-    , P.string "${" *> parse'spaces *> parse'expression-        <* P.char '}' <* parse'spaces-    , parse'strUnquoted <&> Expr'Str . str'unquotedToDynamic-    ]--parse'count :: Parser a -> Parser Natural-parse'count p = go 0-  where-    go :: Natural -> Parser Natural-    go n = (p *> go (succ n)) <|> pure n

@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleContexts #-}++module Bricks.Prelude+  ( bricks'eval+  , bricks'eval'stdlib+  ) where++-- Bricks+import Bricks+import Bricks.BuiltinFunctions+import Bricks.Evaluation+import Bricks.ExpressionToTerm+import Bricks.Term+import Bricks.Type++-- Bricks internal+import Bricks.Internal.Prelude+import Bricks.Internal.Text    (Text)++-- Parsec+import qualified Text.Parsec as P++-- Base+import Data.Typeable (Typeable)++bricks'eval :: (HasCallStack, Typeable a) => Type a -> Text -> IO a+bricks'eval typ src =+  do+    term <- source'to'term src+    reduce'to'type'or'throw typ term++bricks'eval'stdlib :: (HasCallStack, Typeable a) => Type a -> Text -> IO a+bricks'eval'stdlib typ src =+  do+    term <- source'to'term src+    reduce'to'type'or'throw typ (term /@\ standard'library)++source'to'term :: HasCallStack => Text -> IO Term+source'to'term src =+  do+    expr <- either (error . show) pure (P.parse parse'expression "" src)+    expression'to'term expr

@@ -1,281 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Bricks.Rendering-  (-  -- * @Render@-    Render--  -- * Expressions-  , render'expression-  , render'expression'listContext-  , render'expression'dotLeftContext-  , render'expression'applyLeftContext-  , render'expression'applyRightContext-  , render'expression'inParens-  , render'expression'dictKey--  -- * Strings-  , str'escape-  , render'strUnquoted-  , render'strStatic'unquotedIfPossible-  , render'strStatic'quoted-  , render'strDynamic'unquotedIfPossible-  , render'strDynamic'quoted-  , render'inStr'1--  -- * Lists-  , render'list--  -- * Dicts-  , render'dict-  , render'dictBinding--  -- * Dict lookup-  , render'dot--  -- * Lambdas-  , render'lambda--  -- * Function parameters-  , render'param-  , render'dictPattern-  , render'dictPattern'1--  -- * Function application-  , render'apply--  -- * @let@-  , render'let-  , render'letBinding--  -- * @with@-  , render'with--  -- * @inherit@-  , render'inherit--  ) where---- Bricks-import Bricks.Expression-import Bricks.IndentedString-import Bricks.Keyword-import Bricks.UnquotedString---- Bricks internal-import           Bricks.Internal.Prelude-import qualified Bricks.Internal.Seq     as Seq-import           Bricks.Internal.Text    (Text)-import qualified Bricks.Internal.Text    as Text---- Base-import Prelude (fromIntegral)--type Render a = a -> Text---- | Insert escape sequences for rendering normal double-quoted (@"@) strings.-str'escape :: Text -> Text-str'escape =-  Text.replace "\"" "\\\"" .-  Text.replace "${" "\\${" .-  Text.replace "\n" "\\n" .-  Text.replace "\r" "\\r" .-  Text.replace "\t" "\\t" .-  Text.replace "\\" "\\\\"---- | Render an unquoted string in unquoted form.-render'strUnquoted :: Render Str'Unquoted-render'strUnquoted = str'unquotedToStatic---- | Render a static string, in unquoted form if possible.-render'strStatic'unquotedIfPossible :: Render Str'Static-render'strStatic'unquotedIfPossible x =-  if str'canRenderUnquoted x then x else render'strStatic'quoted x---- | Render a static string, in quoted form.-render'strStatic'quoted :: Render Str'Static-render'strStatic'quoted x =-  "\"" <> str'escape x <> "\""---- | Render a dynamic string, in unquoted form if possible.-render'strDynamic'unquotedIfPossible :: Render Str'Dynamic-render'strDynamic'unquotedIfPossible d =-  case str'dynamicToStatic d of-    Just s  -> render'strStatic'unquotedIfPossible s-    Nothing -> render'strDynamic'quoted d---- | Render a dynamic string, in quoted form.-render'strDynamic'quoted :: Render Str'Dynamic-render'strDynamic'quoted xs =-  "\"" <> foldMap r (strDynamic'toSeq xs) <> "\""-  where-    r = \case-      Str'1'Literal x   -> str'escape x-      Str'1'Antiquote x -> "${" <> render'expression x <> "}"---- | Render one line of an indented string ('InStr').-render'inStr'1 :: Render InStr'1-render'inStr'1 (InStr'1 n xs) =-  Text.replicate (fromIntegral n) " " <> foldMap r (strDynamic'toSeq xs)-  where-    r = \case-      Str'1'Literal x -> x-      Str'1'Antiquote x -> "${" <> render'expression x <> "}"---- | Render a lambda parameter: everything from the beginning of a lambda, up--- to but not including the @:@ that separates the head from the body of the--- lambda.-render'param :: Render Param-render'param =-  \case-    Param'Name a         -> render'strUnquoted a-    Param'DictPattern b -> render'dictPattern b-    Param'Both a b      -> render'strUnquoted a <> "@" <>-                           render'dictPattern b---- | Render a dict pattern (@{ a, b ? c, ... }@).-render'dictPattern :: Render DictPattern-render'dictPattern (DictPattern bs e) =-  if Seq.null xs-    then "{ }"-    else "{ " <> Text.intercalate ", " xs <> " }"-  where-    xs =-      Seq.map render'dictPattern'1 bs <>-      if e then Seq.singleton "..." else Seq.empty---- | Render a single item in a 'DictPattern'.-render'dictPattern'1 :: Render DictPattern'1-render'dictPattern'1 =-  \case-    DictPattern'1 a Nothing  -> render'strUnquoted a-    DictPattern'1 a (Just b) -> render'strUnquoted a <> " ? " <> render'expression b---- | Render a lambda expression (@x: y@).-render'lambda :: Render Lambda-render'lambda (Lambda a b) =-  render'param a <> ": " <> render'expression b---- | Render a function application expression (@f x@).-render'apply :: Render Apply-render'apply (Apply a b) =-  render'expression'applyLeftContext a <> " " <>-  render'expression'applyRightContext b---- | Render a list literal (@[ ... ]@).-render'list :: Render List-render'list (List xs) =-  "[ " <> r xs <> "]"-  where-    r = Text.concat . fmap (\x -> render'expression'listContext x <> " ")---- | Render a dict literal (@{ ... }@).-render'dict :: Render Dict-render'dict =-  \case-    Dict False bs ->     "{ " <> r bs <> "}"-    Dict True  bs -> "rec { " <> r bs <> "}"-  where-    r = Text.concat . fmap (\b -> render'dictBinding b <> "; ")---- | Render a binding within a 'Dict', without the trailing semicolon.-render'dictBinding :: Render DictBinding-render'dictBinding =-  \case-    DictBinding'Eq a b ->-      render'expression'dictKey a <> " = " <> render'expression b-    DictBinding'Inherit x ->-      render'inherit x---- | Render a dot expression (@a.b@).-render'dot :: Render Dot-render'dot (Dot a b) =-  render'expression'dotLeftContext a <> "." <> render'expression'dictKey b---- | Render a @let@-@in@ expression.-render'let :: Render Let-render'let (Let bs x) =-  "let " <> r bs <> "in " <> render'expression x-  where-    r = Text.concat . fmap (\b -> render'letBinding b <> "; ")---- | Render a binding within a 'Let', without the trailing semicolon.-render'letBinding :: Render LetBinding-render'letBinding =-  \case-    LetBinding'Eq a b ->-      render'strStatic'unquotedIfPossible a <> " = " <> render'expression b-    LetBinding'Inherit x ->-      render'inherit x--render'inherit :: Render Inherit-render'inherit =-  \case-    Inherit Nothing xs  -> "inherit" <> r xs-    Inherit (Just a) xs -> "inherit (" <> render'expression a <> ")" <> r xs-  where-    r = foldMap (\x -> " " <> render'strStatic'unquotedIfPossible x)---- | Render a @with@ expression.-render'with :: Render With-render'with (With a b) =-  keywordText keyword'with <> " " <>-  render'expression a <> "; " <>-  render'expression b---- | Render an expression.-render'expression :: Render Expression-render'expression =-  \case-    Expr'Str    x -> render'strDynamic'quoted x-    Expr'Dict   x -> render'dict x-    Expr'List   x -> render'list x-    Expr'Var    x -> render'strUnquoted x-    Expr'Dot    x -> render'dot x-    Expr'Lambda x -> render'lambda x-    Expr'Apply  x -> render'apply x-    Expr'Let    x -> render'let x-    Expr'With   x -> render'with x---- | Render an expression in a list context.-render'expression'listContext :: Render Expression-render'expression'listContext x =-  case x of-    Expr'Lambda _ -> render'expression'inParens x-    Expr'Apply  _ -> render'expression'inParens x-    Expr'Let    _ -> render'expression'inParens x-    Expr'With   _ -> render'expression'inParens x-    _             -> render'expression x---- | Render an expression in the context of the left-hand side of a 'Dot'.-render'expression'dotLeftContext :: Render Expression-render'expression'dotLeftContext = render'expression'listContext---- | Render an expression in the context of the left-hand side of an 'Apply'.-render'expression'applyLeftContext :: Render Expression-render'expression'applyLeftContext x =-  case x of-    Expr'Lambda _ -> render'expression'inParens x-    Expr'Let    _ -> render'expression'inParens x-    Expr'With   _ -> render'expression'inParens x-    _             -> render'expression x---- | Render an expression in the context of the right-hand side of an 'Apply'.-render'expression'applyRightContext :: Render Expression-render'expression'applyRightContext x =-  case x of-    Expr'Apply  _ -> render'expression'inParens x-    Expr'Let    _ -> render'expression'inParens x-    Expr'With   _ -> render'expression'inParens x-    _             -> render'expression x--render'expression'inParens :: Render Expression-render'expression'inParens x =-  "(" <> render'expression x <> ")"--render'expression'dictKey :: Render Expression-render'expression'dictKey = \case-  Expr'Str x -> render'strDynamic'unquotedIfPossible x-  x -> "${" <> render'expression x <> "}"

@@ -0,0 +1,117 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude     #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}++module Bricks.Term where++-- Bricks internal+import Bricks.Internal.Monad+import Bricks.Internal.Prelude+import Bricks.Internal.Seq     (Seq)+import Bricks.Internal.Text    (Text)++-- Containers+import Data.Map (Map)+import Data.Set (Set)++-- Base+import Data.Dynamic (Dynamic)+import Data.IORef++data Bottom = Bottom Text++displayBottom :: Bottom -> Text+displayBottom (Bottom message) = "Error: " <> message++class (Monad m, MonadIO m, MonadError Bottom m) => MonadEval m+  where+    reduce'term :: Term -> m Term+    reduce'dict'keys :: Term -> m (Map Text Term)++type Function = forall m. MonadEval m => Term -> m Term++data Term+  = Term'Data Text Dynamic+      -- ^ The name of the data type, and a value of that type.+  | Term'Function Function+  | Term'Lambda TermPattern Term+      -- ^ The head and body of a lambda expression.+  | Term'LetRec (Map Text Term) Term+  | Term'List (Seq Term)+  | Term'Dict (Seq (Term, Term))+  | Term'Dict'ReducedKeys (Map Text Term)+  | Term'Var Text+  | Term'Apply Term Term+  | Term'Pointer TermPtr++{- | Alias for 'Term'Apply'. The name is an allusion to the AST depictions in+/The Implementation of Functional Programming Languages/, where "/f/ applied to+/x/" is drawn as:++>   @+>  ╱ ╲+> f   x++For a function of two parameters, see the corresponding '/@@\' operator. -}++(/@\) :: Term -> Term -> Term+(/@\) = Term'Apply+infixl /@\++{- | Like '/@\', but for a function applied to two arguments. Depicted as an+abstract syntax tree, @f /\@\@\\ (x, y)@ looks like this:++>     @+>    ╱ ╲+>   @   y+>  ╱ ╲+> f   x++-}++(/@@\) :: Term -> (Term, Term) -> Term+f /@@\ (x, y) = (f /@\ x) /@\ y+infixl /@@\++{- | Alias for 'Term'Lambda'. -}++(|->) :: TermPattern -> Term -> Term+(|->) = Term'Lambda+infixl |->++data TermPattern+  = TermPattern'Simple Text+  | TermPattern'Dict (Set Text)++type TermPtr = IORef Term++create'pointer :: MonadIO m => Term -> m Term+create'pointer x = case x of+  Term'Pointer _ -> pure x  -- The term is already a pointer, don't make another+  _              -> Term'Pointer <$> liftIO (newIORef x)++dereference :: MonadIO m => Term -> m Term+dereference = \case+  Term'Pointer p -> readTermPtr p >>= dereference+  x -> pure x++newTermPtr :: MonadIO m => Term -> m Term+newTermPtr x = case x of+   Term'Pointer _ -> pure x  -- The term is already a pointer, nothing to do+   _              -> Term'Pointer <$> liftIO (newIORef x)++readTermPtr :: MonadIO m => TermPtr -> m Term+readTermPtr = liftIO . readIORef++writeTermPtr :: MonadIO m => TermPtr -> Term -> m ()+writeTermPtr ptr val = do+  x <- dereference val+  liftIO $ writeIORef ptr x++bottom :: MonadError Bottom m => Bottom -> m a+bottom = throwError

@@ -0,0 +1,43 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeApplications           #-}++module Bricks.Type where++-- Bricks+import Bricks.Term++-- Bricks internal+import Bricks.Internal.Monad+import Bricks.Internal.Prelude+import Bricks.Internal.Text    (Text)++-- Base+import Prelude (Integer)++data Type a = Type { type'name :: Text }++type'boolean :: Type Bool+type'boolean = Type "boolean"++type'string :: Type Text+type'string = Type "string"++type'integer :: Type Integer+type'integer = Type "integer"++termTypeName :: MonadIO m => Term -> m Text+termTypeName = \case+  Term'Data x _ -> pure x+  Term'Function{} -> pure "built-in function"+  Term'Lambda{} -> pure "lambda"+  Term'LetRec{} -> pure "recursive let"+  Term'List{} -> pure "list"+  Term'Dict{} -> pure "dict"+  Term'Dict'ReducedKeys{} -> pure "dict with reduced keys"+  Term'Var{} -> pure "variable"+  Term'Apply{} -> pure "function application"+  Term'Pointer p -> readTermPtr p >>= termTypeName

@@ -1,83 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Bricks.UnquotedString-  (-  -- * Type-    Str'Unquoted (..)--  -- * Constructor-  , str'tryUnquoted-  , str'unquoted'orThrow--  -- * Predicates-  , str'canRenderUnquoted-  , char'canRenderUnquoted--  ) where---- Bricks-import Bricks.Keyword---- Bricks internal-import           Bricks.Internal.Prelude-import           Bricks.Internal.Text    (Text)-import qualified Bricks.Internal.Text    as Text---- Base-import qualified Data.Char as Char-import qualified Data.List as List-import           Prelude   (error)--{- | A string that can be rendered unquoted. Unquoted strings are restricted to-a conservative set of characters; see 'str'canRenderUnquoted' for the full-rules.--The constructor is tagged "unsafe" because it lets you construct and invalid-value. Prefer 'str'tryUnquoted' which does validate the text. -}-newtype Str'Unquoted = Str'Unquoted'Unsafe { str'unquotedToStatic :: Text }--instance Show Str'Unquoted-  where-    showsPrec _ x = ("unquoted " <>) . shows (str'unquotedToStatic x)--str'tryUnquoted :: Text -> Maybe Str'Unquoted-str'tryUnquoted x =-  if str'canRenderUnquoted x then Just (Str'Unquoted'Unsafe x) else Nothing---- | Throws an exception if the string cannot render unquoted.-str'unquoted'orThrow :: Text -> Str'Unquoted-str'unquoted'orThrow x =-  if str'canRenderUnquoted x then Str'Unquoted'Unsafe x else-  error $ "String " <> show x <> " cannot render unquoted"--{- | Whether a string having this name can be rendered without quoting it.-We allow a string to render unquoted if all these conditions are met:--- The string is nonempty-- All characters satify 'char'canRenderUnquoted'-- The string is not a keyword-->>> str'canRenderUnquoted "-ab_c"-True-->>> str'canRenderUnquoted ""-False-->>> str'canRenderUnquoted "a\"b"-False-->>> str'canRenderUnquoted "let"-False---}-str'canRenderUnquoted :: Text -> Bool-str'canRenderUnquoted x =-  Text.all char'canRenderUnquoted x-  && not (Text.null x)-  && List.all ((/= x) . keywordText) keywords---- | Letters, @-@, and @_@.-char'canRenderUnquoted :: Char -> Bool-char'canRenderUnquoted c =-  Char.isLetter c || c == '-' || c == '_'

@@ -1,23 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Bricks.Test.Hedgehog-  ( runTests-  ) where---- Base-import           Control.Monad (unless)-import           Data.Foldable (for_)-import qualified System.Exit   as Exit-import qualified System.IO     as IO---- Hedgehog-import qualified Hedgehog--runTests :: Hedgehog.Group -> IO ()-runTests tests =-  do-    for_ [IO.stdout, IO.stderr] $ \h -> do-      IO.hSetEncoding h IO.utf8-      IO.hSetBuffering h IO.LineBuffering-    success <- Hedgehog.checkParallel tests-    unless success Exit.exitFailure

@@ -1,39 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Bricks.Test.QQ-  ( text-  ) where---- Base-import Control.Arrow ((>>>))-import Data.Function (const)---- Template Haskell-import Language.Haskell.TH-import Language.Haskell.TH.Quote---- Text-import qualified Data.Text as Text--text :: QuasiQuoter-text =-  QuasiQuoter-    { quoteExp  = pure . LitE . StringL . stripMargin-    , quotePat  = err-    , quoteType = err-    , quoteDec  = err-    }-  where-    err = const . fail $ "illegal text QuasiQuote (allowed as expression only)"--stripMargin :: String -> String-stripMargin =-  Text.pack-  >>> Text.splitOn "\n"-  >>> fmap (\x ->-        let (a, b) = Text.breakOn "|" x-        in  if Text.all (== ' ') a && not (Text.null b)-            then Text.drop 1 b-            else x)-  >>> Text.intercalate "\n"-  >>> Text.unpack

@@ -0,0 +1,68 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TypeApplications  #-}++-- Bricks+import Bricks.Prelude+import Bricks.Type++-- Bricks internal+import Bricks.Internal.Monad+import Bricks.Internal.Prelude++-- Bricks test+import Bricks.Test.Hedgehog+import Bricks.Test.QQ++-- Hedgehog+import           Hedgehog (Property, property, withTests, (===))+import qualified Hedgehog++-- Base+import System.IO (IO)++main :: IO ()+main = runTests $$(Hedgehog.discover)++prop_str :: Property+prop_str = withTests 1 $ property $ do++  do+    x <- liftIO $ bricks'eval type'string [text|"abc"|]+    x === "abc"++  do+    x <- liftIO $ bricks'eval type'string [text|''a${"b"}c''|]+    x === "abc"++{-+prop_dict :: Property+prop_dict = withTests 1 $ property $ do++  x <- liftIO $ bricks'eval type'string [text|{ a = "1"; }.a|]+  x === "1"++  x <- liftIO $ bricks'eval type'string [text|{ "a b" = "1"; }."a b"|]+  x === "1"+-}++prop_add :: Property+prop_add = withTests 1 $ property $ do++  do+    x <- liftIO $ bricks'eval'stdlib type'integer+      [text|┃{ add, integer, ... }:+            ┃add (integer "1") (integer "2")|]+    x === 3++  do+    x <- liftIO $ bricks'eval'stdlib type'integer+      [text|┃lib:+            ┃let+            ┃  inherit (lib) add integer;+            ┃in+            ┃  add (integer "1") (integer "2")|]+    x === 3

@@ -1,527 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE TemplateHaskell   #-}---- Bricks-import Bricks---- Bricks internal-import           Bricks.Internal.Prelude-import           Bricks.Internal.Text    (Text)-import qualified Bricks.Internal.Text    as Text---- Bricks test-import Bricks.Test.Hedgehog-import Bricks.Test.QQ---- Parsec-import qualified Text.Parsec      as P-import           Text.Parsec.Text (Parser)---- Hedgehog-import           Hedgehog (Property, property, (===))-import qualified Hedgehog---- Base-import System.IO (IO)-import Text.Show (show)--main :: IO ()-main = runTests $$(Hedgehog.discover)--{- | We'll use the @parseTest@ function a lot to test parsers. It's a bit like-'P.parseTest' from the Parsec library, but it works on parsers of type 'Text'-rather than @'Show' a => a@. It also prints the unparsed input so we can verify-that our parser consumes the right amount of input, and it prints a message if-the parser fails and consumes input. -}-parseTest :: Parser Text -> Text -> Text-parseTest p input =-  Text.intercalate "\n" $-  catMaybes--    [ Just $ case P.parse p "" input of-        Left err ->-          "Parse error at " <>-          Text.replace "\n" "\n - " (Text.pack (show err))-        Right x -> x--    , let-        p' = do-          _ <- p-          r <- P.many1 P.anyChar-          pure $ "Remaining input: " <> Text.pack (show r)-      in-        case P.parse p' "" input of-          Left _  -> Nothing-          Right x -> Just x--    , case P.parse (void p <|> pure ()) "" input of-        Left _  -> Just "Parser failed and consumed input"-        Right _ -> Nothing--    ]--prop_parse_str_unquoted :: Property-prop_parse_str_unquoted = property $ do--  let test = parseTest $ fmap str'unquotedToStatic $ parse'strUnquoted--  test "-ab_c" === [text|-ab_c|]--  test ""      === [text|Parse error at (line 1, column 1):-                        | - unexpected end of input|]--  test "a\"b"  === [text|a-                        |Remaining input: "\"b"|]--  test "a b"   === [text|a-                        |Remaining input: "b"|]--  -- The unquoted string parser doesn't backtrack.-  -- Note how in this example it fails and consumes input.-  test "rec { }" === [text|Parse error at (line 1, column 4):-                          | - unexpected " "-                          |Parser failed and consumed input|]--prop_parse_expression_dictKey :: Property-prop_parse_expression_dictKey = property $ do--  let test = parseTest $ fmap render'expression $ parse'expression'dictKey--  test "a"      === [text|"a"|]--  test "\"a\""  === [text|"a"|]--  test "a b"    === [text|"a"-                         |Remaining input: "b"|]--  test "${a.b}" === [text|a.b|]--prop_parse_strDynamic_normalQ :: Property-prop_parse_strDynamic_normalQ = property $ do--  let test = parseTest-           $ fmap render'strDynamic'quoted-           $ parse'strDynamic'normalQ--  test "\"a\""        === [text|"a"|]--  test "\"a\" x"      === [text|"a"-                               |Remaining input: "x"|]--  test "\"a ${b} c\"" === [text|"a ${b} c"|]--  test "\"a${ b }c\"" === [text|"a${b}c"|]--  test "\"$\""        === [text|"$"|]--  test "\"a$\""       === [text|"a$"|]--  test "\"\\${\""     === [text|"\${"|]--  test "\"a\\${\""    === [text|"a\${"|]--prop_parse_strDynamic_indentedQ :: Property-prop_parse_strDynamic_indentedQ = property $ do--  let test = parseTest-           $ fmap render'strDynamic'quoted-           $ P.spaces *> parse'strDynamic'indentedQ--  test "''hello''x"    === [text|"hello"-                                |Remaining input: "x"|]--  test "''hello'' x"   === [text|"hello"-                                |Remaining input: "x"|]--  test [text|  ''-            |    one-            |    two-            |  ''x|] === [text|"one\ntwo"-                              |Remaining input: "x"|]--  test [text|  ''-            |    one-            |-            |    two-            |  ''x|] === [text|"one\n\ntwo"-                              |Remaining input: "x"|]--prop_parse_inStr :: Property-prop_parse_inStr = property $ do--  let test = parseTest-           $ fmap (Text.pack . show . fmap render'inStr'1 . inStr'toList)-           $ P.spaces *> parse'inStr--  test [text|  ''-            |    one-            |    two-            |  ''x|] === [text|["","    one","    two","  "]-                              |Remaining input: "x"|]--  test [text|  ''-            |    one-            |-            |    two-            |  ''x|] === [text|["","    one","","    two","  "]-                              |Remaining input: "x"|]--  test "'''' x"   === [text|[""]-                           |Remaining input: "x"|]--  test "''abc''"  === [text|["abc"]|]--  test "''\n''"   === [text|["",""]|]--  test "''  \n''" === [text|["  ",""]|]--  test "''   abc\ndef''" === [text|["   abc","def"]|]--prop_parse_inStr_line :: Property-prop_parse_inStr_line = property $ do--  let test = parseTest-           $ fmap (Text.pack . show . render'inStr'1)-           $ parse'inStr'1--  test "abc" === [text|Parse error at (line 1, column 4):-                      | - unexpected end of input-                      | - expecting "$", "'", "\n", "''" or "${"-                      |Parser failed and consumed input|]--  test "\n"   === [text|""-                       |Remaining input: "\n"|]--  test "  \n" === [text|"  "-                       |Remaining input: "\n"|]--  test "   abc\ndef" === [text|"   abc"-                              |Remaining input: "\ndef"|]--  test "   abc''x"   === [text|"   abc"-                              |Remaining input: "''x"|]--prop_parse_dict_pattern_start :: Property-prop_parse_dict_pattern_start = property $ do--  let test = parseTest $ (P.try parse'dictPattern'start $> "yes") <|> pure "no"--  test "{a, b}:"     === [text|yes-                              |Remaining input: " b}:"|]--  test "{a ? 4, b}:" === [text|yes-                              |Remaining input: " 4, b}:"|]--  test "{ }: x"      === [text|yes-                              |Remaining input: " x"|]--  -- { } is not enough to determine whether we're parsing a dict param, because-  -- if it isn't followed by a colon, then it's actually an empty dict literal.-  test "{ } x"       === [text|no-                              |Remaining input: "{ } x"|]--  test "{ ... }:"    === [text|yes-                              |Remaining input: " }:"|]--prop_parse_dict_pattern :: Property-prop_parse_dict_pattern = property $ do--  let test = parseTest $ fmap render'dictPattern $ parse'dictPattern--  test "{}"               === [text|{ }|]-  test "{...}"            === [text|{ ... }|]-  test "{a}"              === [text|{ a }|]-  test "{a , b}"          === [text|{ a, b }|]-  test "{a , b ? c, ...}" === [text|{ a, b ? c, ... }|]--prop_parse_dot_rhs_chain :: Property-prop_parse_dot_rhs_chain = property $ do--  let test = parseTest-           $ fmap (Text.intercalate "\n" . fmap render'expression)-           $ parse'dot'rhs'chain--  -- The dots parser /does/ match the empty string.-  test ""         === [text||]--  -- The simplest nonempty dot list-  test ".a"       === [text|"a"|]--  -- The dots parser consumes any trailing whitespace beyond the dot list.-  test ".a "      === [text|"a"|]--  -- Dot attributes are usually unquoted strings, but they may also be quoted.-  test ".\"a\""   === [text|"a"|]-  test ". \"a\""  === [text|"a"|]--  -- Here we throw some extra whitespace into the middle, which makes no-  -- difference, and some extra stuff onto the end, which does not get consumed.-  test ".a . b c" === [text|"a"-                           |"b"-                           |Remaining input: "c"|]--  -- Another example of a quoted dot, this time following an unquoted dot-  test ".a.\"b\"" === [text|"a"-                           |"b"|]--  -- If quotes or braces are involved, the stuff that follows a dot expression-  -- can directly abut it with no whitespace in between.-  test [text|.a."b"x|] === [text|"a"-                                |"b"-                                |Remaining input: "x"|]--  test [text|.a.b"x"|] === [text|"a"-                                |"b"-                                |Remaining input: "\"x\""|]--  test ".a.b(x)"   === [text|"a"-                            |"b"-                            |Remaining input: "(x)"|]--  test ". a . b"   === [text|"a"-                            |"b"|]--  test ". \"a\".b" === [text|"a"-                            |"b"|]--  test ". \"a\".${b}" === [text|"a"-                               |b|]--prop_parse_expression :: Property-prop_parse_expression = property $ do--  let test = parseTest $ fmap render'expression $ parse'expression--  -- The empty string is /not/ a valid expression.-  test "" === [text|Parse error at (line 1, column 1):-                   | - unexpected end of input-                   | - expecting expression|]--  -- A very simple expression: a one-letter variable-  test "a"         === [text|a|]--  -- Parsing an expression consumes any subsequent whitespace.-  test "a "        === [text|a|]--  -- When there are multiple expressions, that is parsed as a function call.-  test "f x"       === [text|f x|]--  -- Expressions can directly abut each other, so it's important that the-  -- expression parser is also able to read an expression even when another-  -- expression directly follows it.-  test "f[x y]"    === [text|f [ x y ]|]--  -- A simple example of parsing a dot expression-  test "a.b"       === [text|a.b|]--  -- Dot parsing also consumes trailing whitespace.-  test "a.b "      === [text|a.b|]--  -- It looks odd when a subsequent expression appears after a dot expression-  -- with no whitespace, but it is permitted.-  test "a.b\"c\""  === [text|a.b "c"|]--  -- A simple list example-  test "[ a b ]"   === [text|[ a b ]|]--  -- A list with trailing whitespace that get consumed-  test "[ a b ] "  === [text|[ a b ]|]--  -- A list that is in the left-hand side of a function call. This will fail at-  -- runtime if the call is evaluated, because a list is not a function, but it-  -- should /parse/ successfully.-  test "[ a b ] x" === [text|[ a b ] x|]--  -- The same thing with other weird stuff on the left-hand side of a function-  -- call.-  test "{ a = b; } x" === [text|{ a = b; } x|]--  test "{ } x"        === [text|{ } x|]--  -- Note that the case where an empty dict is on the left-hand side of a-  -- function call looks very similar to the case where a function expression-  -- using dict deconstruction with no bindings. The only difference is the-  -- colon.-  test "{ }: x"      === [text|{ }: x|]--  -- A list with a function call inside-  test "[ (f x) ]"   === [text|[ (f x) ]|]--  test "[ a (f x) ]" === [text|[ a (f x) ]|]--  -- A minimal dict literal-  test "{ x = y; }"  === [text|{ x = y; }|]--  -- The left-hand side of a dict binding is allowed to be any expression.-  test "{ \"a b\" = y; }"  === [text|{ "a b" = y; }|]-  test "{ ${x} = y; }"     === [text|{ ${x} = y; }|]--  -- It may even be the empty string.-  test "{ \"\" = y; }"     === [text|{ "" = y; }|]--  -- None of the conventional whitespace within a dict literal is mandatory.-  test "{x=y;}"            === [text|{ x = y; }|]--  -- A simple dict literal with two bindings-  test "{ x = y; a = b; }" === [text|{ x = y; a = b; }|]--  -- The same thing without any whitespace-  test "{x=y;a=b;}" === [text|{ x = y; a = b; }|]--  -- Dicts with 'inherit' bindings-  test "{ inherit a; }"       === [text|{ inherit a; }|]-  test "{ inherit a b; }"     === [text|{ inherit a b; }|]-  test "{ inherit (x) a b; }" === [text|{ inherit (x) a b; }|]--  -- An inherit binding can be empty, although it is weird.-  test "{ inherit; }"   === [text|{ inherit; }|]--  -- A simple function-  test "x : y" === [text|x: y|]--  -- Whitespace before the colon is unconventional, but allowed.-  test "x : y" === [text|x: y|]--  -- The space after the colon is not mandatory. (In Nix, this example would be-  -- parsed as the string "x:y", but here we do not support URI literals.)-  test "x:y"   === [text|x: y|]--  -- A slightly bigger example where we're starting to nest more things-  test "[ \"abc\" f { x = y; } ]"   === [text|[ "abc" f { x = y; } ]|]--  test "[ \"abc\" (f { x = y; }) ]" === [text|[ "abc" (f { x = y; }) ]|]--  -- This is not valid a expression (though the first bit of it is).-  test "a b: c"   === [text|a b-                           |Remaining input: ": c"|]--  -- This is not a valid expression.-  test "(a b: c)" === [text|Parse error at (line 1, column 5):-                           | - unexpected ":"-                           | - expecting expression list item or ")"-                           |Parser failed and consumed input|]--  -- Some functions that use dict deconstruction-  test "{ a, b, c ? x, ... }: g b (f a c)"-    === [text|{ a, b, c ? x, ... }: g b (f a c)|]--  test "{ x, ... }: f x"    === [text|{ x, ... }: f x|]-  test "{ x?\"abc\" }: x"   === [text|{ x ? "abc" }: x|]-  test "{ ... }: x"         === [text|{ ... }: x|]-  test "a@{ x, ... }: f x"  === [text|a@{ x, ... }: f x|]-  test "a@{ x?\"abc\" }: x" === [text|a@{ x ? "abc" }: x|]-  test "a@{ ... }: x"       === [text|a@{ ... }: x|]--  -- A let expression-  test "let f = x: plus one x; in f seven"-    === [text|let f = x: plus one x; in f seven|]--  -- A let binding list may be empty, although it is silly.-  test "let in f x" === [text|let in f x|]--  test "with x; y"  === [text|with x; y|]--  test "with{x=y;}; f x z" === [text|with { x = y; }; f x z|]--  -- Indented strings do not support any escape sequences.-  test [text|''-            |  There \ is \n no \$ escape.-            |''|] === [text|"There \\ is \\n no \\$ escape."|]--  -- Therefore if you want to include something like '' in an indented string,-  -- you have to put it inside an antiquote.-  test [text|''-            |  Isn't it-            |  ${"''"}interesting-            |''-            |] === [text|"Isn't it\n''interesting"|]--  -- Comments-  test [text|let                -- hi-            |  x {- ! -} = "a"; -- yep-            | in                -- lol-            |   f x-            |] === [text|let x = "a"; in f x|]--  -- Nested block comments-  test [text|f{- a-            |  -- b-            |    {- c {- d-            |    -}-} e-            |  -}x|] === "f x"--prop_parse_expression_list :: Property-prop_parse_expression_list = property $ do--  let test = parseTest-           $ fmap (Text.intercalate "\n" . fmap render'expression)-           $ parse'expressionList--  test ""                       === [text||]--  test "x y z"                  === [text|x-                                         |y-                                         |z|]---  test "(a)b c(d)"              === [text|a-                                         |b-                                         |c-                                         |d|]--  test "a.\"b\"c"               === [text|a.b-                                         |c|]--  test "\"abc\" (f { x = y; })" === [text|"abc"-                                         |f { x = y; }|]--  -- Parsing lists of variables that are similar to keywords-  test "r re reck"              === [text|r-                                         |re-                                         |reck|]-  test "r re rec { } reck"      === [text|r-                                         |re-                                         |rec { }-                                         |reck|]-  test "l le lets"              === [text|l-                                         |le-                                         |lets|]-  test "i ins"                  === [text|i-                                         |ins|]-  test "wi wit withs"           === [text|wi-                                         |wit-                                         |withs|]-  test "inheri inherits"        === [text|inheri-                                         |inherits|]--prop_parse_expression_list_item :: Property-prop_parse_expression_list_item = property $ do--  let test = parseTest $ fmap render'expression $ parse'expressionList'1--  test "abc def"  === [text|abc-                           |Remaining input: "def"|]-  test "a.b c"    === [text|a.b-                           |Remaining input: "c"|]-  test "a.\"b\"c" === [text|a.b-                           |Remaining input: "c"|]-  test "(a.b)c"   === [text|a.b-                           |Remaining input: "c"|]-  test "a.b(c)"   === [text|a.b-                           |Remaining input: "(c)"|]-  test "[ a b ]c" === [text|[ a b ]-                           |Remaining input: "c"|]-  test "a[ b c ]" === [text|a-                           |Remaining input: "[ b c ]"|]-  test "\"a\"b"   === [text|"a"-                           |Remaining input: "b"|]--prop_parse_expression_list_item_no_dot :: Property-prop_parse_expression_list_item_no_dot = property $ do--  let test = parseTest $ fmap render'expression $ parse'expressionList'1'noDot--  test "a.b c" === [text|a-                        |Remaining input: ".b c"|]

@@ -1,123 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedLists   #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE TemplateHaskell   #-}---- Bricks-import Bricks-import Bricks.Expression.Construction---- Bricks internal-import Bricks.Internal.Prelude---- Bricks test-import Bricks.Test.Hedgehog-import Bricks.Test.QQ---- Hedgehog-import           Hedgehog (Property, property, (===))-import qualified Hedgehog---- Base-import System.IO (IO)--main :: IO ()-main = runTests $$(Hedgehog.discover)--prop_render_expression :: Property-prop_render_expression = property $ do--  render'expression (dot (var "a") (str ["b"])) === [text|a.b|]--  render'expression (dot (var "a") (var "b"))   === [text|a.${b}|]--  render'expression (dot (str ["a"])-    (str ["b", antiquote (var "c")]))           === [text|"a"."b${c}"|]--  render'expression-    (lambda-      (param "a" <> pattern-        [ param "f"-        , param "b" & def (apply (var "g") (var "x"))-        ] <> ellipsis)-      (apply (var "f") (var "b")))-    === [text|a@{ f, b ? g x, ... }: f b|]--  render'expression-    (let'in-      [ binding "d" (dict-        [ binding (str ["a"]) (str ["b", antiquote (var "c")])-        , inherit'from (var "x") ["y", "z"]-        ])]-      (dot (var "d") (str ["y"])))-    === [text|let d = { a = "b${c}"; inherit (x) y z; }; in d.y|]--prop_render_identifier :: Property-prop_render_identifier = property $ do--  let test = render'strStatic'unquotedIfPossible--  test "abc"  === [text|abc|]-  test "a\"b" === [text|"a\"b"|]-  test "-ab"  === [text|-ab|]-  test ""     === [text|""|]--prop_render_string_dynamic_quoted :: Property-prop_render_string_dynamic_quoted = property $ do--  let test = render'strDynamic'quoted . strDynamic'fromList--  test []                        === [text|""|]-  test [ Str'1'Literal "hello" ] === [text|"hello"|]--  test [ Str'1'Literal "escape ${ this and \" this" ]-    === [text|"escape \${ this and \" this"|]--  test [ Str'1'Literal "Hello, my name is "-       , Str'1'Antiquote (Expr'Var (Str'Unquoted'Unsafe "name"))-       , Str'1'Literal "!"-       ]-    === [text|"Hello, my name is ${name}!"|]--prop_render_indented_string_line :: Property-prop_render_indented_string_line = property $ do--  let test n xs = render'inStr'1 $ InStr'1 n (strDynamic'fromList xs)--  test 2 [ Str'1'Literal "abc"-         , Str'1'Antiquote (Expr'Var $ Str'Unquoted'Unsafe "x")-         ]-    === [text|  abc${x}|]--prop_render_dict_pattern :: Property-prop_render_dict_pattern = property $ do--  let test a b = render'dictPattern $ DictPattern a b--  test [] False === [text|{ }|]-  test [] True  === [text|{ ... }|]--  let-    item1 = DictPattern'1 (Str'Unquoted'Unsafe "x") Nothing-    item2 = DictPattern'1 (Str'Unquoted'Unsafe "y") $-      Just $ Expr'Str (strDynamic'singleton (Str'1'Literal "abc"))--  test [ item1, item2 ] False === [text|{ x, y ? "abc" }|]-  test [ item1, item2 ] True  === [text|{ x, y ? "abc", ... }|]--prop_render_list :: Property-prop_render_list = property $ do--  let test = render'list . List--  test []                                     === [text|[ ]|]-  test [ Expr'Var (Str'Unquoted'Unsafe "a") ] === [text|[ a ]|]-  test [ Expr'Var (Str'Unquoted'Unsafe "a")-       , Expr'Var (Str'Unquoted'Unsafe "b") ] === [text|[ a b ]|]--  let call = Expr'Apply $ Apply (Expr'Var (Str'Unquoted'Unsafe "f"))-                                (Expr'Var (Str'Unquoted'Unsafe "x"))--  test [ call ]                                     === [text|[ (f x) ]|]-  test [ call, Expr'Var (Str'Unquoted'Unsafe "a") ] === [text|[ (f x) a ]|]