tramaj-hs 0.4.0.0 → 0.5.0.0

raw patch · 8 files changed

+543/−212 lines, 8 filesdep ~megaparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: megaparsec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +29/−0
• src/Tramaj/Ast.hs +153/−116
• src/Tramaj/Eval.hs +8/−4
• src/Tramaj/Parser.hs +260/−90
• test/unit/Tramaj/AnalysisSpec.hs +4/−0
• test/unit/Tramaj/CorpusSpec.hs +11/−1
• test/unit/Tramaj/ParserSpec.hs +76/−0
• tramaj-hs.cabal +2/−1

@@ -1,5 +1,34 @@ # Changelog +## 0.5.0.0 (2026-10-24)++**`?shape(key, shape)` allocates a structure of symbols** with one key and+one site (`../specs/v3-symbols.md` \S1.2, `../specs/decisions.md` \S19). Each+`~name` or `~name(e)` marker in the shape is a symbol `[key, "name"]` or+`[key, "name", e]` at the form's site, and `{~name}` is short for+`{name: ~name}`. It lowers at parse time, so the AST and the envelope are+unchanged. A marker outside a shape or in a key, a bare marker under a lambda+in the shape, a marker name used twice, a shape with no marker and a wrong+argument count are parse errors. New syntax, hence the minor bump; a program+that parsed before parses to the same AST. The corpus runner provides the+`shape` profile. New in `Tramaj.Ast`: `shapeKeyName` and `markerSite`.++**Breaking, symbolic mode only: a symbol or a term as the key of `has` or+`lookup` is `NotConcrete`** (`../specs/v3-symbols.md` \S1.5), where it+answered `false` or the fallback, reading an unknown key as a missing one. A+concrete key keeps the tolerant behaviour: a missing key, an out-of-range+index or a wrong-shaped container still answers `false` or the fallback.++**Parse errors point at the mistake.** An unclosed `(`, `[`, `{`, string or+interpolation used to be reported at line 1, column 1 (megaparsec's error+from wherever the outermost backtracking alternative started), whatever the+mistake. A `try` now covers only what tells a form from its alternatives,+never the form's body, so the error is reported where the closer was looked+for, and the closer names its opener and where it is: `expecting ')' to+close the '(' of .div at line 1, column 5`. Every program that parsed still+parses to the same AST; only the position and wording of errors change.+tramaj-purs has the same fix.+ ## 0.4.0.0  **Breaking: integers and floats are two number types** (`../specs/decisions.md`

@@ -41,9 +41,12 @@   , subExprs   , attributeExprs   , numberAllocs+  , shapeKeyName+  , markerSite   ) where  import Data.Int (Int64)+import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -152,7 +155,9 @@     -- being derived some other way. Assigned by 'numberAllocs' after     -- parsing, not by the parser itself, so that agreement between     -- implementations rests on one small pure function over the AST rather-    -- than on two parsers' internal traversal order.+    -- than on two parsers' internal traversal order. A @~name@ marker of a+    -- @?shape@ (decisions \S19) is one too, at its form's site+    -- ('shapeKeyName').     Alloc Int Expr   | -- | @?ctx.a.b@ (\S1.3): declares a context read symbolic. The path MUST     -- be rooted at @ctx@, which is why it is not just a 'Path' -- unlike an@@ -390,9 +395,27 @@ typeDecls :: [Stmt] -> [(Text, TypeExpr)] typeDecls stmts = [(n, t) | STypeDecl n t <- stmts] +-- | The hidden name a @?shape(key, shape)@ (v3-symbols \S1.2, decisions+-- \S19) binds its key to. The form lowers to @Let shapeKeyName key shape@,+-- with each marker in the shape an 'Alloc' whose key reads this name, so the+-- core AST needs no constructor of its own for it. It starts with @#@, so no+-- surface name can collide with it ('isHiddenName'), and only the parser+-- writes such a 'Let': 'numberAllocs' takes one as a @?shape@ site.+shapeKeyName :: Text+shapeKeyName = "#shape"++-- | The site a @~name@ marker carries between the parser and+-- 'numberAllocs', which replaces it with the site of the innermost enclosing+-- @?shape@. Never left in a parsed program: the parser refuses a marker+-- outside a shape.+markerSite :: Int+markerSite = -1+ -- | Assigns each 'Alloc' in a program the index of its @?(...)@ among all of -- them, in source order (v3-symbols \S1.4) -- a plain pre-order, left-to-right--- walk over the freshly parsed tree, numbering as it goes.+-- walk over the freshly parsed tree, numbering as it goes. A @?shape@ (its+-- 'shapeKeyName' 'Let') takes a number in the same sequence, at its @?@,+-- before its key; its markers take none, only its site. -- -- Done as a rewrite after parsing, rather than by a counter threaded through -- the parser itself, so that two independently written parsers agree on site@@ -405,122 +428,136 @@ -- produces -- attributes before value before children in an 'Element', -- condition before either arm in a 'Branch', and so on. numberAllocs :: Expr -> Expr-numberAllocs e = snd (go 0 e)+numberAllocs e = snd (numberIn Nothing 0 e)   where-    go :: Int -> Expr -> (Int, Expr)-    go n (Alloc _ key) =-      let (n', key') = go (n + 1) key-       in (n', Alloc n key')-    go n e'@(Path _ _) = (n, e')-    go n (FieldAccess target fields) =-      let (n', target') = go n target in (n', FieldAccess target' fields)-    go n (Call fn args) =-      let (n1, fn') = go n fn-          (n2, args') = goList n1 args-       in (n2, Call fn' args')-    go n (Lambda params body) = let (n', body') = go n body in (n', Lambda params body')-    go n (Let name value body) =-      let (n1, value') = go n value-          (n2, body') = go n1 body-       in (n2, Let name value' body')-    go n e'@(StringLit _) = (n, e')-    go n e'@(IntLit _) = (n, e')-    go n e'@(FloatLit _) = (n, e')-    go n e'@(BoolLit _) = (n, e')-    go n NullLit = (n, NullLit)-    go n (ArrayLit elems) = let (n', elems') = goList n elems in (n', ArrayLit elems')-    go n (ObjectLit entries) =-      let (n', entries') = goPairs n entries in (n', ObjectLit entries')-    go n (Element tag attrs val children) =-      let (n1, attrs') = goAttrs n attrs-          (n2, val') = go n1 val-          (n3, children') = goList n2 children-       in (n3, Element tag attrs' val' children')-    go n (Fragment children) = let (n', children') = goList n children in (n', Fragment children')-    go n (Branch c t e') =-      let (n1, c') = go n c-          (n2, t') = go n1 t-          (n3, e'') = go n2 e'-       in (n3, Branch c' t' e'')-    go n (Map coll fn) =-      let (n1, coll') = go n coll-          (n2, fn') = go n1 fn-       in (n2, Map coll' fn')-    go n (Filter coll fn) =-      let (n1, coll') = go n coll-          (n2, fn') = go n1 fn-       in (n2, Filter coll' fn')-    go n (Scan coll initial fn) =-      let (n1, coll') = go n coll-          (n2, initial') = go n1 initial-          (n3, fn') = go n2 fn-       in (n3, Scan coll' initial' fn')-    go n (Fold coll initial fn) =-      let (n1, coll') = go n coll-          (n2, initial') = go n1 initial-          (n3, fn') = go n2 fn-       in (n3, Fold coll' initial' fn')-    go n (SortBy descending coll fn) =-      let (n1, coll') = go n coll-          (n2, fn') = go n1 fn-       in (n2, SortBy descending coll' fn')-    go n (Concat l r) =-      let (n1, l') = go n l-          (n2, r') = go n1 r-       in (n2, Concat l' r')-    go n (Import name params) =-      let (n', params') = goParams n params in (n', Import name params')-    go n (AdaptActions target adaptation fn) =-      let (n1, target') = go n target-          (n2, fn') = case fn of-            Nothing -> (n1, Nothing)-            Just f -> let (n', f') = go n1 f in (n', Just f')-       in (n2, AdaptActions target' adaptation fn')-    go n (Constrain name args) = let (n', args') = goList n args in (n', Constrain name args')-    go n (Emit constraint body) =-      let (n1, constraint') = go n constraint-          (n2, body') = go n1 body-       in (n2, Emit constraint' body')-    go n e'@(Demand _) = (n, e')-    go n (TypeDecl name t body) = let (n', body') = go n body in (n', TypeDecl name t body')-    go n (TypeAnnotate name t value body) =-      let (n1, value') = go n value-          (n2, body') = go n1 body-       in (n2, TypeAnnotate name t value' body')-    go n (TypeEmit name tcArgs body) = let (n', body') = go n body in (n', TypeEmit name tcArgs body')+    -- | Numbers under the innermost enclosing @?shape@'s site, if any: a+    -- marker ('markerSite') takes that site, and no number of its own.+    numberIn :: Maybe Int -> Int -> Expr -> (Int, Expr)+    numberIn shape = go+      where+        go :: Int -> Expr -> (Int, Expr)+        go n (Alloc site key)+          | site == markerSite =+              let (n', key') = go n key+               in (n', Alloc (fromMaybe markerSite shape) key')+          | otherwise =+              let (n', key') = go (n + 1) key+               in (n', Alloc n key')+        go n e'@(Path _ _) = (n, e')+        go n (FieldAccess target fields) =+          let (n', target') = go n target in (n', FieldAccess target' fields)+        go n (Call fn args) =+          let (n1, fn') = go n fn+              (n2, args') = goList n1 args+           in (n2, Call fn' args')+        go n (Lambda params body) = let (n', body') = go n body in (n', Lambda params body')+        go n (Let name value body)+          | name == shapeKeyName =+              let (n1, value') = go (n + 1) value+                  (n2, body') = numberIn (Just n) n1 body+               in (n2, Let name value' body')+        go n (Let name value body) =+          let (n1, value') = go n value+              (n2, body') = go n1 body+           in (n2, Let name value' body')+        go n e'@(StringLit _) = (n, e')+        go n e'@(IntLit _) = (n, e')+        go n e'@(FloatLit _) = (n, e')+        go n e'@(BoolLit _) = (n, e')+        go n NullLit = (n, NullLit)+        go n (ArrayLit elems) = let (n', elems') = goList n elems in (n', ArrayLit elems')+        go n (ObjectLit entries) =+          let (n', entries') = goPairs n entries in (n', ObjectLit entries')+        go n (Element tag attrs val children) =+          let (n1, attrs') = goAttrs n attrs+              (n2, val') = go n1 val+              (n3, children') = goList n2 children+           in (n3, Element tag attrs' val' children')+        go n (Fragment children) = let (n', children') = goList n children in (n', Fragment children')+        go n (Branch c t e') =+          let (n1, c') = go n c+              (n2, t') = go n1 t+              (n3, e'') = go n2 e'+           in (n3, Branch c' t' e'')+        go n (Map coll fn) =+          let (n1, coll') = go n coll+              (n2, fn') = go n1 fn+           in (n2, Map coll' fn')+        go n (Filter coll fn) =+          let (n1, coll') = go n coll+              (n2, fn') = go n1 fn+           in (n2, Filter coll' fn')+        go n (Scan coll initial fn) =+          let (n1, coll') = go n coll+              (n2, initial') = go n1 initial+              (n3, fn') = go n2 fn+           in (n3, Scan coll' initial' fn')+        go n (Fold coll initial fn) =+          let (n1, coll') = go n coll+              (n2, initial') = go n1 initial+              (n3, fn') = go n2 fn+           in (n3, Fold coll' initial' fn')+        go n (SortBy descending coll fn) =+          let (n1, coll') = go n coll+              (n2, fn') = go n1 fn+           in (n2, SortBy descending coll' fn')+        go n (Concat l r) =+          let (n1, l') = go n l+              (n2, r') = go n1 r+           in (n2, Concat l' r')+        go n (Import name params) =+          let (n', params') = goParams n params in (n', Import name params')+        go n (AdaptActions target adaptation fn) =+          let (n1, target') = go n target+              (n2, fn') = case fn of+                Nothing -> (n1, Nothing)+                Just f -> let (n', f') = go n1 f in (n', Just f')+           in (n2, AdaptActions target' adaptation fn')+        go n (Constrain name args) = let (n', args') = goList n args in (n', Constrain name args')+        go n (Emit constraint body) =+          let (n1, constraint') = go n constraint+              (n2, body') = go n1 body+           in (n2, Emit constraint' body')+        go n e'@(Demand _) = (n, e')+        go n (TypeDecl name t body) = let (n', body') = go n body in (n', TypeDecl name t body')+        go n (TypeAnnotate name t value body) =+          let (n1, value') = go n value+              (n2, body') = go n1 body+           in (n2, TypeAnnotate name t value' body')+        go n (TypeEmit name tcArgs body) = let (n', body') = go n body in (n', TypeEmit name tcArgs body') -    goList :: Int -> [Expr] -> (Int, [Expr])-    goList n [] = (n, [])-    goList n (x : xs) =-      let (n1, x') = go n x-          (n2, xs') = goList n1 xs-       in (n2, x' : xs')+        goList :: Int -> [Expr] -> (Int, [Expr])+        goList n [] = (n, [])+        goList n (x : xs) =+          let (n1, x') = go n x+              (n2, xs') = goList n1 xs+           in (n2, x' : xs') -    goPairs :: Int -> [(Text, Expr)] -> (Int, [(Text, Expr)])-    goPairs n [] = (n, [])-    goPairs n ((k, x) : xs) =-      let (n1, x') = go n x-          (n2, xs') = goPairs n1 xs-       in (n2, (k, x') : xs')+        goPairs :: Int -> [(Text, Expr)] -> (Int, [(Text, Expr)])+        goPairs n [] = (n, [])+        goPairs n ((k, x) : xs) =+          let (n1, x') = go n x+              (n2, xs') = goPairs n1 xs+           in (n2, (k, x') : xs') -    goAttrs :: Int -> [Attribute] -> (Int, [Attribute])-    goAttrs n [] = (n, [])-    goAttrs n (Attr name x : xs) =-      let (n1, x') = go n x-          (n2, xs') = goAttrs n1 xs-       in (n2, Attr name x' : xs')-    goAttrs n (ActionAttr ev key x : xs) =-      let (n1, x') = go n x-          (n2, xs') = goAttrs n1 xs-       in (n2, ActionAttr ev key x' : xs')+        goAttrs :: Int -> [Attribute] -> (Int, [Attribute])+        goAttrs n [] = (n, [])+        goAttrs n (Attr name x : xs) =+          let (n1, x') = go n x+              (n2, xs') = goAttrs n1 xs+           in (n2, Attr name x' : xs')+        goAttrs n (ActionAttr ev key x : xs) =+          let (n1, x') = go n x+              (n2, xs') = goAttrs n1 xs+           in (n2, ActionAttr ev key x' : xs') -    goParams :: Int -> [(Text, ParamValue)] -> (Int, [(Text, ParamValue)])-    goParams n [] = (n, [])-    goParams n ((k, PExpr x) : xs) =-      let (n1, x') = go n x-          (n2, xs') = goParams n1 xs-       in (n2, (k, PExpr x') : xs')-    goParams n ((k, p@(PFromContext _)) : xs) =-      let (n1, xs') = goParams n xs in (n1, (k, p) : xs')-    goParams n ((k, p@(PType _)) : xs) =-      let (n1, xs') = goParams n xs in (n1, (k, p) : xs')+        goParams :: Int -> [(Text, ParamValue)] -> (Int, [(Text, ParamValue)])+        goParams n [] = (n, [])+        goParams n ((k, PExpr x) : xs) =+          let (n1, x') = go n x+              (n2, xs') = goParams n1 xs+           in (n2, (k, PExpr x') : xs')+        goParams n ((k, p@(PFromContext _)) : xs) =+          let (n1, xs') = goParams n xs in (n1, (k, p) : xs')+        goParams n ((k, p@(PType _)) : xs) =+          let (n1, xs') = goParams n xs in (n1, (k, p) : xs')

@@ -1346,12 +1346,14 @@      -- | Deliberately tolerant: a missing key, an out-of-range index, or a     -- container of the wrong shape all answer @false@ rather than erroring-    -- -- except a symbolic container, which is 'NotConcrete' rather than a-    -- lie (v3-symbols \S1.5): the tolerant @false@ would claim to know-    -- something about a container the language cannot see into.+    -- -- except a symbolic container or key, which is 'NotConcrete' rather+    -- than a lie (v3-symbols \S1.5): the tolerant @false@ would claim to+    -- know something about a value the language cannot see into.     hasImpl :: Value' -> Value' -> Either EvalError Value'     hasImpl (VSymbol _ _) _ = Left (NotConcrete name)     hasImpl (VTerm _ _) _ = Left (NotConcrete name)+    hasImpl _ (VSymbol _ _) = Left (NotConcrete name)+    hasImpl _ (VTerm _ _) = Left (NotConcrete name)     hasImpl container key = Right . VBool $ case (container, key) of       (VObject o, VString k) -> Map.member k o       (VArray xs, VInt n) -> maybe False (\i -> i < length xs) (asIndex n)@@ -1359,11 +1361,13 @@      -- | Dynamic access by a computed key or index -- the counterpart to a     -- static path segment. The third argument is the mandatory fallback. A-    -- symbolic container is 'NotConcrete' rather than falling back, which+    -- symbolic container or key is 'NotConcrete' rather than falling back, which     -- would silently discard the symbol (\S1.5).     lookupImpl :: Value' -> Value' -> Value' -> Either EvalError Value'     lookupImpl (VSymbol _ _) _ _ = Left (NotConcrete name)     lookupImpl (VTerm _ _) _ _ = Left (NotConcrete name)+    lookupImpl _ (VSymbol _ _) _ = Left (NotConcrete name)+    lookupImpl _ (VTerm _ _) _ = Left (NotConcrete name)     lookupImpl container key fallback = Right $ case (container, key) of       (VObject o, VString k) -> maybe fallback id (Map.lookup k o)       (VArray xs, VInt n) -> maybe fallback id (asIndex n >>= atIndex xs)

@@ -5,6 +5,8 @@ -- * string interpolation becomes 'Concat' over the @str@ builtin; -- * @branch(fallback, p1, v1, ...)@ becomes nested 'Branch'; -- * object shorthand @{foo}@ becomes @{"foo": $foo}@;+-- * @?shape(key, shape)@ becomes a 'Let' of its key and the shape, each+--   @~name@ marker in it an 'Alloc' at the form's one site; -- * escape sequences are resolved into the 'StringLit' they denote. -- -- The grammar keeps three leader characters from v1: @.@ introduces a@@ -24,6 +26,13 @@ --   @map@ has matched, its shape is parsed without backtracking, so a --   malformed one is a hard parse error instead of silently falling through --   to a meaningless 'Call' that would only fail much later at eval time.+--   The same holds for every form, not only the special ones: a 'try'+--   covers what tells a form from its alternatives (@name(@, @key:@,+--   @(params) =>@) and never the form's body. A 'try' around a body throws+--   away the error inside it, and the program is then reported as wrong at+--   wherever the outermost alternative started -- line 1, column 1 for an+--   unclosed bracket anywhere in a document. Each closer also names its+--   opener and where it is ('closing'). -- * A field-access suffix is parsed with no whitespace skipped before it, so --   @f().rendered@ is a field access while @f()@ followed by a newline and --   @.div(...)@ is two separate things.@@ -35,7 +44,7 @@ import Data.Char (chr, isAlphaNum, isDigit, isHexDigit, isLetter) import Data.Int (Int64) import Data.List (nub)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, maybeToList) import Data.Text (Text) import qualified Data.Text as T import Data.Void (Void)@@ -82,6 +91,50 @@ lexeme :: P a -> P a lexeme p = p <* skipSpaces +-- Unclosed openers ---------------------------------------------------------++-- | An opener that has been read -- a bracket, a quote, a backtick -- and+-- where it sits, so the closer that never comes can say which one it was.+--+-- The error for a missing closer is reported where the closer was looked+-- for (often the end of the input), and names the opener and its position:+-- @expecting ')' to close the '(' at line 1, column 5@. Without that, the+-- only position a reader got was wherever the outermost backtracking+-- alternative started, which for most programs is line 1, column 1.+data Opened = Opened String SourcePos++-- | Reads an opener with @p@, remembering where it started. @what@ is how+-- the closer's error names it: @'('@, @the string@, @the interpolation@.+opening :: String -> P a -> P Opened+opening what p = do+  pos <- getSourcePos+  _ <- p+  pure (Opened what pos)++-- | Reads the closer that matches an 'Opened', labelled with it.+closing :: Opened -> String -> P a -> P a+closing (Opened what pos) closer p =+  p <?> (closer <> " to close " <> what <> " at line " <> show (unPos (sourceLine pos)) <> ", column " <> show (unPos (sourceColumn pos)))++-- | The common case: a lexeme opener and its lexeme closer.+openSym :: Text -> P Opened+openSym o = opening ("the '" <> T.unpack o <> "'") (symbol o)++closeSym :: Opened -> Text -> P ()+closeSym opened c = () <$ closing opened ("'" <> T.unpack c <> "'") (symbol c)++-- | A closer read with no whitespace skipped after it, for the forms that+-- read a field-access suffix directly behind their @)@.+closeChar :: Opened -> Char -> P ()+closeChar opened c = () <$ closing opened ("'" <> [c] <> "'") (char c)++-- | Another item of a comma-separated list: a @,@ that is not the trailing+-- one before the closer @c@. Recognizing the comma this way, rather than+-- wrapping the comma /and the item/ in a 'try', is what keeps an error inside+-- the item where it happened instead of rewinding to the comma.+nextItem :: Char -> P ()+nextItem c = () <$ try (symbol "," <* notFollowedBy (char c))+ symbol :: Text -> P Text symbol s = lexeme (string s) @@ -135,9 +188,12 @@ -- whole point of the position being static is that it cannot be computed. staticString :: P Text staticString = lexeme $ do-  _ <- char '"'+  opened <- opening "the string" (char '"')   s <- takeWhileP Nothing (\c -> c /= '"' && c /= '`')-  _ <- char '"' <|> interpolationRefused+  next <- optional (lookAhead anySingle)+  case next of+    Just '`' -> interpolationRefused+    _ -> () <$ closing opened "'\"'" (char '"')   pure s   where     interpolationRefused =@@ -149,16 +205,20 @@ -- arbitrary expression. stringLit :: P Expr stringLit = lexeme $ do-  _ <- char '"'+  opened <- opening "the string" (char '"')   parts <- many stringPart-  _ <- char '"'+  _ <- closing opened "'\"'" (char '"')   pure (desugarString parts)   where     stringPart :: P StringPart     stringPart = interpPart <|> (SLit <$> litChunk)      interpPart :: P StringPart-    interpPart = SInterp <$> (char '`' *> expr <* char '`')+    interpPart = do+      opened <- opening "the interpolation" (char '`')+      e <- expr+      _ <- closing opened "'`'" (char '`')+      pure (SInterp e)      -- | A run of ordinary characters, with escape sequences resolved as they     -- are read. Stops at a closing quote or an interpolation's backtick;@@ -190,9 +250,9 @@     unicodeEscape :: P Text     unicodeEscape = do       _ <- char 'u'-      _ <- char '{'+      opened <- opening "the '{' of the unicode escape" (char '{')       digits <- takeWhile1P (Just "hex digit") isHexDigit-      _ <- char '}'+      _ <- closing opened "'}'" (char '}')       case readHex (T.unpack digits) of         [(n, "")] | n <= 0x10FFFF -> pure (T.singleton (chr n))         _ -> fail ("invalid unicode escape: \\u{" <> T.unpack digits <> "}")@@ -277,26 +337,34 @@  arrayLit :: P Expr arrayLit = lexeme $ do-  _ <- symbol "["+  opened <- openSym "["   elems <- sepEndBy expr (symbol ",")-  _ <- symbol "]"+  closeSym opened "]"   pure (ArrayLit elems)  -- | Object keys may be quoted or bare, and a bare key on its own is shorthand -- for reading the binding of the same name: @{foo, bar: $baz}@. objectLit :: P Expr objectLit = lexeme $ do-  _ <- symbol "{"+  opened <- openSym "{"   entries <- sepEndBy objEntry (symbol ",")-  _ <- symbol "}"+  closeSym opened "}"   pure (ObjectLit entries)   where     objEntry :: P (Text, Expr)-    objEntry = try explicitEntry <|> shorthandEntry+    objEntry = explicitEntry <|> markerEntry <|> shorthandEntry +    -- | @{~replicas}@ is @{replicas: ~replicas}@, and @{~host($x)}@ is+    -- @{host: ~host($x)}@ (v3-symbols \S1.2): the shorthand field of a+    -- marker, expanded here so every other rule sees the long form.+    markerEntry :: P (Text, Expr)+    markerEntry = marker++    -- The 'try' covers @key:@ only, which is what tells this from the+    -- shorthand; an error in the value is reported where it is.     explicitEntry :: P (Text, Expr)     explicitEntry = do-      k <- objectKey+      k <- try (objectKey <* lookAhead (symbol ":"))       _ <- reservedKeyRefused k       _ <- symbol ":"       v <- expr@@ -336,15 +404,97 @@ -- traversal order. A projection following it, as in @?(key).field@, is an -- ordinary field-access suffix, the same mechanism a call result uses. allocExpr :: P Expr-allocExpr = try $ do-  _ <- char '?'-  _ <- symbol "("+allocExpr = do+  opened <- try $ do+    _ <- char '?'+    openSym "("   keyExpr <- expr-  _ <- char ')'+  closeChar opened ')'   segs <- fieldAccessSuffix   skipSpaces   pure (applyFieldAccess (Alloc 0 keyExpr) segs) +-- | @?shape(key, shape)@ (v3-symbols \S1.2, decisions \S19): a structure of+-- symbols written with one key and one site. It lowers here, so the core AST+-- is unchanged: the key is bound once to the hidden 'shapeKeyName', and each+-- marker in the shape is already an 'Alloc' over @[$#shape, "name"]@ or+-- @[$#shape, "name", key]@ ('marker'). 'numberAllocs' then gives the form+-- one site and its markers that same site.+--+-- The 'try' covers @?shape(@ only; past it, the form is exactly two+-- arguments, and a malformed one is a parse error. So are the marker rules+-- the shape must keep ('checkShape') and a marker in the key.+shapeExpr :: P Expr+shapeExpr = do+  opened <- try $ do+    _ <- char '?'+    n <- rawIdent+    if n == "shape" then pure () else fail "not a ?shape form"+    openSym "("+  keyExpr <- expr+  if null (ownMarkers False keyExpr)+    then pure ()+    else fail "a marker cannot be written in a ?shape's key"+  _ <- symbol ","+  shape <- expr+  closeChar opened ')'+  checkShape shape+  segs <- fieldAccessSuffix+  skipSpaces+  pure (applyFieldAccess (Let shapeKeyName keyExpr shape) segs)++-- | The rules on a @?shape@'s own markers, all static: at least one, no name+-- twice (bare or keyed), and a key on every marker that sits under a lambda+-- inside the shape.+checkShape :: Expr -> P ()+checkShape shape+  | null markers = fail "a ?shape's shape must contain at least one marker of its own"+  | any (\(_, keyed, underLambda) -> underLambda && not keyed) markers =+      fail "a marker under a lambda inside a ?shape must carry a key, as in ~name(key)"+  | length (nub names) /= length names = fail "a marker name appears twice in one ?shape"+  | otherwise = pure ()+  where+    markers = ownMarkers False shape+    names = [n | (n, _, _) <- markers]++-- | @~name@ or @~name(key)@: a symbol marker, as the allocation it lowers to,+-- with 'markerSite' until 'numberAllocs' gives it its form's site. The name+-- follows the @~@ directly, and the @(@ of a key follows the name directly.+-- Parsed anywhere an expression is; the enclosing 'shapeExpr' (or, outside+-- any, 'noStrayMarker') decides whether it is legal there.+marker :: P (Text, Expr)+marker = lexeme $ do+  _ <- char '~'+  name <- rawIdent+  key <- optional $ do+    opened <- opening "the '('" (char '(')+    skipSpaces+    e <- expr+    closeChar opened ')'+    pure e+  pure (name, Alloc markerSite (ArrayLit ([Path shapeKeyName [], StringLit name] <> maybeToList key)))++markerExpr :: P Expr+markerExpr = snd <$> marker++-- | The markers that belong to the form whose shape (or key) this is: every+-- marker in it but those inside a nested @?shape@'s shape, as (name, keyed,+-- under a lambda written inside it).+ownMarkers :: Bool -> Expr -> [(Text, Bool, Bool)]+ownMarkers underLambda e = case e of+  Alloc site (ArrayLit (_ : StringLit name : rest))+    | site == markerSite -> (name, not (null rest), underLambda) : concatMap (ownMarkers underLambda) rest+  Let name value _+    | name == shapeKeyName -> ownMarkers underLambda value+  Lambda _ body -> ownMarkers True body+  _ -> concatMap (ownMarkers underLambda) (subExprs e)++-- | A marker belongs to a @?shape@'s shape; anywhere else it is a parse error.+noStrayMarker :: Expr -> P ()+noStrayMarker e+  | null (ownMarkers False e) = pure ()+  | otherwise = fail "a marker ~name may only be written inside a ?shape's shape"+ -- | @?ctx.a.b@ (\S1.3): the path MUST be rooted at @ctx@ -- unlike an -- ordinary read, an unsupplied demand allocates at the root rather than -- failing, so the language needs to tell the two apart before evaluating@@ -362,22 +512,26 @@ -- values (@$lib.vals.fn(1)@) or an import being given more parameters -- (@$deployment({...})@) is callable directly. call :: P Expr-call = try $ do-  _ <- optional (char '$')-  (root, fields) <- pathTail-  _ <- symbol "("+call = do+  ((root, fields), opened) <- try $ do+    _ <- optional (char '$')+    callee <- pathTail+    opened <- openSym "("+    pure (callee, opened)   args <- sepEndBy expr (symbol ",")-  _ <- char ')'+  closeChar opened ')'   segs <- fieldAccessSuffix   skipSpaces   pure (applyFieldAccess (Call (Path root fields) args) segs)  lambdaExpr :: P Expr-lambdaExpr = try $ do-  _ <- symbol "("-  params <- sepEndBy pattern (symbol ",")-  _ <- symbol ")"-  _ <- symbol "=>"+lambdaExpr = do+  params <- try $ do+    _ <- symbol "("+    params <- sepEndBy pattern (symbol ",")+    _ <- symbol ")"+    _ <- symbol "=>"+    pure params   lowerLambda params <$> expr  -- Binding patterns (decisions \S17) -------------------------------------------@@ -394,9 +548,9 @@  objectPattern :: P Pattern objectPattern = do-  _ <- symbol "{"+  opened <- openSym "{"   fields <- sepEndBy1 patternField (symbol ",")-  _ <- symbol "}"+  closeSym opened "}"   let pat = PObject fields       names = patternNames pat   if length (nub names) /= length names@@ -446,11 +600,14 @@  -- | Grouping, for readability where 'Concat' chains get long. Not a semantic -- construct: the parse tree it produces is the same as the inner expression's.+--+-- No 'try': 'lambdaExpr' is tried first, and nothing else starts with @(@,+-- so an error inside the parentheses is reported where it is. parenExpr :: P Expr-parenExpr = try $ do-  _ <- symbol "("+parenExpr = do+  opened <- openSym "("   e <- expr-  _ <- symbol ")"+  closeSym opened ")"   pure e  -- | The forms whose evaluation the language defines itself, rather than@@ -485,22 +642,22 @@   where     binaryShape :: (Expr -> Expr -> Expr) -> P Expr     binaryShape ctor = do-      _ <- symbol "("+      opened <- openSym "("       a <- expr       _ <- symbol ","       b <- expr-      _ <- char ')'+      closeChar opened ')'       pure (ctor a b)      ternaryShape :: (Expr -> Expr -> Expr -> Expr) -> P Expr     ternaryShape ctor = do-      _ <- symbol "("+      opened <- openSym "("       a <- expr       _ <- symbol ","       b <- expr       _ <- symbol ","       c <- expr-      _ <- char ')'+      closeChar opened ')'       pure (ctor a b c)      -- | @branch(fallback, p1, v1, p2, v2, ...)@ reads "if p1 then v1, else if@@ -508,11 +665,11 @@     -- laziness is the core constructor's rather than a rule of its own.     branchShape :: P Expr     branchShape = do-      _ <- symbol "("+      opened <- openSym "("       fallback <- expr-      arms <- many (try (symbol "," *> arm))+      arms <- many (nextItem ')' *> arm)       _ <- optional (symbol ",")-      _ <- char ')'+      closeChar opened ')'       pure (foldr (\(p, v) acc -> Branch p v acc) fallback arms)      arm :: P (Expr, Expr)@@ -528,11 +685,11 @@     -- signature for any name.     constraintShape :: P Expr     constraintShape = do-      _ <- symbol "("+      opened <- openSym "("       name <- staticString-      args <- many (try (symbol "," *> expr))+      args <- many (nextItem ')' *> expr)       _ <- optional (symbol ",")-      _ <- char ')'+      closeChar opened ')'       pure (Constrain name args)      -- | @import("name", {param: expr, other: ctx(path)})@. The name is a@@ -541,27 +698,26 @@     -- only here.     importShape :: P Expr     importShape = do-      _ <- symbol "("+      opened <- openSym "("       name <- staticString       _ <- symbol ","       params <- importParams-      _ <- char ')'+      closeChar opened ')'       pure (Import name params)      importParams :: P [(Text, ParamValue)]     importParams = do-      _ <- symbol "{"+      opened <- openSym "{"       entries <- sepEndBy paramEntry (symbol ",")-      _ <- symbol "}"+      closeSym opened "}"       pure entries      paramEntry :: P (Text, ParamValue)-    paramEntry = try explicitParam <|> shorthandParam+    paramEntry = explicitParam <|> shorthandParam      explicitParam :: P (Text, ParamValue)     explicitParam = do-      k <- objectKey-      _ <- symbol ":"+      k <- try (objectKey <* symbol ":")       v <- paramValue       pure (k, v) @@ -582,10 +738,10 @@         n <- identifier         _ <- lookAhead (char '(')         if n == ("ctx" :: Text) then pure n else fail "not a ctx(...) parameter"-      _ <- symbol "("+      opened <- openSym "("       (root, fields) <- pathTail       skipSpaces-      _ <- char ')'+      closeChar opened ')'       skipSpaces       pure (PFromContext (root : fields)) @@ -593,13 +749,13 @@     -- the event type and payload.     adaptActionsShape :: P Expr     adaptActionsShape = do-      _ <- symbol "("+      opened <- openSym "("       target <- expr       _ <- symbol ","       adaptation <- adaptationShape-      fn <- optional (try (symbol "," *> expr))+      fn <- optional (nextItem ')' *> expr)       _ <- optional (symbol ",")-      _ <- char ')'+      closeChar opened ')'       pure (AdaptActions target adaptation fn)      -- | Two forms only, never an arbitrary rewriting function: this is what@@ -611,9 +767,9 @@       case name of         "identity" -> pure Identity         "prefix" -> do-          _ <- symbol "("+          opened <- openSym "("           p <- staticString-          _ <- char ')'+          closeChar opened ')'           skipSpaces           pure (Prefix p)         _ -> fail "an action adaptation must be identity or prefix(\"...\")"@@ -682,16 +838,16 @@  typeArray :: P TypeExpr typeArray = do-  _ <- symbol "["+  opened <- openSym "["   t <- typeExpr-  _ <- symbol "]"+  closeSym opened "]"   pure (TArray t)  typeRecord :: P TypeExpr typeRecord = do-  _ <- symbol "{"+  opened <- openSym "{"   fields <- sepEndBy typeField (symbol ",")-  _ <- symbol "}"+  closeSym opened "}"   pure (TRecord fields)   where     -- | Unlike an ordinary object literal's 'objectKey', a field name here is@@ -772,15 +928,16 @@ -- @type-constraint(...)@ would otherwise parse as an ordinary call to an -- unbound name. typeEmission :: P Stmt-typeEmission = try $ do-  _ <- char '!'-  kw <- identifier-  if kw /= ("type-constraint" :: Text) then fail "not a !type-constraint" else pure ()-  _ <- symbol "("+typeEmission = do+  opened <- try $ do+    _ <- char '!'+    kw <- identifier+    if kw /= ("type-constraint" :: Text) then fail "not a !type-constraint" else pure ()+    openSym "("   name <- staticString-  args <- many (try (symbol "," *> typeConstraintArg))+  args <- many (nextItem ')' *> typeConstraintArg)   _ <- optional (symbol ",")-  _ <- char ')'+  closeChar opened ')'   skipSpaces   pure (STypeEmit name args) @@ -790,36 +947,41 @@ -- it -- the same device 'keywordLit' uses -- which is what keeps @typeface = -- ...@ from being chopped into the keyword @type@ plus leftovers. typeDeclStmt :: P Stmt-typeDeclStmt = try $ do-  kw <- identifier-  if kw /= "type" then fail "not a type declaration" else pure ()-  name <- identifier-  _ <- symbol "="+typeDeclStmt = do+  name <- try $ do+    kw <- identifier+    if kw /= "type" then fail "not a type declaration" else pure ()+    name <- identifier+    _ <- symbol "="+    pure name   STypeDecl name <$> typeExpr  -- Documents ---------------------------------------------------------------  -- | @.tag(...)@ is an element; @.(...)@ is a fragment -- a tagless element, -- introducing siblings with no wrapper.+--+-- No 'try': nothing else an operand can be starts with @.@, so once it is+-- read this is a document, and an error inside it is reported where it is. documentExpr :: P Expr-documentExpr = try $ do+documentExpr = do   _ <- char '.'   choice [fragmentShape, elementShape]   where     fragmentShape :: P Expr     fragmentShape = do-      _ <- symbol "("+      opened <- openSym "("       children <- sepEndBy expr (symbol ",")-      _ <- symbol ")"+      closeSym opened ")"       pure (Fragment children)      elementShape :: P Expr     elementShape = do       tag <- rawIdent       skipSpaces-      _ <- symbol "("+      opened <- opening ("the '(' of ." <> T.unpack tag) (symbol "(")       args <- sepEndBy elementArg (symbol ",")-      _ <- symbol ")"+      closeSym opened ")"       buildElement tag args  -- | Buckets an element's arguments and enforces the one ordering rule:@@ -848,7 +1010,7 @@ elementArg :: P ElementArg elementArg =   attributePositionArg-    <|> (EArgAttr <$> try namedArg)+    <|> (EArgAttr <$> namedArg)     <|> (EArgChild <$> expr)  -- | @action(...)@ and @value(...)@, the two forms that mean something only in@@ -881,28 +1043,29 @@ -- it. actionShape :: P Attribute actionShape = do-  _ <- symbol "("+  opened <- openSym "("   event <- staticString   _ <- symbol ","   key <- staticString   _ <- symbol ","   payload <- expr-  _ <- symbol ")"+  closeSym opened ")"   pure (ActionAttr event key payload)  -- | @value(expr)@ fills the element's value slot -- see "Tramaj.Node" for -- what a host does with it. valueShape :: P Expr valueShape = do-  _ <- symbol "("+  opened <- openSym "("   v <- expr-  _ <- symbol ")"+  closeSym opened ")"   pure v +-- The 'try' covers @name:@ only, which is what tells an attribute from a+-- child; an error in its value is reported where it is. namedArg :: P Attribute namedArg = do-  name <- objectKey-  _ <- symbol ":"+  name <- try (objectKey <* symbol ":")   Attr name <$> expr  -- Precedence ---------------------------------------------------------------@@ -912,7 +1075,7 @@ expr :: P Expr expr = do   first <- operand-  rest <- many (try (symbol "<>" *> operand))+  rest <- many (symbol "<>" *> operand)   pure (foldl Concat first rest)  -- | Alternatives are ordered so that a longer form is tried before a prefix of@@ -927,7 +1090,9 @@     <|> call     <|> pathExpr     <|> allocExpr+    <|> shapeExpr     <|> demandExpr+    <|> markerExpr     <|> documentExpr     <|> stringLit     <|> numberLit@@ -939,8 +1104,11 @@ -- | @\@name=expr@ or @\@name : T = expr@ (v4-types \S7), one per line. @\@@ -- leads a binding definition, mirroring @$@ leading a binding read; the -- optional @: T@ is what tells 'SLet' and 'SAnnotate' apart.+--+-- No 'try': nothing else starts with @\@@, so an error in a binding is+-- reported where it is rather than at the start of the line. binding :: P [Stmt]-binding = try $ do+binding = do   _ <- char '@'   pat <- pattern   case pat of@@ -958,7 +1126,7 @@ -- @$@ and @\@@. A statement position only -- it may not appear inside an -- expression, so there is no operand form for it. emission :: P Expr-emission = try $ do+emission = do   _ <- char '!'   expr @@ -983,11 +1151,13 @@       root <- expr       skipSpaces       eof-      let programBody = numberAllocs (stmts (concat statements) root)+      let body = stmts (concat statements) root+      noStrayMarker body+      let programBody = numberAllocs body       pure $ case root of         Element {} -> DocumentProgram programBody         Fragment {} -> DocumentProgram programBody         _ -> ExpressionProgram programBody  parseExpr :: Text -> Either (ParseErrorBundle Text Void) Expr-parseExpr = runParser (numberAllocs <$> (skipSpaces *> expr <* eof)) ""+parseExpr = runParser (numberAllocs <$> (skipSpaces *> expr <* eof >>= \e -> e <$ noStrayMarker e)) ""

@@ -181,6 +181,10 @@   it "finds a site inside a lambda" $     symbolSites (prog "map($ctx.xs, (x) => ?($x))") `shouldBe` Set.fromList [0] +  it "reports a ?shape's site once, whatever number of markers it holds, in one sequence with ?(k)" $+    symbolSites (prog "[?shape(\"o\", {~a, b: [~b, ~c(1)], i: ?shape(\"i\", {~d})}), ?(\"p\")]")+      `shouldBe` Set.fromList [0, 1, 2]+   it "is non-empty for a program that cannot serve as a library" $     symbolSites (prog "?(\"x\")") `shouldNotBe` Set.empty 

@@ -70,9 +70,16 @@ -- which is an option of each evaluation here ('optionsFromMeta'). @sort@, -- @format-number@ and @round@: transition tags for the two sort forms, the -- @format-number@ builtin and the tenth arithmetic name (decisions \S20).+-- @shape@: the @?shape(key, shape)@ form and its @~name@ markers (decisions+-- \S19). providedProfiles :: [Text]-providedProfiles = ["base", "int-float", "int64", "arithmetic", "sort", "format-number", "round"]+providedProfiles = ["base", "int-float", "int64", "arithmetic", "sort", "format-number", "round", "shape"] +-- | The profiles every port provides (@corpus/README.md@). A case naming one+-- that 'providedProfiles' lacks fails instead of being skipped.+requiredProfiles :: [Text]+requiredProfiles = ["int-float", "arithmetic"]+ -- | The profiles a case names that this port does not provide. missingProfiles :: CaseMeta -> [Text] missingProfiles = filter (`notElem` providedProfiles) . metaProfiles@@ -215,6 +222,9 @@   meta <- (readJsonFile (dir </> "meta.json") :: IO CaseMeta)   when (metaHasRequires meta) $     error (dir <> ": \"requires\" was replaced by \"profiles\" (corpus/README.md)")+  case filter (`elem` requiredProfiles) (missingProfiles meta) of+    [] -> pure ()+    required -> error (dir <> ": not provided, but required of every port: " <> T.unpack (T.intercalate ", " required))   if metaExpect meta == "analysis"     then do       -- The names are the keys of @analysis.json@, which holds no number, so

@@ -9,8 +9,10 @@ module Tramaj.ParserSpec (spec) where  import Data.Either (isLeft, isRight)+import Data.List (isInfixOf, isPrefixOf) import Data.Text (Text) import Test.Hspec+import Text.Megaparsec (errorBundlePretty) import Tramaj.Ast import Tramaj.Parser @@ -18,6 +20,7 @@ spec = do   acceptanceSpec   rejectionSpec+  unclosedSpec   commentSpec   desugaringSpec   programKindSpec@@ -101,6 +104,44 @@   rejects "a binding name ending in a hyphen" "@a-=1\n$a"   rejects "a tag ending in a hyphen" ".div-()" +-- | An unclosed bracket, quote or interpolation is reported where the+-- closer was looked for, and names the opener and where it is. Each case+-- gives the position the error must carry (@line:column@, as+-- 'errorBundlePretty' prints it first) and a part of its message.+--+-- Before, every one of these said line 1, column 1: the backtracking+-- alternatives that recognize a form wrapped the whole form, so the deep+-- error was dropped in favour of the alternative's starting point.+unclosedSpec :: Spec+unclosedSpec = describe "an unclosed opener" $ do+  failsAt "an element's parenthesis" ".div(\"x\"" "1:9" "')' to close the '(' of .div at line 1, column 5"+  failsAt+    "an element's parenthesis, over several lines"+    ".div(\n  .p(\"a\"),\n  .p(\"b\")\n"+    "4:1"+    "')' to close the '(' of .div at line 1, column 5"+  failsAt "a nested element's parenthesis" ".div(.p(\"a\", .span(\"b\"))" "1:25" "')' to close the '(' of .div at line 1, column 5"+  failsAt "a string" ".div(\"abc)" "1:11" "'\"' to close the string at line 1, column 6"+  failsAt "a string over several lines" ".div(class: \"x\n)" "2:2" "'\"' to close the string at line 1, column 13"+  failsAt "an interpolation" "\"a `$x" "1:7" "'`' to close the interpolation at line 1, column 4"+  failsAt "an interpolation the string closes first" ".div(\"a`$x\")" "1:11" "'`' to close the interpolation at line 1, column 8"+  failsAt "a call's parenthesis" "f(1, 2" "1:7" "')' to close the '(' at line 1, column 2"+  failsAt "a grouping parenthesis" "(1" "1:3" "')' to close the '(' at line 1, column 1"+  failsAt "an array" "[1, 2" "1:6" "']' to close the '[' at line 1, column 1"+  failsAt "an object" "{a: 1" "1:6" "'}' to close the '{' at line 1, column 1"+  failsAt "a special form's parenthesis" "map($xs, (x) => $x" "1:19" "')' to close the '(' at line 1, column 4"+  failsAt "a string in a branch arm" "branch($x, $p, \"abc" "1:20" "'\"' to close the string at line 1, column 16"+  failsAt "an array in a binding" "@x = 1\n@y = [1,\n$x" "3:3" "']' to close the '[' at line 2, column 6"+  failsAt "a static string" ".b(action(\"on-click\", \"save, {}))" "1:34" "'\"' to close the string at line 1, column 23"+  where+    failsAt :: String -> Text -> String -> String -> Spec+    failsAt name src pos msg = it name $ case parseProgram src of+      Right _ -> expectationFailure "parsed, but should not have"+      Left bundle -> do+        let rendered = errorBundlePretty bundle+        rendered `shouldSatisfy` ((pos <> ":") `isPrefixOf`)+        rendered `shouldSatisfy` (msg `isInfixOf`)+ -- | Comments: @--@ to the end of the line, single-line only. -- -- The load-bearing assertion is 'leavesNoTrace' -- a commented program and@@ -399,3 +440,38 @@   it "does not confuse !type-constraint with an ordinary !expr emission" $     parseProgram "!constraint(\"k\", 1)\ntrue"       `shouldBe` Right (ExpressionProgram (Emit (Constrain "k" [IntLit 1]) (BoolLit True)))++  -- v3-symbols \S1.2, decisions \S19: ?shape lowers at parse time.+  declares+    "?shape lowers to a hidden binding of its key and markers allocating at the form's one site"+    "?shape(\"d\", {~replicas, ports: [~http($x)]})"+    ( ExpressionProgram+        ( Let+            "#shape"+            (StringLit "d")+            ( ObjectLit+                [ ("replicas", Alloc 0 (ArrayLit [Path "#shape" [], StringLit "replicas"]))+                , ("ports", ArrayLit [Alloc 0 (ArrayLit [Path "#shape" [], StringLit "http", Path "x" []])])+                ]+            )+        )+    )++  declares+    "a ?(k) inside a shape takes the next site, after the form's own"+    "?shape(\"o\", [~a, ?(\"p\")])"+    ( ExpressionProgram+        ( Let+            "#shape"+            (StringLit "o")+            (ArrayLit [Alloc 0 (ArrayLit [Path "#shape" [], StringLit "a"]), Alloc 1 (StringLit "p")])+        )+    )++  rejects "a marker outside any shape" "[~a]"+  rejects "a marker in a ?shape's key" "?shape(~k, {~a})"+  rejects "a bare marker under a lambda inside the shape" "?shape(\"d\", map($xs, (x) => ~a))"+  rejects "a duplicate marker name, bare and keyed" "?shape(\"d\", [~a, map($xs, (x) => ~a($x))])"+  rejects "a shape with no marker" "?shape(\"d\", {a: 1})"+  rejects "?shape with three arguments" "?shape(\"d\", {~a}, 1)"+  rejects "a space after the marker leader" "?shape(\"d\", ~ a)"

@@ -1,6 +1,6 @@ cabal-version:      3.4 name:               tramaj-hs-version:            0.4.0.0+version:            0.5.0.0 synopsis:           Haskell parser/AST/evaluator for the tramaj language description:   Parser, AST and evaluator for the tramaj language specified in@@ -81,6 +81,7 @@     , directory     , filepath     , hspec        >=2.11+    , megaparsec     , tramaj-hs     , text     , vector