bricks (empty) → 0.0.0.1
raw patch · 19 files changed
+3210/−0 lines, 19 filesdep +basedep +bricksdep +containerssetup-changed
Dependencies added: base, bricks, containers, doctest, hedgehog, parsec, template-haskell, text
Files
- Setup.hs +2/−0
- bricks.cabal +105/−0
- license.txt +13/−0
- src/Bricks.hs +203/−0
- src/Bricks/Expression.hs +583/−0
- src/Bricks/Expression/Construction.hs +233/−0
- src/Bricks/IndentedString.hs +120/−0
- src/Bricks/Internal/Prelude.hs +43/−0
- src/Bricks/Internal/Seq.hs +47/−0
- src/Bricks/Internal/Text.hs +35/−0
- src/Bricks/Keyword.hs +67/−0
- src/Bricks/Parsing.hs +679/−0
- src/Bricks/Rendering.hs +281/−0
- src/Bricks/UnquotedString.hs +83/−0
- test/Bricks/Test/Hedgehog.hs +23/−0
- test/Bricks/Test/QQ.hs +39/−0
- test/doctest.hs +4/−0
- test/parsing.hs +527/−0
- test/rendering.hs +123/−0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bricks.cabal view
@@ -0,0 +1,105 @@+-- This file has been generated from package.yaml by hpack version 0.18.1.+--+-- see: https://github.com/sol/hpack++name: bricks+version: 0.0.0.1+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.+homepage: https://github.com/chris-martin/bricks#readme+bug-reports: https://github.com/chris-martin/bricks/issues+license: Apache-2.0+license-file: license.txt+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/chris-martin/bricks++library+ hs-source-dirs:+ 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+ 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+ other-modules:+ Paths_bricks+ default-language: Haskell2010++test-suite doctest+ type: exitcode-stdio-1.0+ main-is: doctest.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+ , 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+ other-modules:+ Bricks.Test.Hedgehog+ Bricks.Test.QQ+ default-language: Haskell2010++test-suite rendering+ type: exitcode-stdio-1.0+ main-is: rendering.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+ other-modules:+ Bricks.Test.Hedgehog+ Bricks.Test.QQ+ default-language: Haskell2010
+ license.txt view
@@ -0,0 +1,13 @@+Copyright 2017 Chris Martin++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ src/Bricks.hs view
@@ -0,0 +1,203 @@+{- | __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)++The following modules are re-exported from this module in their entireties:++- "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++Other modules:++- "Bricks.Expression.Construction" - Functions for constructing 'Expression's+ in a way that matches their 'Show' implementations.++-}+module Bricks++ (+ -------------------------------------------------+ -- * Expressions+ Expression (..)+ -- ** Rendering expressions+ , render'expression+ , render'expression'listContext+ , render'expression'dotLeftContext+ , render'expression'applyLeftContext+ , render'expression'applyRightContext+ , render'expression'inParens+ , render'expression'dictKey+ -- ** Parsing expressions+ , parse'expression+ , parse'expression'paren+ , parse'expression'dictKey+ -- ** Parsing lists of expressions+ , parse'expressionList+ , parse'expressionList'1+ , parse'expressionList'1'noDot+ -------------------------------------------------+ -- * Strings+ , str'escape+ , parse'str'within'normalQ+ , parse'str'escape'normalQ+ -- ** Static strings+ , Str'Static+ , render'strStatic'unquotedIfPossible+ , render'strStatic'quoted+ , parse'strStatic+ , parse'strStatic'quoted+ , parse'strStatic'unquoted+ -- ** Dynamic strings+ , Str'Dynamic (..)+ , Str'1 (..)+ , strDynamic'toList+ , strDynamic'fromList+ , strDynamic'singleton+ , render'strDynamic'unquotedIfPossible+ , render'strDynamic'quoted+ , parse'strDynamic'quoted+ , parse'strDynamic'normalQ+ , parse'strDynamic'indentedQ+ -- ** Unquoted strings+ , Str'Unquoted (..)+ , str'tryUnquoted+ , str'unquoted'orThrow+ , str'canRenderUnquoted+ , char'canRenderUnquoted+ , render'strUnquoted+ , parse'strUnquoted+ -- ** String conversions+ , str'dynamicToStatic+ , str'staticToDynamic+ , str'unquotedToDynamic+ -- ** Indented strings+ , InStr (..)+ , inStr'toList+ , inStr'join+ , inStr'level+ , inStr'dedent+ , inStr'trim+ , render'inStr'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 (..)+ , render'list+ , parse'list+ -------------------------------------------------+ -- * Dicts+ , Dict (..)+ , keyword'rec+ , render'dict+ , parse'dict+ , parse'dict'rec+ , parse'dict'noRec+ -- ** Dict bindings+ , DictBinding (..)+ , render'dictBinding+ , parse'dictBinding+ , parse'dictBinding'inherit+ , parse'dictBinding'eq+ -- ** Dict lookup (dot)+ , Dot (..)+ , expression'applyDots+ , render'dot+ , parse'dot'rhs'chain+ -------------------------------------------------+ -- * Functions+ -- ** Lambdas+ , Lambda (..)+ , render'lambda+ , parse'lambda+ -- ** Function parameters+ , Param (..)+ , render'param+ , parse'param+ , parse'param'var+ , parse'param'noVar+ -- ** Dict patterns+ , DictPattern (..)+ , DictPattern'1 (..)+ , render'dictPattern+ , render'dictPattern'1+ , parse'dictPattern+ , parse'dictPattern'start+ -- ** Function application+ , Apply (..)+ , expression'applyArgs+ , render'apply+ -------------------------------------------------+ -- * @let@+ , Let (..)+ , keyword'let+ , keyword'in+ , render'let+ , parse'let+ -- ** @let@ bindings+ , LetBinding (..)+ , 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+ , Render+ , parse'antiquote+ -------------------------------------------------+ ) where++import Bricks.Expression+import Bricks.IndentedString+import Bricks.Keyword+import Bricks.Parsing+import Bricks.Rendering+import Bricks.UnquotedString
+ src/Bricks/Expression.hs view
@@ -0,0 +1,583 @@+{-# 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)]
+ src/Bricks/Expression/Construction.hs view
@@ -0,0 +1,233 @@+{-# 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)
+ src/Bricks/IndentedString.hs view
@@ -0,0 +1,120 @@+{-# 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
+ src/Bricks/Internal/Prelude.hs view
@@ -0,0 +1,43 @@+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 <&>
+ src/Bricks/Internal/Seq.hs view
@@ -0,0 +1,47 @@+{-# 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
+ src/Bricks/Internal/Text.hs view
@@ -0,0 +1,35 @@+{-# 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
+ src/Bricks/Keyword.hs view
@@ -0,0 +1,67 @@+{-# 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 "--"
+ src/Bricks/Parsing.hs view
@@ -0,0 +1,679 @@+{-# 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
+ src/Bricks/Rendering.hs view
@@ -0,0 +1,281 @@+{-# 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 <> "}"
+ src/Bricks/UnquotedString.hs view
@@ -0,0 +1,83 @@+{-# 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 == '_'
+ test/Bricks/Test/Hedgehog.hs view
@@ -0,0 +1,23 @@+{-# 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
+ test/Bricks/Test/QQ.hs view
@@ -0,0 +1,39 @@+{-# 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
+ test/doctest.hs view
@@ -0,0 +1,4 @@+import Test.DocTest (doctest)++main :: IO ()+main = doctest ["src", "-XOverloadedStrings"]
+ test/parsing.hs view
@@ -0,0 +1,527 @@+{-# 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"|]
+ test/rendering.hs view
@@ -0,0 +1,123 @@+{-# 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 ]|]