bricks-parsec-0.0.0.4: src/Bricks/Parsec.hs
{-# 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.Parsec
(
-- * Expressions
parse'expression
, parse'expression'paren
, parse'expression'antiquote
, parse'expression'dictKey
-- * Expression lists
, parse'expressionList
, parse'expressionList'1
, parse'expressionList'1'noDot
-- * Variables
, parse'var
-- * Strings
, parse'strUnquoted
, parse'strStatic
, parse'strStatic'quoted
, parse'strStatic'unquoted
, parse'str'dynamic
, 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
-- * Comments and whitespace
, parse'spaces
, parse'comment
, parse'comment'inline
, parse'comment'block
-- * Keywords
, parse'keyword
) where
-- Bricks
import Bricks.Expression
import Bricks.Keyword
import Bricks.Source
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)
-- Containers
import Data.Set (Set)
import qualified Data.Set as Set
-- Base
import Control.Monad (fail)
import Prelude (fromIntegral, succ)
-- $setup
--
-- ==== Doctest setup
--
-- >>> import Data.Foldable (length)
-- >>> import Text.Parsec (parseTest)
-- >>> import Prelude (putStrLn)
parse'position :: Parser SourcePosition
parse'position = do
x <- P.getPosition
pure SourcePosition
{ sourcePosition'line = fromIntegral $ P.sourceLine x
, sourcePosition'column = fromIntegral $ P.sourceColumn x
}
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 (void p)
where
p =
-- 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'canBeUnquoted) *>
-- As usual, consume trailing spaces.
parse'spaces
{- | Parser for an unquoted string. Unquoted strings are restricted to a
conservative set of characters, and they may not be any of the keywords. See
'text'canBeUnquoted' for a complete description of the unquoted string rules. -}
-- | ==== Examples
--
-- >>> parseTest parse'strUnquoted "abc"
-- ("abc",1:1-1:4)
--
-- Here the parser consumes letters up to but not including @{@, because that
-- character does not satisfy 'char'canBeUnquoted':
--
-- >>> parseTest parse'strUnquoted "ab{c"
-- ("ab",1:1-1:3)
--
-- \"let\" does not parse as an unquoted string because @let@ is a keyword:
--
-- >>> parseTest parse'strUnquoted "let"
-- parse error at (line 1, column 4):
-- unexpected end of input
--
-- This parser does /not/ parse quoted strings:
--
-- >>> parseTest parse'strUnquoted "\"abc\""
-- parse error at (line 1, column 1):
-- unexpected "\""
parse'strUnquoted :: Parser (UnquotedString, SourceRange)
parse'strUnquoted = do
pos'1 <- parse'position
text <- P.many1 (P.satisfy char'canBeUnquoted) <&> Text.pack
pos'2 <- parse'position
-- Fail if what we just parsed isn't a valid unquoted string
case unquotedString'try text of
Nothing -> P.parserZero
Just b -> do
_ <- parse'spaces
pure (b, SourceRange pos'1 pos'2)
parse'var :: Parser Var
parse'var = do
(a, b) <- parse'strUnquoted
pure $ Var a (Just b)
{- | Parser for a static string which may be either quoted or unquoted. -}
-- | ==== Examples
--
-- >>> parseTest parse'strStatic "\"hello\""
-- {- 1:1-1:8 -} "hello"
--
-- >>> parseTest parse'strStatic "hello"
-- {- 1:1-1:6 -} "hello"
--
-- >>> parseTest parse'strStatic "\"a b\""
-- {- 1:1-1:6 -} "a b"
--
-- >>> parseTest parse'strStatic "a b"
-- {- 1:1-1:2 -} "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 =
do
pos'1 <- parse'position
_ <- P.char '"'
Str'Static text _ <- parse'str'within'normalQ
_ <- P.char '"' <|> anti
pos'2 <- parse'position
_ <- parse'spaces
let src = Just (SourceRange pos'1 pos'2)
pure $ Str'Static text src
where
anti = do
_ <- 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 = do
(a, b) <- parse'strUnquoted
pure $ Str'Static (unquotedString'text a) (Just b)
{- | Parser for a dynamic string enclosed in quotes (@"@ ... @"@). -}
parse'str'dynamic :: Parser Str'Dynamic
parse'str'dynamic =
do
pos'1 <- parse'position
_ <- P.char '"'
xs <- go Seq.empty
pos'2 <- parse'position
_ <- parse'spaces
let src = Just (SourceRange pos'1 pos'2)
pure $ Str'Dynamic xs src
where
go :: Seq Str'1 -> Parser (Seq Str'1)
go previousParts =
asum
[ do
_ <- P.char '"'
pure previousParts
, do
x <- lit <|> (parse'expression'antiquote <&> Str'1'Antiquote)
go $ previousParts |> x
]
-- Read some literal characters
lit :: Parser Str'1
lit = parse'str'within'normalQ <&> Str'1'Literal
{- | 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 Str'Static
parse'str'within'normalQ =
do
pos'1 <- parse'position
t <- text
pos'2 <- parse'position
let src = Just (SourceRange pos'1 pos'2)
pure $ Str'Static t src
where
text :: Parser Text
text = P.many1 (char <|> parse'str'escape'normalQ) <&> Text.concat
char :: Parser Text
char = asum
[ P.satisfy (\x -> x /= '$' && x /= '"' && x /= '\\')
, P.try $ P.char '$' <* P.notFollowedBy (P.char '{')
] <&> Text.singleton
parse'str'escape'normalQ :: Parser Text
parse'str'escape'normalQ =
P.char '\\' *> esc
where
esc = 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. Therefore the only way
to express @''@ or @${@ within an indented string is to antiquote them. -}
-- | ==== Examples
--
-- >>> x = "''${\"''\"} and ${\"\\${\"}''"
--
-- >>> putStrLn x
-- ''${"''"} and ${"\${"}''
--
-- >>> parseTest (inStr'discardSource <$> parse'inStr) x
-- str'indented [indent 0 [antiquote (str ["''"]), " and ", antiquote (str ["${"])] Nothing]
--
-- >>> parseTest parse'inStr x
-- {- 1:1-1:25 -} str'indented [indent {- 1:3-1:3 -} 0 [antiquote ({- 1:5-1:9 -} str [{- 1:6-1:8 -} "''"]), {- 1:10-1:15 -} " and ", antiquote ({- 1:17-1:22 -} str [{- 1:18-1:21 -} "${"])] Nothing]
parse'inStr :: Parser InStr
parse'inStr =
do
pos'1 <- parse'position
_ <- P.string "''"
lines <- go Seq.empty
pos'2 <- parse'position
_ <- parse'spaces
let src = Just (SourceRange pos'1 pos'2)
pure $ InStr lines src
where
go :: Seq InStr'1 -> Parser (Seq InStr'1)
go previousLines =
do
x <- parse'inStr'1
let newLines = previousLines |> x
if isJust (inStr'1'lineBreak x)
then go newLines
else P.string "''" $> newLines
{- | Parser for a single line of an 'InStr'. -}
parse'inStr'1 :: Parser InStr'1
parse'inStr'1 =
do
pos'1 <- parse'position
n <- parse'count (P.char ' ')
pos'2 <- parse'position
(str, break) <- go Seq.empty
pure InStr'1
{ inStr'1'level = n
, inStr'1'indentSource = Just (SourceRange pos'1 pos'2)
, inStr'1'str = str
, inStr'1'lineBreak = break
}
where
go :: Seq Str'1 -> Parser (Seq Str'1, Maybe Str'Static)
go previousParts =
asum
[ do
break <- end
pure (previousParts, break)
, do
x <- chars
go (previousParts |> x)
, do
x <- parse'expression'antiquote
go (previousParts |> Str'1'Antiquote x)
]
end :: Parser (Maybe Str'Static)
end = asum
[ do
end'pos'1 <- parse'position
s <- P.char '\n'
end'pos'2 <- parse'position
pure $ Just $ Str'Static
{ str'static'text = Text.singleton s
, str'static'source = Just (SourceRange end'pos'1 end'pos'2)
}
, do
_ <- P.lookAhead . P.try $ P.string "''"
pure Nothing
]
chars :: Parser Str'1
chars = do
chars'pos'1 <- parse'position
s <- 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 '\'')
]
chars'pos'2 <- parse'position
pure $ Str'1'Literal $ Str'Static
{ str'static'text = Text.pack s
, str'static'source = Just (SourceRange chars'pos'1 chars'pos'2)
}
{- | 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'var <* 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 Set.empty
where
-- We keep track of what we've parsed so far in two forms:
go :: Seq DictPattern'1 -- 1. A sequence of items (which will be
-- included directly in the result)
-> Set Text -- 2. A set of the names of the items (which is
-- used to test each new item so we can issue
-- an error message if the list contains two
-- items having the same name)
-> Parser DictPattern
go previousItems previousNames =
asum
[ end $> DictPattern previousItems False
, ellipsis $> DictPattern previousItems True
, more
]
where
more :: Parser DictPattern
more = item >>= \newItem ->
let
newName = var'text (dictPattern'1'name newItem)
newItems = previousItems |> newItem
newNames = Set.insert newName previousNames
in
if newName `Set.member` previousNames
then fail $ "Name " <> Text.unpack newName <>
" appears twice in a dict pattern"
else asum
[ P.char ',' *> parse'spaces *> go newItems newNames
, end $> DictPattern newItems False
]
item :: Parser DictPattern'1
item = DictPattern'1 <$> parse'var <*> P.optionMaybe def
def :: Parser Expression
def = P.char '?' *> parse'spaces *> parse'expression
ellipsis :: Parser ()
ellipsis = P.string "..." *> parse'spaces *> end
end :: Parser ()
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@). -}
-- | ==== Examples
--
-- >>> test = parseTest (lambda'discardSource <$> parse'lambda)
--
-- >>> test "x: [x x \"a\"]"
-- lambda (param "x") (list [var "x", var "x", str ["a"]])
--
-- >>> test "{a,b}:a"
-- lambda (pattern [dict'param "a", dict'param "b"]) (var "a")
--
-- >>> test "{ ... }: \"x\""
-- lambda (pattern [] <> ellipsis) (str ["x"])
--
-- >>> test "a@{ f, b ? g x, ... }: f b"
-- lambda (param "a" <> pattern [dict'param "f", dict'param "b" & def (apply (var "g") (var "x"))] <> ellipsis) (apply (var "f") (var "b"))
--
-- >>> test "a: b: \"x\""
-- lambda (param "a") (lambda (param "b") (str ["x"]))
parse'lambda :: Parser Lambda
parse'lambda = do
pos'1 <- parse'position
head <- parse'param
body <- parse'expression
let pos'2 = sourceRange'end <$> expression'source body
let src = SourceRange pos'1 <$> pos'2
pure $ Lambda head body src
{- | Parser for a list expression (@[ ... ]@). -}
-- | ==== Examples
--
-- >>> parseTest parse'list "[]"
-- {- 1:1-1:3 -} list []
--
-- >>> :{
-- >>> parseTest (list'discardSource <$> 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 =
do
pos'1 <- parse'position
_ <- P.char '['
_ <- parse'spaces
x <- parse'expressionList
_ <- P.char ']'
pos'2 <- parse'position
_ <- parse'spaces
let src = (Just (SourceRange pos'1 pos'2))
pure $ List (Seq.fromList x) src
{- | Parser for a dict expression, either recursive (@rec@ keyword) or not. -}
-- | ==== Examples
--
-- >>> parseTest parse'dict "{}"
-- {- 1:1-1:3 -} dict []
--
-- >>> parseTest parse'dict "rec { }"
-- {- 1:1-1:8 -} rec'dict []
--
-- >>> :{
-- >>> parseTest (dict'discardSource <$> parse'dict)
-- >>> "{ a = b; inherit (x) y z \"s t\"; }"
-- >>> :}
-- dict [dict'eq (str ["a"]) (var "b"), dict'inherit'from (var "x") ["y", "z", "s t"]]
parse'dict :: Parser Dict
parse'dict =
parse'dict'noRec <|> parse'dict'rec
{- | Parser for a recursive (@rec@ keyword) dict. -}
-- | ==== Examples
--
-- >>> parseTest parse'dict'rec "rec { }"
-- {- 1:1-1:8 -} rec'dict []
--
-- >>> :{
-- >>> parseTest (dict'discardSource <$> parse'dict'rec)
-- >>> "rec { a = \"1\"; b = \"${a}2\"; }"
-- >>> :}
-- rec'dict [dict'eq (str ["a"]) (str ["1"]), dict'eq (str ["b"]) (str [antiquote (var "a"), "2"])]
parse'dict'rec :: Parser Dict
parse'dict'rec =
do
pos'1 <- parse'position
_ <- parse'keyword keyword'rec
Dict _ xs src' <- parse'dict'noRec
let src = src' <&> \s -> s{ sourceRange'start = pos'1 }
pure $ Dict True xs src
{- | Parser for a non-recursive (no @rec@ keyword) dict. -}
-- | ==== Examples
--
-- >>> parseTest parse'dict'noRec "{ }"
-- {- 1:1-1:4 -} dict []
--
-- >>> :{
-- >>> parseTest (dict'discardSource <$> parse'dict'noRec)
-- >>> "{ a = \"1\"; b = \"${a}2\"; }"
-- >>> :}
-- dict [dict'eq (str ["a"]) (str ["1"]), dict'eq (str ["b"]) (str [antiquote (var "a"), "2"])]
parse'dict'noRec :: Parser Dict
parse'dict'noRec =
do
pos'1 <- parse'position
_ <- P.char '{'
_ <- parse'spaces
xs <- go Seq.empty
pos'2 <- parse'position
_ <- parse'spaces
let src = Just (SourceRange pos'1 pos'2)
pure $ Dict False xs src
where
go :: Seq DictBinding -> Parser (Seq DictBinding)
go previousBindings =
asum
[ do
_ <- P.char '}'
pure previousBindings
, do
a <- parse'dictBinding
go (previousBindings |> a)
]
{- | Parser for a chain of dict lookups (like @.a.b.c@) on the right-hand side
of a 'Dot' expression. -}
-- | ==== Examples
--
-- >>> parseTest parse'dot'rhs'chain ""
-- []
--
-- >>> parseTest parse'dot'rhs'chain ".abc"
-- [{- 1:2-1:5 -} str [{- 1:2-1:5 -} "abc"]]
--
-- >>> :{
-- >>> parseTest (fmap expression'discardSource <$> 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 dot
where
dot = do
_ <- P.char '.'
_ <- parse'spaces
x <- parse'expression'dictKey
_ <- parse'spaces
pure x
parse'let :: Parser Let
parse'let =
do
pos'1 <- parse'position
_ <- parse'keyword keyword'let
(xs, e) <- go Seq.empty
let
src = do
pos'2 <- sourceRange'end <$> expression'source e
pure $ SourceRange pos'1 pos'2
pure $ Let xs e src
where
go :: Seq LetBinding -> Parser (Seq LetBinding, Expression)
go previousBindings =
asum
[ do
_ <- parse'keyword keyword'in
e <- parse'expression
pure (previousBindings, e)
, do
a <- parse'letBinding
go (previousBindings |> a)
]
parse'dictBinding :: Parser DictBinding
parse'dictBinding =
parse'dictBinding'inherit <|> parse'dictBinding'eq
parse'dictBinding'inherit :: Parser DictBinding
parse'dictBinding'inherit =
do
_ <- parse'keyword keyword'inherit
asum
[ do
a <- parse'expression'paren
xs <- go'strs Seq.empty
pure $ DictBinding'Inherit'Dict a xs
, do
xs <- go'vars Seq.empty
pure $ DictBinding'Inherit'Var xs
]
where
go'strs :: Seq Str'Static -> Parser (Seq Str'Static)
go'strs previousList =
asum
[ do
_ <- P.char ';'
_ <- parse'spaces
pure previousList
, do
x <- parse'strStatic
go'strs (previousList |> x)
]
go'vars :: Seq Var -> Parser (Seq Var)
go'vars previousList =
asum
[ do
_ <- P.char ';'
_ <- parse'spaces
pure previousList
, do
x <- parse'var
go'vars (previousList |> x)
]
parse'dictBinding'eq :: Parser DictBinding
parse'dictBinding'eq =
do
key <- parse'expression'dictKey
_ <- parse'spaces
_ <- P.char '='
_ <- parse'spaces
val <- parse'expression
_ <- parse'spaces
_ <- P.char ';'
_ <- parse'spaces
pure $ DictBinding'Eq key val
parse'letBinding :: Parser LetBinding
parse'letBinding =
parse'letBinding'inherit <|> parse'letBinding'eq
parse'letBinding'eq :: Parser LetBinding
parse'letBinding'eq =
do
key <- parse'var
_ <- parse'spaces
_ <- P.char '='
_ <- parse'spaces
val <- parse'expression
_ <- parse'spaces
_ <- P.char ';'
_ <- parse'spaces
pure $ LetBinding'Eq key val
parse'letBinding'inherit :: Parser LetBinding
parse'letBinding'inherit =
do
_ <- parse'keyword keyword'inherit
a <- parse'expression'paren
xs <- go Seq.empty
pure $ LetBinding'Inherit a xs
where
go :: Seq Var -> Parser (Seq Var)
go previousList =
asum
[ do
_ <- P.char ';'
_ <- parse'spaces
pure previousList
, do
x <- parse'var
go (previousList |> x)
]
{- | The primary, top-level expression parser. This is what you use to parse a
@.nix@ file. -}
-- | ==== Examples
--
-- >>> 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'lambda <&> Expr'Lambda
, list
]
list = 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@). -}
-- | ==== Examples
--
-- >>> 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. -}
-- | ==== Examples
--
-- >>> parseTest parse'expressionList'1 "ab.xy"
-- {- 1:1-1:6 -} dot ({- 1:1-1:3 -} var "ab") ({- 1:4-1:6 -} str [{- 1:4-1:6 -} "xy"])
--
-- >>> :{
-- >>> parseTest (expression'discardSource <$> parse'expressionList'1)
-- >>> "(x: f x x) y z"
-- >>> :}
-- lambda (param "x") (apply (apply (var "f") (var "x")) (var "x"))
--
-- >>> :{
-- >>> parseTest (expression'discardSource <$> parse'expressionList'1)
-- >>> "{ a = b; }.a y"
-- >>> :}
-- dot (dict [dict'eq (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'. -}
-- | ==== Examples
--
-- >>> parseTest parse'expressionList'1'noDot "ab.xy"
-- {- 1:1-1:3 -} var "ab"
--
-- >>> :{
-- >>> parseTest (expression'discardSource <$> parse'expressionList'1'noDot)
-- >>> "(x: f x x) y z"
-- >>> :}
-- lambda (param "x") (apply (apply (var "f") (var "x")) (var "x"))
--
-- >>> :{
-- >>> parseTest (expression'discardSource <$> parse'expressionList'1'noDot)
-- >>> "{ a = b; }.a y"
-- >>> :}
-- dict [dict'eq (str ["a"]) (var "b")]
parse'expressionList'1'noDot :: Parser Expression
parse'expressionList'1'noDot =
asum
[ parse'str'dynamic <&> Expr'Str
, parse'inStr <&> Expr'Str'Indented
, parse'list <&> Expr'List
, parse'dict <&> Expr'Dict
, parse'var <&> 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
parse'expression'antiquote :: Parser Expression
parse'expression'antiquote =
P.try (P.string "${") *> parse'spaces *> parse'expression <* P.char '}'
{- | 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 =
quoted <|> antiquoted <|> unquoted
where
quoted :: Parser Expression
quoted = parse'str'dynamic <&> Expr'Str
antiquoted :: Parser Expression
antiquoted = do
_ <- P.string "${"
_ <- parse'spaces
e <- parse'expression
_ <- P.char '}'
_ <- parse'spaces
pure e
unquoted :: Parser Expression
unquoted = do
(x, src) <- parse'strUnquoted
pure $ Expr'Str $ str'static'to'dynamic $
Str'Static (unquotedString'text x) (Just src)
parse'count :: Parser a -> Parser Natural
parse'count p =
go 0
where
go :: Natural -> Parser Natural
go n = (p *> go (succ n)) <|> pure n