{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Dhall.Parser.Expression where
import Control.Applicative (Alternative (..), liftA2, optional)
import Data.ByteArray.Encoding (Base (..))
import Data.Foldable (foldl')
import Data.Functor (void)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup (Semigroup (..))
import Data.Text (Text)
import Dhall.Src (Src (..))
import Dhall.Syntax
import Prelude hiding (const, pi)
import Text.Parser.Combinators (choice, try, (<?>))
import qualified Control.Monad
import qualified Control.Monad.Combinators.NonEmpty as Combinators.NonEmpty
import qualified Data.ByteArray.Encoding
import qualified Data.ByteString
import qualified Data.Char as Char
import qualified Data.List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Sequence
import qualified Data.Text
import qualified Data.Text.Encoding
import qualified Dhall.Crypto
import qualified Text.Megaparsec
import Dhall.Parser.Combinators
import Dhall.Parser.Token
getSourcePos :: Text.Megaparsec.MonadParsec e s m =>
m Text.Megaparsec.SourcePos
getSourcePos :: m SourcePos
getSourcePos =
m SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
Text.Megaparsec.getSourcePos
{-# INLINE getSourcePos #-}
getOffset :: Text.Megaparsec.MonadParsec e s m => m Int
getOffset :: m Int
getOffset = State s e -> Int
forall s e. State s e -> Int
Text.Megaparsec.stateOffset (State s e -> Int) -> m (State s e) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (State s e)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
Text.Megaparsec.getParserState
{-# INLINE getOffset #-}
setOffset :: Text.Megaparsec.MonadParsec e s m => Int -> m ()
setOffset :: Int -> m ()
setOffset Int
o = (State s e -> State s e) -> m ()
forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
Text.Megaparsec.updateParserState ((State s e -> State s e) -> m ())
-> (State s e -> State s e) -> m ()
forall a b. (a -> b) -> a -> b
$ \State s e
state ->
State s e
state
{ stateOffset :: Int
Text.Megaparsec.stateOffset = Int
o }
{-# INLINE setOffset #-}
src :: Parser a -> Parser Src
src :: Parser a -> Parser Src
src Parser a
parser = do
SourcePos
before <- Parser SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
(Text
tokens, a
_) <- Parser a -> Parser (Tokens Text, a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser a
parser
SourcePos
after <- Parser SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
Src -> Parser Src
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
before SourcePos
after Text
tokens)
srcAnd :: Parser a -> Parser (Src, a)
srcAnd :: Parser a -> Parser (Src, a)
srcAnd Parser a
parser = do
SourcePos
before <- Parser SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
(Text
tokens, a
x) <- Parser a -> Parser (Tokens Text, a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser a
parser
SourcePos
after <- Parser SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
(Src, a) -> Parser (Src, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
before SourcePos
after Text
tokens, a
x)
noted :: Parser (Expr Src a) -> Parser (Expr Src a)
noted :: Parser (Expr Src a) -> Parser (Expr Src a)
noted Parser (Expr Src a)
parser = do
SourcePos
before <- Parser SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
(Text
tokens, Expr Src a
e) <- Parser (Expr Src a) -> Parser (Tokens Text, Expr Src a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser (Expr Src a)
parser
SourcePos
after <- Parser SourcePos
forall e s (m :: * -> *). MonadParsec e s m => m SourcePos
getSourcePos
let src₀ :: Src
src₀ = SourcePos -> SourcePos -> Text -> Src
Src SourcePos
before SourcePos
after Text
tokens
case Expr Src a
e of
Note Src
src₁ Expr Src a
_ | Src -> Src -> Bool
laxSrcEq Src
src₀ Src
src₁ -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
e
Expr Src a
_ -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Src -> Expr Src a -> Expr Src a
forall s a. s -> Expr s a -> Expr s a
Note Src
src₀ Expr Src a
e)
completeExpression :: Parser a -> Parser (Expr Src a)
completeExpression :: Parser a -> Parser (Expr Src a)
completeExpression Parser a
embedded = Parser (Expr Src a)
completeExpression_
where
Parsers {Parser (Expr Src a)
importExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
..} = Parser a -> Parsers a
forall a. Parser a -> Parsers a
parsers Parser a
embedded
importExpression :: Parser a -> Parser (Expr Src a)
importExpression :: Parser a -> Parser (Expr Src a)
importExpression Parser a
embedded = Parser (Expr Src a)
importExpression_
where
Parsers {Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
importExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
completeExpression_ :: forall a. Parsers a -> Parser (Expr Src a)
..} = Parser a -> Parsers a
forall a. Parser a -> Parsers a
parsers Parser a
embedded
data Parsers a = Parsers
{ Parsers a -> Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
, Parsers a -> Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
}
parsers :: Parser a -> Parsers a
parsers :: Parser a -> Parsers a
parsers Parser a
embedded = Parsers :: forall a. Parser (Expr Src a) -> Parser (Expr Src a) -> Parsers a
Parsers {Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
importExpression_ :: Parser (Expr Src a)
completeExpression_ :: Parser (Expr Src a)
..}
where
completeExpression_ :: Parser (Expr Src a)
completeExpression_ = Parser ()
whitespace Parser () -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression Parser (Expr Src a) -> Parser () -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
expression :: Parser (Expr Src a)
expression =
Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted
( [Parser (Expr Src a)] -> Parser (Expr Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative0
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative1
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative2
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative3
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative4
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative5
]
) Parser (Expr Src a) -> String -> Parser (Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"expression"
where
alternative0 :: Parser (Expr Src a)
alternative0 = do
Parser ()
_lambda
Parser ()
whitespace
Parser ()
_openParens
Parser ()
whitespace
Text
a <- Parser Text
label
Parser ()
whitespace
Parser ()
_colon
Parser ()
nonemptyWhitespace
Expr Src a
b <- Parser (Expr Src a)
expression
Parser ()
whitespace
Parser ()
_closeParens
Parser ()
whitespace
Parser ()
_arrow
Parser ()
whitespace
Expr Src a
c <- Parser (Expr Src a)
expression
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Expr Src a -> Expr Src a -> Expr Src a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam Text
a Expr Src a
b Expr Src a
c)
alternative1 :: Parser (Expr Src a)
alternative1 = do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_if Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
Expr Src a
a <- Parser (Expr Src a)
expression
Parser ()
whitespace
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_then Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
Expr Src a
b <- Parser (Expr Src a)
expression
Parser ()
whitespace
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_else Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
Expr Src a
c <- Parser (Expr Src a)
expression
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a -> Expr s a -> Expr s a
BoolIf Expr Src a
a Expr Src a
b Expr Src a
c)
alternative2 :: Parser (Expr Src a)
alternative2 = do
let binding :: Parser (Binding Src a)
binding = do
Src
src0 <- Parser Src -> Parser Src
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_let Parser () -> Parser Src -> Parser Src
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
nonemptyWhitespace)
Text
c <- Parser Text
label
Src
src1 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace
Maybe (Maybe Src, Expr Src a)
d <- Parser (Maybe Src, Expr Src a)
-> Parser (Maybe (Maybe Src, Expr Src a))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do
Parser ()
_colon
Src
src2 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
nonemptyWhitespace
Expr Src a
e <- Parser (Expr Src a)
expression
Parser ()
whitespace
(Maybe Src, Expr Src a) -> Parser (Maybe Src, Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
src2, Expr Src a
e) )
Parser ()
_equal
Src
src3 <- Parser () -> Parser Src
forall a. Parser a -> Parser Src
src Parser ()
whitespace
Expr Src a
f <- Parser (Expr Src a)
expression
Parser ()
whitespace
Binding Src a -> Parser (Binding Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Src
-> Text
-> Maybe Src
-> Maybe (Maybe Src, Expr Src a)
-> Maybe Src
-> Expr Src a
-> Binding Src a
forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
src0) Text
c (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
src1) Maybe (Maybe Src, Expr Src a)
d (Src -> Maybe Src
forall a. a -> Maybe a
Just Src
src3) Expr Src a
f)
NonEmpty (Binding Src a)
as <- Parser (Binding Src a) -> Parser (NonEmpty (Binding Src a))
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NonEmpty.some1 Parser (Binding Src a)
binding
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_in Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
Expr Src a
b <- Parser (Expr Src a)
expression
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Binding Src a) -> Expr Src a -> Expr Src a
forall (f :: * -> *) s a.
Foldable f =>
f (Binding s a) -> Expr s a -> Expr s a
Dhall.Syntax.wrapInLets NonEmpty (Binding Src a)
as Expr Src a
b)
alternative3 :: Parser (Expr Src a)
alternative3 = do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_forall Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_openParens)
Parser ()
whitespace
Text
a <- Parser Text
label
Parser ()
whitespace
Parser ()
_colon
Parser ()
nonemptyWhitespace
Expr Src a
b <- Parser (Expr Src a)
expression
Parser ()
whitespace
Parser ()
_closeParens
Parser ()
whitespace
Parser ()
_arrow
Parser ()
whitespace
Expr Src a
c <- Parser (Expr Src a)
expression
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Expr Src a -> Expr Src a -> Expr Src a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi Text
a Expr Src a
b Expr Src a
c)
alternative4 :: Parser (Expr Src a)
alternative4 = do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_assert Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_colon)
Parser ()
nonemptyWhitespace
Expr Src a
a <- Parser (Expr Src a)
expression
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
Assert Expr Src a
a)
alternative5 :: Parser (Expr Src a)
alternative5 = do
Expr Src a
a0 <- Parser (Expr Src a)
applicationExpression
let (Parser (Expr Src a)
parseFirstOperatorExpression, Parser (Expr Src a)
parseOperatorExpression) =
Parser (Expr Src a) -> (Parser (Expr Src a), Parser (Expr Src a))
operatorExpression (Expr Src a -> Parser (Expr Src a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Src a
a0)
Expr Src a
a <- Parser (Expr Src a)
parseFirstOperatorExpression
Parser ()
whitespace
let alternative4A :: Parser (Expr Src a)
alternative4A = do
Parser ()
_arrow
Parser ()
whitespace
Expr Src a
b <- Parser (Expr Src a)
expression
Parser ()
whitespace
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Expr Src a -> Expr Src a -> Expr Src a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi Text
"_" Expr Src a
a Expr Src a
b)
let alternative4B :: Parser (Expr Src a)
alternative4B = do
Parser ()
_colon
Parser ()
nonemptyWhitespace
Expr Src a
b <- Parser (Expr Src a)
expression
case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
a of
ListLit Maybe (Expr Src a)
Nothing [] ->
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Expr Src a) -> Seq (Expr Src a) -> Expr Src a
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (Expr Src a -> Maybe (Expr Src a)
forall a. a -> Maybe a
Just Expr Src a
b) [])
Merge Expr Src a
c Expr Src a
d Maybe (Expr Src a)
Nothing ->
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Maybe (Expr Src a) -> Expr Src a
forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge Expr Src a
c Expr Src a
d (Expr Src a -> Maybe (Expr Src a)
forall a. a -> Maybe a
Just Expr Src a
b))
ToMap Expr Src a
c Maybe (Expr Src a)
Nothing ->
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Maybe (Expr Src a) -> Expr Src a
forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap Expr Src a
c (Expr Src a -> Maybe (Expr Src a)
forall a. a -> Maybe a
Just Expr Src a
b))
Expr Src a
_ -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src a
a Expr Src a
b)
let alternative4C :: Parser (Expr Src a)
alternative4C = do
case Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a
shallowDenote Expr Src a
a of
Equivalent{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
ImportAlt{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
BoolOr{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
NaturalPlus{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
TextAppend{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
ListAppend{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
BoolAnd{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
Combine{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
Prefer{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
CombineTypes{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
NaturalTimes{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
BoolEQ{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
BoolNE{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
App{} -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
Expr Src a
_ -> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Expr Src a -> Expr Src a]
bs <- Parser (Expr Src a -> Expr Src a)
-> Parser [Expr Src a -> Expr Src a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_with Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
NonEmpty Text
keys <- Parser Text -> Parser () -> Parser (NonEmpty Text)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
Combinators.NonEmpty.sepBy1 Parser Text
anyLabel (Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_dot) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)
Parser ()
whitespace
Parser ()
_equal
Parser ()
whitespace
Expr Src a
value <- Parser (Expr Src a)
parseOperatorExpression
(Expr Src a -> Expr Src a) -> Parser (Expr Src a -> Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr Src a
e -> Expr Src a -> NonEmpty Text -> Expr Src a -> Expr Src a
forall s a. Expr s a -> NonEmpty Text -> Expr s a -> Expr s a
With Expr Src a
e NonEmpty Text
keys Expr Src a
value) )
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr Src a -> (Expr Src a -> Expr Src a) -> Expr Src a)
-> Expr Src a -> [Expr Src a -> Expr Src a] -> Expr Src a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Expr Src a
e Expr Src a -> Expr Src a
f -> Expr Src a -> Expr Src a
f Expr Src a
e) Expr Src a
a0 [Expr Src a -> Expr Src a]
bs)
Parser (Expr Src a)
alternative4A Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
alternative4B Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
alternative4C Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr Src a -> Parser (Expr Src a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Src a
a
operatorExpression :: Parser (Expr Src a) -> (Parser (Expr Src a), Parser (Expr Src a))
operatorExpression Parser (Expr Src a)
firstApplicationExpression =
(Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> (Parser (Expr Src a), Parser (Expr Src a))
-> (Parser (Expr Src a), Parser (Expr Src a)))
-> (Parser (Expr Src a), Parser (Expr Src a))
-> [Parser (Expr Src a -> Expr Src a -> Expr Src a)]
-> (Parser (Expr Src a), Parser (Expr Src a))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> (Parser (Expr Src a), Parser (Expr Src a))
-> (Parser (Expr Src a), Parser (Expr Src a))
forall a.
Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> (Parser (Expr Src a), Parser (Expr Src a))
-> (Parser (Expr Src a), Parser (Expr Src a))
cons (Parser (Expr Src a), Parser (Expr Src a))
nil [Parser (Expr Src a -> Expr Src a -> Expr Src a)]
forall s a. [Parser (Expr s a -> Expr s a -> Expr s a)]
operatorParsers
where
cons :: Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> (Parser (Expr Src a), Parser (Expr Src a))
-> (Parser (Expr Src a), Parser (Expr Src a))
cons Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser (Parser (Expr Src a)
p0, Parser (Expr Src a)
p) =
( Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
forall a a.
Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
makeOperatorExpression Parser (Expr Src a)
p0 Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser Parser (Expr Src a)
p
, Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
forall a a.
Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
makeOperatorExpression Parser (Expr Src a)
p Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser Parser (Expr Src a)
p
)
nil :: (Parser (Expr Src a), Parser (Expr Src a))
nil = (Parser (Expr Src a)
firstApplicationExpression, Parser (Expr Src a)
applicationExpression)
makeOperatorExpression :: Parser (Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
makeOperatorExpression Parser (Expr Src a)
firstSubExpression Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser Parser (Expr Src a)
subExpression = do
Expr Src a
a <- Parser (Expr Src a)
firstSubExpression
[Expr Src a -> Expr Src a]
bs <- Parser (Expr Src a -> Expr Src a)
-> Parser [Expr Src a -> Expr Src a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many (Parser (Expr Src a -> Expr Src a)
-> Parser [Expr Src a -> Expr Src a])
-> Parser (Expr Src a -> Expr Src a)
-> Parser [Expr Src a -> Expr Src a]
forall a b. (a -> b) -> a -> b
$ do
(Src SourcePos
_ SourcePos
_ Text
textOp, Expr Src a -> Expr Src a -> Expr Src a
op0) <- Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Src, Expr Src a -> Expr Src a -> Expr Src a)
forall a. Parser a -> Parser (Src, a)
srcAnd (Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser ()
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a -> Expr Src a -> Expr Src a)
operatorParser))
Expr Src a
r0 <- Parser (Expr Src a)
subExpression
let l :: Expr Src a
l@(Note (Src SourcePos
startL SourcePos
_ Text
textL) Expr Src a
_) op :: Expr Src a -> Expr Src a -> Expr Src a
`op` r :: Expr Src a
r@(Note (Src SourcePos
_ SourcePos
endR Text
textR) Expr Src a
_) =
Src -> Expr Src a -> Expr Src a
forall s a. s -> Expr s a -> Expr s a
Note (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
startL SourcePos
endR (Text
textL Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textOp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
textR)) (Expr Src a
l Expr Src a -> Expr Src a -> Expr Src a
`op0` Expr Src a
r)
Expr Src a
l `op` Expr Src a
r =
Expr Src a
l Expr Src a -> Expr Src a -> Expr Src a
`op0` Expr Src a
r
(Expr Src a -> Expr Src a) -> Parser (Expr Src a -> Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Expr Src a
`op` Expr Src a
r0)
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr Src a -> (Expr Src a -> Expr Src a) -> Expr Src a)
-> Expr Src a -> [Expr Src a -> Expr Src a] -> Expr Src a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Expr Src a
x Expr Src a -> Expr Src a
f -> Expr Src a -> Expr Src a
f Expr Src a
x) Expr Src a
a [Expr Src a -> Expr Src a]
bs)
operatorParsers :: [Parser (Expr s a -> Expr s a -> Expr s a)]
operatorParsers :: [Parser (Expr s a -> Expr s a -> Expr s a)]
operatorParsers =
[ Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
Equivalent (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_equivalent Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
ImportAlt (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_importAlt Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
nonemptyWhitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
BoolOr (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_or Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
NaturalPlus (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_plus Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
nonemptyWhitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
TextAppend (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_textAppend Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
ListAppend (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_listAppend Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
BoolAnd (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_and Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Maybe Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine Maybe Text
forall a. Maybe a
Nothing (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_combine Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
forall s a.
PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Prefer PreferAnnotation s a
forall s a. PreferAnnotation s a
PreferFromSource (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_prefer Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
CombineTypes (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_combineTypes Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
NaturalTimes (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_times Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
BoolEQ (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_doubleEqual Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
Text.Megaparsec.notFollowedBy (Char -> Parser Char
char Char
'=')) Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
, Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
BoolNE (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_notEqual Parser (Expr s a -> Expr s a -> Expr s a)
-> Parser () -> Parser (Expr s a -> Expr s a -> Expr s a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
]
applicationExpression :: Parser (Expr Src a)
applicationExpression = do
let alternative0 :: Parser (Expr s a -> Expr s a, Maybe String)
alternative0 = do
()
_ <- Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_Some Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
nonemptyWhitespace)
(Expr s a -> Expr s a, Maybe String)
-> Parser (Expr s a -> Expr s a, Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Some, String -> Maybe String
forall a. a -> Maybe a
Just String
"argument to ❰Some❱")
let alternative1 :: Parser (Expr s a -> Expr s a, Maybe String)
alternative1 = do
()
_ <- Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_toMap Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
(Expr s a -> Expr s a, Maybe String)
-> Parser (Expr s a -> Expr s a, Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (\Expr s a
a -> Expr s a -> Maybe (Expr s a) -> Expr s a
forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap Expr s a
a Maybe (Expr s a)
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just String
"argument to ❰toMap❱")
let alternative2 :: Parser (a -> a, Maybe a)
alternative2 = do
(a -> a, Maybe a) -> Parser (a -> a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
forall a. a -> a
id, Maybe a
forall a. Maybe a
Nothing)
(Expr Src a -> Expr Src a
f, Maybe String
maybeMessage) <- Parser (Expr Src a -> Expr Src a, Maybe String)
forall s a. Parser (Expr s a -> Expr s a, Maybe String)
alternative0 Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a -> Expr Src a, Maybe String)
forall s a. Parser (Expr s a -> Expr s a, Maybe String)
alternative1 Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
-> Parser (Expr Src a -> Expr Src a, Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a -> Expr Src a, Maybe String)
forall a a. Parser (a -> a, Maybe a)
alternative2
let adapt :: m a -> m a
adapt m a
parser =
case Maybe String
maybeMessage of
Maybe String
Nothing -> m a
parser
Just String
message -> m a
parser m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
message
Expr Src a
a <- Parser (Expr Src a) -> Parser (Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> m a
adapt (Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted Parser (Expr Src a)
importExpression_)
[(Text, Expr Src a)]
bs <- Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many (Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)])
-> (Parser (Text, Expr Src a) -> Parser (Text, Expr Src a))
-> Parser (Text, Expr Src a)
-> Parser [(Text, Expr Src a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Text, Expr Src a) -> Parser (Text, Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)])
-> Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)]
forall a b. (a -> b) -> a -> b
$ do
(Text
sep, ()
_) <- Parser () -> Parser (Tokens Text, ())
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Text.Megaparsec.match Parser ()
nonemptyWhitespace
Expr Src a
b <- Parser (Expr Src a)
importExpression_
(Text, Expr Src a) -> Parser (Text, Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
sep, Expr Src a
b)
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr Src a -> (Text, Expr Src a) -> Expr Src a)
-> Expr Src a -> [(Text, Expr Src a)] -> Expr Src a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Expr Src a -> (Text, Expr Src a) -> Expr Src a
forall a. Expr Src a -> (Text, Expr Src a) -> Expr Src a
app (Expr Src a -> Expr Src a
f Expr Src a
a) [(Text, Expr Src a)]
bs)
where
app :: Expr Src a -> (Text, Expr Src a) -> Expr Src a
app Expr Src a
a (Text
sep, Expr Src a
b)
| Note (Src SourcePos
left SourcePos
_ Text
bytesL) Expr Src a
_ <- Expr Src a
a
, Note (Src SourcePos
_ SourcePos
right Text
bytesR) Expr Src a
_ <- Expr Src a
b
= Src -> Expr Src a -> Expr Src a
forall s a. s -> Expr s a -> Expr s a
Note (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
left SourcePos
right (Text
bytesL Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bytesR)) (Expr Src a -> Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src a
a Expr Src a
b)
app Expr Src a
a (Text
_, Expr Src a
b) =
Expr Src a -> Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src a
a Expr Src a
b
importExpression_ :: Parser (Expr Src a)
importExpression_ = Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted ([Parser (Expr Src a)] -> Parser (Expr Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [ Item [Parser (Expr Src a)]
forall s. Parser (Expr s a)
alternative0, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative1 ])
where
alternative0 :: Parser (Expr s a)
alternative0 = do
a
a <- Parser a
embedded
Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Expr s a
forall s a. a -> Expr s a
Embed a
a)
alternative1 :: Parser (Expr Src a)
alternative1 = Parser (Expr Src a)
completionExpression
completionExpression :: Parser (Expr Src a)
completionExpression = Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted (do
Expr Src a
a <- Parser (Expr Src a)
selectorExpression
Maybe (Expr Src a)
mb <- Parser (Expr Src a) -> Parser (Maybe (Expr Src a))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_doubleColon)
Parser ()
whitespace
Parser (Expr Src a)
selectorExpression )
case Maybe (Expr Src a)
mb of
Maybe (Expr Src a)
Nothing -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
a
Just Expr Src a
b -> Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a -> Expr s a
RecordCompletion Expr Src a
a Expr Src a
b) )
selectorExpression :: Parser (Expr Src a)
selectorExpression = Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted (do
Expr Src a
a <- Parser (Expr Src a)
primitiveExpression
let recordType :: Parser (Expr Src a)
recordType = Parser ()
_openParens Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser () -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression Parser (Expr Src a) -> Parser () -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace Parser (Expr Src a) -> Parser () -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
_closeParens
let field :: Text -> Expr s a -> Expr s a
field Text
x Expr s a
e = Expr s a -> Text -> Expr s a
forall s a. Expr s a -> Text -> Expr s a
Field Expr s a
e Text
x
let projectBySet :: Set Text -> Expr s a -> Expr s a
projectBySet Set Text
xs Expr s a
e = Expr s a -> Either (Set Text) (Expr s a) -> Expr s a
forall s a. Expr s a -> Either (Set Text) (Expr s a) -> Expr s a
Project Expr s a
e (Set Text -> Either (Set Text) (Expr s a)
forall a b. a -> Either a b
Left Set Text
xs)
let projectByExpression :: Expr s a -> Expr s a -> Expr s a
projectByExpression Expr s a
xs Expr s a
e = Expr s a -> Either (Set Text) (Expr s a) -> Expr s a
forall s a. Expr s a -> Either (Set Text) (Expr s a) -> Expr s a
Project Expr s a
e (Expr s a -> Either (Set Text) (Expr s a)
forall a b. b -> Either a b
Right Expr s a
xs)
let alternatives :: Parser (Expr Src a -> Expr Src a)
alternatives =
(Text -> Expr Src a -> Expr Src a)
-> Parser Text -> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Expr Src a -> Expr Src a
forall s a. Text -> Expr s a -> Expr s a
field Parser Text
anyLabel
Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Set Text -> Expr Src a -> Expr Src a)
-> Parser (Set Text) -> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set Text -> Expr Src a -> Expr Src a
forall s a. Set Text -> Expr s a -> Expr s a
projectBySet Parser (Set Text)
labels
Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Expr Src a -> Expr Src a -> Expr Src a)
-> Parser (Expr Src a) -> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Src a -> Expr Src a -> Expr Src a
forall s a. Expr s a -> Expr s a -> Expr s a
projectByExpression Parser (Expr Src a)
recordType
[Expr Src a -> Expr Src a]
b <- Parser (Expr Src a -> Expr Src a)
-> Parser [Expr Src a -> Expr Src a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many (Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_dot Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace Parser ()
-> Parser (Expr Src a -> Expr Src a)
-> Parser (Expr Src a -> Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a -> Expr Src a)
alternatives))
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Expr Src a -> (Expr Src a -> Expr Src a) -> Expr Src a)
-> Expr Src a -> [Expr Src a -> Expr Src a] -> Expr Src a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Expr Src a
e Expr Src a -> Expr Src a
k -> Expr Src a -> Expr Src a
k Expr Src a
e) Expr Src a
a [Expr Src a -> Expr Src a]
b) )
primitiveExpression :: Parser (Expr Src a)
primitiveExpression =
Parser (Expr Src a) -> Parser (Expr Src a)
forall a. Parser (Expr Src a) -> Parser (Expr Src a)
noted
( [Parser (Expr Src a)] -> Parser (Expr Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Item [Parser (Expr Src a)]
forall s a. Parser (Expr s a)
alternative00
, Item [Parser (Expr Src a)]
forall s a. Parser (Expr s a)
alternative01
, Item [Parser (Expr Src a)]
forall s a. Parser (Expr s a)
alternative02
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative03
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative04
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative05
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative06
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative07
, Item [Parser (Expr Src a)]
forall s a. Parser (Expr s a)
alternative37
, Item [Parser (Expr Src a)]
forall s a. Parser (Expr s a)
alternative09
, Item [Parser (Expr Src a)]
forall s a. Parser (Expr s a)
builtin
]
)
Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
alternative38
where
alternative00 :: Parser (Expr s a)
alternative00 = do
Int
n <- Parser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Double
a <- Parser Double -> Parser Double
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Double
doubleLiteral
Double
b <- if Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
a
then Int -> Parser ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
n Parser () -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Parser Double
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"double out of bounds"
else Double -> Parser Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
a
Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
b))
alternative01 :: Parser (Expr s a)
alternative01 = do
Natural
a <- Parser Natural -> Parser Natural
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Natural
naturalLiteral
Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit Natural
a)
alternative02 :: Parser (Expr s a)
alternative02 = do
Integer
a <- Parser Integer -> Parser Integer
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Integer
integerLiteral
Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit Integer
a)
alternative03 :: Parser (Expr Src a)
alternative03 = Parser (Expr Src a)
textLiteral
alternative04 :: Parser (Expr Src a)
alternative04 = (do
Parser ()
_openBrace
Parser ()
whitespace
Maybe ()
_ <- Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)
Expr Src a
a <- Parser (Expr Src a)
recordTypeOrLiteral
Parser ()
whitespace
Parser ()
_closeBrace
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
a ) Parser (Expr Src a) -> String -> Parser (Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"
alternative05 :: Parser (Expr Src a)
alternative05 = Parser (Expr Src a)
unionType
alternative06 :: Parser (Expr Src a)
alternative06 = Parser (Expr Src a)
listLiteral
alternative07 :: Parser (Expr Src a)
alternative07 = do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
_merge Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
Expr Src a
a <- Parser (Expr Src a)
importExpression_
Parser ()
nonemptyWhitespace
Expr Src a
b <- Parser (Expr Src a)
importExpression_ Parser (Expr Src a) -> String -> Parser (Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"second argument to ❰merge❱"
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src a -> Expr Src a -> Maybe (Expr Src a) -> Expr Src a
forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge Expr Src a
a Expr Src a
b Maybe (Expr Src a)
forall a. Maybe a
Nothing)
alternative09 :: Parser (Expr s a)
alternative09 = do
Double
a <- Parser Double -> Parser Double
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser Double
doubleInfinity
Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
a))
builtin :: Parser (Expr s a)
builtin = do
let predicate :: Char -> Bool
predicate Char
c =
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'N'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'I'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'L'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'O'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'B'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'S'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'T'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'F'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'K'
let nan :: DhallDouble
nan = Double -> DhallDouble
DhallDouble (Double
0.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0.0)
Char
c <- Parser Char -> Parser Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.lookAhead ((Token Text -> Bool) -> Parser (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Text.Megaparsec.satisfy Char -> Bool
Token Text -> Bool
predicate)
case Char
c of
Char
'N' ->
[Parser (Expr s a)] -> Parser (Expr s a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Expr s a
forall s a. Expr s a
NaturalFold Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalFold
, Expr s a
forall s a. Expr s a
NaturalBuild Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalBuild
, Expr s a
forall s a. Expr s a
NaturalIsZero Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalIsZero
, Expr s a
forall s a. Expr s a
NaturalEven Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalEven
, Expr s a
forall s a. Expr s a
NaturalOdd Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalOdd
, Expr s a
forall s a. Expr s a
NaturalSubtract Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalSubtract
, Expr s a
forall s a. Expr s a
NaturalToInteger Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalToInteger
, Expr s a
forall s a. Expr s a
NaturalShow Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaturalShow
, Expr s a
forall s a. Expr s a
Natural Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Natural
, Expr s a
forall s a. Expr s a
None Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_None
, DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
DoubleLit DhallDouble
nan Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_NaN
]
Char
'I' ->
[Parser (Expr s a)] -> Parser (Expr s a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Expr s a
forall s a. Expr s a
IntegerClamp Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_IntegerClamp
, Expr s a
forall s a. Expr s a
IntegerNegate Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_IntegerNegate
, Expr s a
forall s a. Expr s a
IntegerShow Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_IntegerShow
, Expr s a
forall s a. Expr s a
IntegerToDouble Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_IntegerToDouble
, Expr s a
forall s a. Expr s a
Integer Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Integer
]
Char
'D' ->
[Parser (Expr s a)] -> Parser (Expr s a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Expr s a
forall s a. Expr s a
DoubleShow Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_DoubleShow
, Expr s a
forall s a. Expr s a
Double Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Double
]
Char
'L' ->
[Parser (Expr s a)] -> Parser (Expr s a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Expr s a
forall s a. Expr s a
ListBuild Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListBuild
, Expr s a
forall s a. Expr s a
ListFold Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListFold
, Expr s a
forall s a. Expr s a
ListLength Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListLength
, Expr s a
forall s a. Expr s a
ListHead Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListHead
, Expr s a
forall s a. Expr s a
ListLast Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListLast
, Expr s a
forall s a. Expr s a
ListIndexed Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListIndexed
, Expr s a
forall s a. Expr s a
ListReverse Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_ListReverse
, Expr s a
forall s a. Expr s a
List Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_List
]
Char
'O' -> Expr s a
forall s a. Expr s a
Optional Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Optional
Char
'B' -> Expr s a
forall s a. Expr s a
Bool Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Bool
Char
'S' -> Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Sort Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Sort
Char
'T' ->
[Parser (Expr s a)] -> Parser (Expr s a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Expr s a
forall s a. Expr s a
TextShow Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_TextShow
, Expr s a
forall s a. Expr s a
Text Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Text
, Bool -> Expr s a
forall s a. Bool -> Expr s a
BoolLit Bool
True Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_True
, Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Type Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Type
]
Char
'F' -> Bool -> Expr s a
forall s a. Bool -> Expr s a
BoolLit Bool
False Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_False
Char
'K' -> Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Kind Expr s a -> Parser () -> Parser (Expr s a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
_Kind
Char
_ -> Parser (Expr s a)
forall (f :: * -> *) a. Alternative f => f a
empty
alternative37 :: Parser (Expr s a)
alternative37 = do
Var
a <- Parser Var
identifier
Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> Expr s a
forall s a. Var -> Expr s a
Var Var
a)
alternative38 :: Parser (Expr Src a)
alternative38 = do
Parser ()
_openParens
Parser ()
whitespace
Expr Src a
a <- Parser (Expr Src a)
expression
Parser ()
whitespace
Parser ()
_closeParens
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src a
a
doubleQuotedChunk :: Parser (Chunks Src a)
doubleQuotedChunk =
[Parser (Chunks Src a)] -> Parser (Chunks Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
interpolation
, Item [Parser (Chunks Src a)]
forall s a. Parser (Chunks s a)
unescapedCharacterFast
, Item [Parser (Chunks Src a)]
forall s a. Parser (Chunks s a)
unescapedCharacterSlow
, Item [Parser (Chunks Src a)]
forall s a. Parser (Chunks s a)
escapedCharacter
]
where
interpolation :: Parser (Chunks Src a)
interpolation = do
Text
_ <- Text -> Parser Text
text Text
"${"
Expr Src a
e <- Parser (Expr Src a)
completeExpression_
Char
_ <- Char -> Parser Char
char Char
'}'
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text
forall a. Monoid a => a
mempty, Expr Src a
e)] Text
forall a. Monoid a => a
mempty)
unescapedCharacterFast :: Parser (Chunks s a)
unescapedCharacterFast = do
Text
t <- Maybe String -> (Token Text -> Bool) -> Parser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
predicate
Chunks s a -> Parser (Chunks s a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
t)
where
predicate :: Char -> Bool
predicate Char
c =
( (Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x21' )
Bool -> Bool -> Bool
|| (Char
'\x23' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5B' )
Bool -> Bool -> Bool
|| (Char
'\x5D' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF')
) Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$'
unescapedCharacterSlow :: Parser (Chunks s a)
unescapedCharacterSlow = do
Char
_ <- Char -> Parser Char
char Char
'$'
Chunks s a -> Parser (Chunks s a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
"$")
escapedCharacter :: Parser (Chunks s a)
escapedCharacter = do
Char
_ <- Char -> Parser Char
char Char
'\\'
Char
c <- [Parser Char] -> Parser Char
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Item [Parser Char]
Parser Char
quotationMark
, Item [Parser Char]
Parser Char
dollarSign
, Item [Parser Char]
Parser Char
backSlash
, Item [Parser Char]
Parser Char
forwardSlash
, Item [Parser Char]
Parser Char
backSpace
, Item [Parser Char]
Parser Char
formFeed
, Item [Parser Char]
Parser Char
lineFeed
, Item [Parser Char]
Parser Char
carriageReturn
, Item [Parser Char]
Parser Char
tab
, Item [Parser Char]
Parser Char
unicode
]
Chunks s a -> Parser (Chunks s a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (Char -> Text
Data.Text.singleton Char
c))
where
quotationMark :: Parser Char
quotationMark = Char -> Parser Char
char Char
'"'
dollarSign :: Parser Char
dollarSign = Char -> Parser Char
char Char
'$'
backSlash :: Parser Char
backSlash = Char -> Parser Char
char Char
'\\'
forwardSlash :: Parser Char
forwardSlash = Char -> Parser Char
char Char
'/'
backSpace :: Parser Char
backSpace = do Char
_ <- Char -> Parser Char
char Char
'b'; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\b'
formFeed :: Parser Char
formFeed = do Char
_ <- Char -> Parser Char
char Char
'f'; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\f'
lineFeed :: Parser Char
lineFeed = do Char
_ <- Char -> Parser Char
char Char
'n'; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
carriageReturn :: Parser Char
carriageReturn = do Char
_ <- Char -> Parser Char
char Char
'r'; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
tab :: Parser Char
tab = do Char
_ <- Char -> Parser Char
char Char
't'; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
unicode :: Parser Char
unicode = do
Char
_ <- Char -> Parser Char
char Char
'u';
let toNumber :: [Int] -> Int
toNumber = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (\Int
x Int
y -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Int
0
let fourCharacterEscapeSequence :: Parser Int
fourCharacterEscapeSequence = do
[Int]
ns <- Int -> Parser Int -> Parser [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Control.Monad.replicateM Int
4 Parser Int
hexNumber
let number :: Int
number = [Int] -> Int
toNumber [Int]
ns
Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Control.Monad.guard (Int -> Bool
validCodepoint Int
number)
Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Unicode code point"
Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
number
let bracedEscapeSequence :: Parser Int
bracedEscapeSequence = do
Char
_ <- Char -> Parser Char
char Char
'{'
[Int]
ns <- Parser Int -> Parser [Int]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Int
hexNumber
let number :: Int
number = [Int] -> Int
toNumber [Int]
ns
Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
Control.Monad.guard (Int
number Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFD Bool -> Bool -> Bool
&& Int -> Bool
validCodepoint Int
number)
Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Unicode code point"
Char
_ <- Char -> Parser Char
char Char
'}'
Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
number
Int
n <- Parser Int
bracedEscapeSequence Parser Int -> Parser Int -> Parser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Int
fourCharacterEscapeSequence
Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
Char.chr Int
n)
doubleQuotedLiteral :: Parser (Chunks Src a)
doubleQuotedLiteral = do
Char
_ <- Char -> Parser Char
char Char
'"'
[Chunks Src a]
chunks <- Parser (Chunks Src a) -> Parser [Chunks Src a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many Parser (Chunks Src a)
doubleQuotedChunk
Char
_ <- Char -> Parser Char
char Char
'"'
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Chunks Src a] -> Chunks Src a
forall a. Monoid a => [a] -> a
mconcat [Chunks Src a]
chunks)
singleQuoteContinue :: Parser (Chunks Src a)
singleQuoteContinue =
[Parser (Chunks Src a)] -> Parser (Chunks Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
escapeSingleQuotes
, Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
interpolation
, Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
escapeInterpolation
, Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
endLiteral
, Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
unescapedCharacterFast
, Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
unescapedCharacterSlow
, Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
tab
, Item [Parser (Chunks Src a)]
Parser (Chunks Src a)
endOfLine
]
where
escapeSingleQuotes :: Parser (Chunks Src a)
escapeSingleQuotes = do
Text
_ <- Parser Text
"'''" :: Parser Text
Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"''" Chunks Src a -> Chunks Src a -> Chunks Src a
forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
interpolation :: Parser (Chunks Src a)
interpolation = do
Text
_ <- Text -> Parser Text
text Text
"${"
Expr Src a
a <- Parser (Expr Src a)
completeExpression_
Char
_ <- Char -> Parser Char
char Char
'}'
Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text
forall a. Monoid a => a
mempty, Expr Src a
a)] Text
forall a. Monoid a => a
mempty Chunks Src a -> Chunks Src a -> Chunks Src a
forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
escapeInterpolation :: Parser (Chunks Src a)
escapeInterpolation = do
Text
_ <- Text -> Parser Text
text Text
"''${"
Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"${" Chunks Src a -> Chunks Src a -> Chunks Src a
forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
endLiteral :: Parser (Chunks Src a)
endLiteral = do
Text
_ <- Text -> Parser Text
text Text
"''"
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return Chunks Src a
forall a. Monoid a => a
mempty
unescapedCharacterFast :: Parser (Chunks Src a)
unescapedCharacterFast = do
Text
a <- Maybe String -> (Token Text -> Bool) -> Parser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
predicate
Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a Chunks Src a -> Chunks Src a -> Chunks Src a
forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
where
predicate :: Char -> Bool
predicate Char
c =
(Char
'\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FFFF') Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\''
unescapedCharacterSlow :: Parser (Chunks Src a)
unescapedCharacterSlow = do
Text
a <- (Char -> Bool) -> Parser Text
satisfy Char -> Bool
predicate
Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a Chunks Src a -> Chunks Src a -> Chunks Src a
forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
where
predicate :: Char -> Bool
predicate Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
endOfLine :: Parser (Chunks Src a)
endOfLine = do
Text
a <- Parser Text
"\n" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
"\r\n"
Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Expr Src a)] -> Text -> Chunks Src a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
a Chunks Src a -> Chunks Src a -> Chunks Src a
forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
tab :: Parser (Chunks Src a)
tab = do
Char
_ <- Char -> Parser Char
char Char
'\t' Parser Char -> String -> Parser Char
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"tab"
Chunks Src a
b <- Parser (Chunks Src a)
singleQuoteContinue
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a
"\t" Chunks Src a -> Chunks Src a -> Chunks Src a
forall a. Semigroup a => a -> a -> a
<> Chunks Src a
b)
singleQuoteLiteral :: Parser (Chunks Src a)
singleQuoteLiteral = do
Text
_ <- Text -> Parser Text
text Text
"''"
()
_ <- Parser ()
endOfLine
Chunks Src a
a <- Parser (Chunks Src a)
singleQuoteContinue
Chunks Src a -> Parser (Chunks Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a -> Chunks Src a
forall a. Chunks Src a -> Chunks Src a
Dhall.Syntax.toDoubleQuoted Chunks Src a
a)
where
endOfLine :: Parser ()
endOfLine = (Parser Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'\n') Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
text Text
"\r\n")) Parser () -> String -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"newline"
textLiteral :: Parser (Expr Src a)
textLiteral = (do
Chunks Src a
literal <- Parser (Chunks Src a)
doubleQuotedLiteral Parser (Chunks Src a)
-> Parser (Chunks Src a) -> Parser (Chunks Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Chunks Src a)
singleQuoteLiteral
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks Src a -> Expr Src a
forall s a. Chunks s a -> Expr s a
TextLit Chunks Src a
literal) ) Parser (Expr Src a) -> String -> Parser (Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"
recordTypeOrLiteral :: Parser (Expr Src a)
recordTypeOrLiteral =
[Parser (Expr Src a)] -> Parser (Expr Src a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Item [Parser (Expr Src a)]
forall s a. Parser (Expr s a)
alternative0
, Item [Parser (Expr Src a)]
Parser (Expr Src a)
alternative1
, Item [Parser (Expr Src a)]
forall s a. Parser (Expr s a)
alternative2
]
where
alternative0 :: Parser (Expr s a)
alternative0 = do
Parser ()
_equal
Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit Map Text (Expr s a)
forall a. Monoid a => a
mempty)
alternative1 :: Parser (Expr Src a)
alternative1 = Parser (Expr Src a)
nonEmptyRecordTypeOrLiteral
alternative2 :: Parser (Expr s a)
alternative2 = Expr s a -> Parser (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
Record Map Text (Expr s a)
forall a. Monoid a => a
mempty)
nonEmptyRecordTypeOrLiteral :: Parser (Expr Src a)
nonEmptyRecordTypeOrLiteral = do
let nonEmptyRecordType :: Parser (Expr Src a)
nonEmptyRecordType = do
Text
a <- Parser Text -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser Text
anyLabelOrSome Parser Text -> Parser () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace Parser Text -> Parser () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
_colon)
Parser ()
nonemptyWhitespace
Expr Src a
b <- Parser (Expr Src a)
expression
Parser ()
whitespace
[(Text, Expr Src a)]
e <- Parser (Text, Expr Src a) -> Parser [(Text, Expr Src a)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
Text.Megaparsec.many (do
Parser ()
_comma
Parser ()
whitespace
Text
c <- Parser Text
anyLabelOrSome
Parser ()
whitespace
Parser ()
_colon
Parser ()
nonemptyWhitespace
Expr Src a
d <- Parser (Expr Src a)
expression
Parser ()
whitespace
(Text, Expr Src a) -> Parser (Text, Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
c, Expr Src a
d) )
Map Text (Expr Src a)
m <- [(Text, Expr Src a)] -> Parser (Map Text (Expr Src a))
forall a. [(Text, a)] -> Parser (Map Text a)
toMap ((Text
a, Expr Src a
b) (Text, Expr Src a) -> [(Text, Expr Src a)] -> [(Text, Expr Src a)]
forall a. a -> [a] -> [a]
: [(Text, Expr Src a)]
e)
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Expr Src a) -> Expr Src a
forall s a. Map Text (Expr s a) -> Expr s a
Record Map Text (Expr Src a)
m)
let keysValue :: Parser (Text, Expr Src a)
keysValue = do
NonEmpty Text
keys <- Parser Text -> Parser () -> Parser (NonEmpty Text)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
Combinators.NonEmpty.sepBy1 Parser Text
anyLabelOrSome (Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_dot) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)
let normalRecordEntry :: Parser (Text, Expr Src a)
normalRecordEntry = do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_equal)
Parser ()
whitespace
Expr Src a
value <- Parser (Expr Src a)
expression
let cons :: a -> (Text, Expr s a) -> (a, Expr s a)
cons a
key (Text
key', Expr s a
values) =
(a
key, Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit [ (Text
key', Expr s a
values) ])
let nil :: (Text, Expr Src a)
nil = (NonEmpty Text -> Text
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Text
keys, Expr Src a
value)
(Text, Expr Src a) -> Parser (Text, Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text -> (Text, Expr Src a) -> (Text, Expr Src a))
-> (Text, Expr Src a) -> [Text] -> (Text, Expr Src a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> (Text, Expr Src a) -> (Text, Expr Src a)
forall a s a. a -> (Text, Expr s a) -> (a, Expr s a)
cons (Text, Expr Src a)
nil (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty Text
keys))
let punnedEntry :: Parser (Text, Expr s a)
punnedEntry =
case NonEmpty Text
keys of
Text
x :| [] -> (Text, Expr s a) -> Parser (Text, Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Var -> Expr s a
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x Int
0))
NonEmpty Text
_ -> Parser (Text, Expr s a)
forall (f :: * -> *) a. Alternative f => f a
empty
(Parser (Text, Expr Src a)
normalRecordEntry Parser (Text, Expr Src a)
-> Parser (Text, Expr Src a) -> Parser (Text, Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Text, Expr Src a)
forall s a. Parser (Text, Expr s a)
punnedEntry) Parser (Text, Expr Src a) -> Parser () -> Parser (Text, Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace
let nonEmptyRecordLiteral :: Parser (Expr Src a)
nonEmptyRecordLiteral = do
[(Text, Expr Src a)]
as <- Parser (Text, Expr Src a)
-> Parser () -> Parser [(Text, Expr Src a)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Text.Megaparsec.sepBy1 Parser (Text, Expr Src a)
keysValue (Parser ()
_comma Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)
let combine :: Text -> f (Expr s a) -> f (Expr s a) -> f (Expr s a)
combine Text
k = (Expr s a -> Expr s a -> Expr s a)
-> f (Expr s a) -> f (Expr s a) -> f (Expr s a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Expr s a -> Expr s a -> Expr s a)
-> Expr s a -> Expr s a -> Expr s a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
k)))
Map Text (Expr Src a)
m <- (Text
-> Parser (Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a))
-> [(Text, Expr Src a)] -> Parser (Map Text (Expr Src a))
forall a.
(Text -> Parser a -> Parser a -> Parser a)
-> [(Text, a)] -> Parser (Map Text a)
toMapWith Text
-> Parser (Expr Src a)
-> Parser (Expr Src a)
-> Parser (Expr Src a)
forall (f :: * -> *) s a.
Applicative f =>
Text -> f (Expr s a) -> f (Expr s a) -> f (Expr s a)
combine [(Text, Expr Src a)]
as
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Expr Src a) -> Expr Src a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit Map Text (Expr Src a)
m)
Parser (Expr Src a)
nonEmptyRecordType Parser (Expr Src a) -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expr Src a)
nonEmptyRecordLiteral
unionType :: Parser (Expr Src a)
unionType = (do
Parser ()
_openAngle
Parser ()
whitespace
Maybe ()
_ <- Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_bar Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)
let unionTypeEntry :: Parser (Text, Maybe (Expr Src a))
unionTypeEntry = do
Text
a <- Parser Text
anyLabelOrSome
Parser ()
whitespace
Maybe (Expr Src a)
b <- Parser (Expr Src a) -> Parser (Maybe (Expr Src a))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_colon Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace Parser () -> Parser (Expr Src a) -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Expr Src a)
expression Parser (Expr Src a) -> Parser () -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace)
(Text, Maybe (Expr Src a)) -> Parser (Text, Maybe (Expr Src a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
a, Maybe (Expr Src a)
b)
[(Text, Maybe (Expr Src a))]
kvs <- Parser (Text, Maybe (Expr Src a))
-> Parser () -> Parser [(Text, Maybe (Expr Src a))]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Text.Megaparsec.sepBy Parser (Text, Maybe (Expr Src a))
unionTypeEntry (Parser ()
_bar Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)
Map Text (Maybe (Expr Src a))
m <- [(Text, Maybe (Expr Src a))]
-> Parser (Map Text (Maybe (Expr Src a)))
forall a. [(Text, a)] -> Parser (Map Text a)
toMap [(Text, Maybe (Expr Src a))]
kvs
Parser ()
_closeAngle
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Maybe (Expr Src a)) -> Expr Src a
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src a))
m) ) Parser (Expr Src a) -> String -> Parser (Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"
listLiteral :: Parser (Expr Src a)
listLiteral = (do
Parser ()
_openBracket
Parser ()
whitespace
Maybe ()
_ <- Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
_comma Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)
[Expr Src a]
a <- Parser (Expr Src a) -> Parser () -> Parser [Expr Src a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Text.Megaparsec.sepBy (Parser (Expr Src a)
expression Parser (Expr Src a) -> Parser () -> Parser (Expr Src a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace) (Parser ()
_comma Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
whitespace)
Parser ()
_closeBracket
Expr Src a -> Parser (Expr Src a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Expr Src a) -> Seq (Expr Src a) -> Expr Src a
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src a)
forall a. Maybe a
Nothing ([Expr Src a] -> Seq (Expr Src a)
forall a. [a] -> Seq a
Data.Sequence.fromList [Expr Src a]
a)) ) Parser (Expr Src a) -> String -> Parser (Expr Src a)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"literal"
env :: Parser ImportType
env :: Parser ImportType
env = do
Text
_ <- Text -> Parser Text
text Text
"env:"
Text
a <- (Parser Text
alternative0 Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
alternative1)
ImportType -> Parser ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ImportType
Env Text
a)
where
alternative0 :: Parser Text
alternative0 = Parser Text
bashEnvironmentVariable
alternative1 :: Parser Text
alternative1 = do
Char
_ <- Char -> Parser Char
char Char
'"'
Text
a <- Parser Text
posixEnvironmentVariable
Char
_ <- Char -> Parser Char
char Char
'"'
Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
a
localOnly :: Parser ImportType
localOnly :: Parser ImportType
localOnly =
[Parser ImportType] -> Parser ImportType
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
[ Item [Parser ImportType]
Parser ImportType
parentPath
, Item [Parser ImportType]
Parser ImportType
herePath
, Item [Parser ImportType]
Parser ImportType
homePath
, Parser ImportType -> Parser ImportType
forall (m :: * -> *) a. Parsing m => m a -> m a
try Parser ImportType
absolutePath
]
where
parentPath :: Parser ImportType
parentPath = do
Text
_ <- Parser Text
".." :: Parser Text
File
file <- ComponentType -> Parser File
file_ ComponentType
FileComponent
ImportType -> Parser ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
Parent File
file)
herePath :: Parser ImportType
herePath = do
Text
_ <- Parser Text
"." :: Parser Text
File
file <- ComponentType -> Parser File
file_ ComponentType
FileComponent
ImportType -> Parser ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
Here File
file)
homePath :: Parser ImportType
homePath = do
Text
_ <- Parser Text
"~" :: Parser Text
File
file <- ComponentType -> Parser File
file_ ComponentType
FileComponent
ImportType -> Parser ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
Home File
file)
absolutePath :: Parser ImportType
absolutePath = do
File
file <- ComponentType -> Parser File
file_ ComponentType
FileComponent
ImportType -> Parser ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
Absolute File
file)
local :: Parser ImportType
local :: Parser ImportType
local = do
ImportType
a <- Parser ImportType
localOnly
ImportType -> Parser ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return ImportType
a
http :: Parser ImportType
http :: Parser ImportType
http = do
URL
url <- Parser URL
httpRaw
Maybe (Expr Src Import)
headers <- Parser (Expr Src Import) -> Parser (Maybe (Expr Src Import))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_using Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
Parser Import -> Parser (Expr Src Import)
forall a. Parser a -> Parser (Expr Src a)
importExpression Parser Import
import_ )
ImportType -> Parser ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (URL -> ImportType
Remote (URL
url { Maybe (Expr Src Import)
headers :: Maybe (Expr Src Import)
headers :: Maybe (Expr Src Import)
headers }))
missing :: Parser ImportType
missing :: Parser ImportType
missing = do
Parser ()
_missing
ImportType -> Parser ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return ImportType
Missing
importType_ :: Parser ImportType
importType_ :: Parser ImportType
importType_ = do
let predicate :: Char -> Bool
predicate Char
c =
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'h' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'm'
Char
_ <- Parser Char -> Parser Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.lookAhead ((Token Text -> Bool) -> Parser (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Text.Megaparsec.satisfy Char -> Bool
Token Text -> Bool
predicate)
[Parser ImportType] -> Parser ImportType
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [ Item [Parser ImportType]
Parser ImportType
local, Item [Parser ImportType]
Parser ImportType
http, Item [Parser ImportType]
Parser ImportType
env, Item [Parser ImportType]
Parser ImportType
missing ]
importHash_ :: Parser Dhall.Crypto.SHA256Digest
importHash_ :: Parser SHA256Digest
importHash_ = do
Text
_ <- Text -> Parser Text
text Text
"sha256:"
Text
t <- Int -> Parser Text -> Parser Text
forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
64 ((Char -> Bool) -> Parser Text
satisfy Char -> Bool
hexdig Parser Text -> String -> Parser Text
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"hex digit")
let strictBytes16 :: ByteString
strictBytes16 = Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
t
ByteString
strictBytes <- case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
Data.ByteArray.Encoding.convertFromBase Base
Base16 ByteString
strictBytes16 of
Left String
string -> String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
string
Right ByteString
strictBytes -> ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
strictBytes :: Data.ByteString.ByteString)
case ByteString -> Maybe SHA256Digest
Dhall.Crypto.sha256DigestFromByteString ByteString
strictBytes of
Maybe SHA256Digest
Nothing -> String -> Parser SHA256Digest
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid sha256 hash"
Just SHA256Digest
h -> SHA256Digest -> Parser SHA256Digest
forall (f :: * -> *) a. Applicative f => a -> f a
pure SHA256Digest
h
importHashed_ :: Parser ImportHashed
importHashed_ :: Parser ImportHashed
importHashed_ = do
ImportType
importType <- Parser ImportType
importType_
Maybe SHA256Digest
hash <- Parser SHA256Digest -> Parser (Maybe SHA256Digest)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser SHA256Digest -> Parser SHA256Digest
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
nonemptyWhitespace Parser () -> Parser SHA256Digest -> Parser SHA256Digest
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser SHA256Digest
importHash_))
ImportHashed -> Parser ImportHashed
forall (m :: * -> *) a. Monad m => a -> m a
return (ImportHashed :: Maybe SHA256Digest -> ImportType -> ImportHashed
ImportHashed {Maybe SHA256Digest
ImportType
importType :: ImportType
hash :: Maybe SHA256Digest
hash :: Maybe SHA256Digest
importType :: ImportType
..})
import_ :: Parser Import
import_ :: Parser Import
import_ = (do
ImportHashed
importHashed <- Parser ImportHashed
importHashed_
ImportMode
importMode <- Parser ImportMode
alternative Parser ImportMode -> Parser ImportMode -> Parser ImportMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImportMode -> Parser ImportMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportMode
Code
Import -> Parser Import
forall (m :: * -> *) a. Monad m => a -> m a
return (Import :: ImportHashed -> ImportMode -> Import
Import {ImportHashed
ImportMode
importMode :: ImportMode
importHashed :: ImportHashed
importMode :: ImportMode
importHashed :: ImportHashed
..}) ) Parser Import -> String -> Parser Import
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"import"
where
alternative :: Parser ImportMode
alternative = do
Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser ()
whitespace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
_as Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
nonemptyWhitespace)
(Parser ()
_Text Parser () -> Parser ImportMode -> Parser ImportMode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ImportMode -> Parser ImportMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportMode
RawText) Parser ImportMode -> Parser ImportMode -> Parser ImportMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
_Location Parser () -> Parser ImportMode -> Parser ImportMode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ImportMode -> Parser ImportMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportMode
Location)