{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- |

module JL.Parser where

import           Control.Monad.Catch
import           Data.Functor
import qualified Data.HashMap.Strict as HM
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import           JL.Tokenizer
import           JL.Types
import           Text.Parsec hiding (satisfy, anyToken)

parseText :: MonadThrow m => SourceName -> Text -> m Expression
parseText :: SourceName -> Text -> m Expression
parseText SourceName
fp Text
inp =
  case Parsec Text () [(Token, Location)]
-> SourceName -> Text -> Either ParseError [(Token, Location)]
forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse Parsec Text () [(Token, Location)]
tokensTokenizer SourceName
fp (Text
inp) of
    Left ParseError
e -> ParseException -> m Expression
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> ParseException
TokenizerError ParseError
e)
    Right [(Token, Location)]
tokens' ->
      case Parsec [(Token, Location)] Int Expression
-> Int
-> SourceName
-> [(Token, Location)]
-> Either ParseError Expression
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> SourceName -> s -> Either ParseError a
runParser (Parsec [(Token, Location)] Int Expression
TokenParser Expression
expressionParser Parsec [(Token, Location)] Int Expression
-> ParsecT [(Token, Location)] Int Identity ()
-> Parsec [(Token, Location)] Int Expression
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [(Token, Location)] Int Identity ()
TokenParser ()
endOfTokens) Int
0 SourceName
fp [(Token, Location)]
tokens' of
        Left ParseError
e -> ParseException -> m Expression
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> ParseException
ParserError ParseError
e)
        Right Expression
ast -> Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
ast

expressionParser :: TokenParser Expression
expressionParser :: ParsecT s Int m Expression
expressionParser = ParsecT s Int m Expression
pipes
  where
    pipes :: ParsecT s Int m Expression
pipes = do
      [Expression]
ps <- ParsecT s Int m Expression
-> ParsecT s Int m Location -> ParsecT s Int m [Expression]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT s Int m Expression
dollars (Token -> TokenParser Location
equalToken Token
Bar)
      case [Expression]
ps of
        [Expression
p] -> Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
p
        [] -> SourceName -> ParsecT s Int m Expression
forall s (m :: * -> *) t u a.
Stream s m t =>
SourceName -> ParsecT s u m a
unexpected SourceName
"empty expression"
        (Expression
p:[Expression]
ps') ->
          Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ((Expression -> Expression -> Expression)
-> Expression -> [Expression] -> Expression
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
               (\Expression
x Expression
y ->
                  Expression -> Expression -> Expression
ApplicationExpression
                    (Expression -> Expression -> Expression
ApplicationExpression
                       (Variable -> Expression
VariableExpression (Text -> Variable
Variable Text
"compose"))
                       Expression
x)
                    Expression
y)
               Expression
p
               [Expression]
ps')
    dollars :: ParsecT s Int m Expression
dollars = do
      [Expression]
ps <- ParsecT s Int m Expression
-> ParsecT s Int m Location -> ParsecT s Int m [Expression]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT s Int m Expression
dollarable (Token -> TokenParser Location
equalToken Token
Dollar)
      case [Expression]
ps of
        [Expression
p] -> Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
p
        (Expression
p:[Expression]
ps') -> Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expression -> Expression -> Expression)
-> Expression -> [Expression] -> Expression
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Expression -> Expression -> Expression
ApplicationExpression Expression
p [Expression]
ps')
        [] -> SourceName -> ParsecT s Int m Expression
forall s (m :: * -> *) t u a.
Stream s m t =>
SourceName -> ParsecT s u m a
unexpected SourceName
"empty expression"
      where
        dollarable :: ParsecT s Int m Expression
dollarable =
          ParsecT s Int m Expression
array ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
record ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
TokenParser Expression
lambda ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
TokenParser Expression
ifParser ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
infix' ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
app ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
TokenParser Expression
atomic
    array :: ParsecT s Int m Expression
array = do
      ParsecT s Int m Location -> ParsecT s Int m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token -> TokenParser Location
equalToken Token
OpenBracket) ParsecT s Int m () -> SourceName -> ParsecT s Int m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> (SourceName
"open bracket " SourceName -> SourceName -> SourceName
forall a. Semigroup a => a -> a -> a
<> SourceName -> SourceName
curlyQuotes SourceName
"[")
      [Expression]
es <- ParsecT s Int m Expression
-> ParsecT s Int m () -> ParsecT s Int m [Expression]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT s Int m Expression
TokenParser Expression
expressionParser (ParsecT s Int m Location -> ParsecT s Int m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token -> TokenParser Location
equalToken Token
Comma))
      ParsecT s Int m Location -> ParsecT s Int m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token -> TokenParser Location
equalToken Token
CloseBracket) ParsecT s Int m () -> SourceName -> ParsecT s Int m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> (SourceName
"closing bracket " SourceName -> SourceName -> SourceName
forall a. Semigroup a => a -> a -> a
<> SourceName -> SourceName
curlyQuotes SourceName
"]")
      Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Expression -> Expression
ArrayExpression ([Expression] -> Vector Expression
forall a. [a] -> Vector a
V.fromList [Expression]
es))
    record :: ParsecT s Int m Expression
record = do
      Location
_ <- Token -> TokenParser Location
equalToken Token
OpenBrace
      [(Text, Expression)]
pairs' <- ParsecT s Int m (Text, Expression)
-> ParsecT s Int m Location -> ParsecT s Int m [(Text, Expression)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT s Int m (Text, Expression)
pair (Token -> TokenParser Location
equalToken Token
Comma ParsecT s Int m Location -> SourceName -> ParsecT s Int m Location
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName -> SourceName
curlyQuotes SourceName
",")
      Location
_ <- Token -> TokenParser Location
equalToken Token
CloseBrace ParsecT s Int m Location -> SourceName -> ParsecT s Int m Location
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> (SourceName
"closing brace " SourceName -> SourceName -> SourceName
forall a. Semigroup a => a -> a -> a
<> SourceName -> SourceName
curlyQuotes SourceName
"}")
      Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text Expression -> Expression
RecordExpression ([(Text, Expression)] -> HashMap Text Expression
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text, Expression)]
pairs'))
      where
        pair :: ParsecT s Int m (Text, Expression)
pair = do
          Text
var <-
            ((Text, Location) -> Text)
-> ParsecT s Int m (Text, Location) -> ParsecT s Int m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              (Text, Location) -> Text
forall a b. (a, b) -> a
fst
              ((Token -> Maybe Text) -> TokenParser (Text, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
                 (\case
                    VariableToken Text
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
                    Token
_ -> Maybe Text
forall a. Maybe a
Nothing)) ParsecT s Int m Text
-> ParsecT s Int m Text -> ParsecT s Int m Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            ((Text, Location) -> Text)
-> ParsecT s Int m (Text, Location) -> ParsecT s Int m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
              (Text, Location) -> Text
forall a b. (a, b) -> a
fst
              ((Token -> Maybe Text) -> TokenParser (Text, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
                 (\case
                    StringToken Text
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c
                    Token
_ -> Maybe Text
forall a. Maybe a
Nothing))
          Location
_ <- Token -> TokenParser Location
equalToken Token
Colon
          Expression
e <- ParsecT s Int m Expression
TokenParser Expression
expressionParser
          (Text, Expression) -> ParsecT s Int m (Text, Expression)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
var, Expression
e)
    app :: ParsecT s Int m Expression
app = do
      Expression
left <- ParsecT s Int m Expression
funcOp ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function expression"
      [Expression]
right <- ParsecT s Int m Expression -> ParsecT s Int m [Expression]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s Int m Expression
unambiguous ParsecT s Int m [Expression]
-> SourceName -> ParsecT s Int m [Expression]
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function arguments"
      case [Expression]
right of
        [] -> Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
left
        [Expression]
_ -> Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expression -> Expression -> Expression)
-> Expression -> [Expression] -> Expression
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Expression -> Expression -> Expression
ApplicationExpression) Expression
left [Expression]
right)
    infix' :: ParsecT s Int m Expression
infix' =
      (do Expression
left <- (ParsecT s Int m Expression
app ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
unambiguous) ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"left-hand side of operator"
          Maybe (Token, Location)
tok <- ((Token, Location) -> Maybe (Token, Location))
-> ParsecT s Int m (Token, Location)
-> ParsecT s Int m (Maybe (Token, Location))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Token, Location) -> Maybe (Token, Location)
forall a. a -> Maybe a
Just (ParsecT s Int m (Token, Location)
operator ParsecT s Int m (Token, Location)
-> SourceName -> ParsecT s Int m (Token, Location)
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"infix operator") ParsecT s Int m (Maybe (Token, Location))
-> ParsecT s Int m (Maybe (Token, Location))
-> ParsecT s Int m (Maybe (Token, Location))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe (Token, Location)
-> ParsecT s Int m (Maybe (Token, Location))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Token, Location)
forall a. Maybe a
Nothing
          case Maybe (Token, Location)
tok of
            Just (Operator Text
t, Location
_) -> do
              Expression
right <-
                (ParsecT s Int m Expression
app ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
unambiguous) ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?>
                (SourceName
"right-hand side of " SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++
                 SourceName -> SourceName
curlyQuotes (Text -> SourceName
T.unpack Text
t) SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++ SourceName
" operator")
              Maybe (Token, Location)
badop <- ((Token, Location) -> Maybe (Token, Location))
-> ParsecT s Int m (Token, Location)
-> ParsecT s Int m (Maybe (Token, Location))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Token, Location) -> Maybe (Token, Location)
forall a. a -> Maybe a
Just (ParsecT s Int m (Token, Location)
-> ParsecT s Int m (Token, Location)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT s Int m (Token, Location)
operator) ParsecT s Int m (Maybe (Token, Location))
-> ParsecT s Int m (Maybe (Token, Location))
-> ParsecT s Int m (Maybe (Token, Location))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe (Token, Location)
-> ParsecT s Int m (Maybe (Token, Location))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Token, Location)
forall a. Maybe a
Nothing
              let infixexp :: Expression
infixexp = Expression -> Variable -> Expression -> Expression
InfixExpression Expression
left (Text -> Variable
Variable Text
t) Expression
right
              ParsecT s Int m ()
-> ((Token, Location) -> ParsecT s Int m ())
-> Maybe (Token, Location)
-> ParsecT s Int m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (() -> ParsecT s Int m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                (\(Token, Location)
op ->
                   SourceName -> ParsecT s Int m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
SourceName -> ParsecT s u m a
unexpected
                     ([SourceName] -> SourceName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                        [ (Token, Location) -> SourceName
tokenString (Token, Location)
op SourceName -> SourceName -> SourceName
forall a. [a] -> [a] -> [a]
++
                          SourceName
". When more than one operator is used\n"
                        , SourceName
"in the same expression, use parentheses."
                        ]))
                Maybe (Token, Location)
badop
              Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
infixexp
            Maybe (Token, Location)
_ -> Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
left) ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?>
      SourceName
"infix expression (e.g. x * y)"
      where
        operator :: ParsecT s Int m (Token, Location)
operator =
          (Token -> Bool) -> TokenParser (Token, Location)
satisfyToken
            (\case
               Operator {} -> Bool
True
               Token
_ -> Bool
False)
    funcOp :: ParsecT s Int m Expression
funcOp = do
      let collectsubscripts :: ([Subscript] -> a) -> b -> ParsecT s Int m (a, b)
collectsubscripts [Subscript] -> a
ks b
a = do
            Bool
bracket' <-
              (Location -> Bool)
-> ParsecT s Int m Location -> ParsecT s Int m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Location -> Bool
forall a b. a -> b -> a
const Bool
True) (Token -> TokenParser Location
equalToken Token
OpenBracket) ParsecT s Int m Bool
-> ParsecT s Int m Bool -> ParsecT s Int m Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT s Int m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            if Bool
bracket'
              then do
                Expression
k <- ParsecT s Int m Expression
TokenParser Expression
expressionParser
                Location
_ <- Token -> TokenParser Location
equalToken Token
CloseBracket
                ([Subscript] -> a) -> b -> ParsecT s Int m (a, b)
collectsubscripts ([Subscript] -> a
ks ([Subscript] -> a)
-> ([Subscript] -> [Subscript]) -> [Subscript] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expression -> Subscript
ExpressionSubscript Expression
k Subscript -> [Subscript] -> [Subscript]
forall a. a -> [a] -> [a]
:)) b
a
              else do
                Bool
dot <- (Location -> Bool)
-> ParsecT s Int m Location -> ParsecT s Int m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Location -> Bool
forall a b. a -> b -> a
const Bool
True) (Token -> TokenParser Location
equalToken Token
Period) ParsecT s Int m Bool
-> ParsecT s Int m Bool -> ParsecT s Int m Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> ParsecT s Int m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                if Bool
dot
                  then do
                    Text
k <-
                      ((Text, Location) -> Text)
-> ParsecT s Int m (Text, Location) -> ParsecT s Int m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                        (Text, Location) -> Text
forall a b. (a, b) -> a
fst
                        ((Token -> Maybe Text) -> TokenParser (Text, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
                           (\case
                              VariableToken Text
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
                              Integer Integer
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just (SourceName -> Text
T.pack (Integer -> SourceName
forall a. Show a => a -> SourceName
show Integer
i))
                              Token
_ -> Maybe Text
forall a. Maybe a
Nothing))
                    ([Subscript] -> a) -> b -> ParsecT s Int m (a, b)
collectsubscripts ([Subscript] -> a
ks ([Subscript] -> a)
-> ([Subscript] -> [Subscript]) -> [Subscript] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Subscript
PropertySubscript Text
k Subscript -> [Subscript] -> [Subscript]
forall a. a -> [a] -> [a]
:)) b
a
                  else (a, b) -> ParsecT s Int m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Subscript] -> a
ks [], b
a)
      Expression
a <- ParsecT s Int m Expression
TokenParser Expression
varParser ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
parensExpr
      ([Subscript]
subscripts, Expression
b) <- ([Subscript] -> [Subscript])
-> Expression -> ParsecT s Int m ([Subscript], Expression)
forall s (m :: * -> *) a b.
Stream s m (Token, Location) =>
([Subscript] -> a) -> b -> ParsecT s Int m (a, b)
collectsubscripts [Subscript] -> [Subscript]
forall a. a -> a
id Expression
a
      if [Subscript] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Subscript]
subscripts
         then case Expression
b of
                VariableExpression (Variable Text
"_") -> SourceName -> ParsecT s Int m Expression
forall s (m :: * -> *) t u a.
Stream s m t =>
SourceName -> ParsecT s u m a
unexpected SourceName
"wildcard without subscript"
                Expression
_ -> Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression
a
         else Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Subscripted -> [Subscript] -> Expression
SubscriptExpression
                      (case Expression
b of
                         VariableExpression (Variable Text
"_") -> Subscripted
WildcardSubscripted
                         Expression
_ -> Expression -> Subscripted
ExpressionSubscripted Expression
b)
                      [Subscript]
subscripts)
    unambiguous :: ParsecT s Int m Expression
unambiguous = ParsecT s Int m Expression
funcOp ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
record ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
TokenParser Expression
atomic
    parensExpr :: ParsecT s Int m Expression
parensExpr = TokenParser Expression -> TokenParser Expression
forall a. TokenParser a -> TokenParser a
parens TokenParser Expression
expressionParser

parens :: TokenParser a -> TokenParser a
parens :: TokenParser a -> TokenParser a
parens TokenParser a
p = ParsecT s Int m a
go ParsecT s Int m a -> SourceName -> ParsecT s Int m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"parens e.g. (x)"
  where
    go :: ParsecT s Int m a
go = do
      Location
_ <- Token -> TokenParser Location
equalToken Token
OpenParen
      a
e <- ParsecT s Int m a
TokenParser a
p ParsecT s Int m a -> SourceName -> ParsecT s Int m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"expression inside parentheses e.g. (foo)"
      Location
_ <- Token -> TokenParser Location
equalToken Token
CloseParen ParsecT s Int m Location -> SourceName -> ParsecT s Int m Location
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"closing parenthesis ‘)’"
      a -> ParsecT s Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
e

varParser :: TokenParser Expression
varParser :: ParsecT s Int m Expression
varParser = ParsecT s Int m Expression
go ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"variable (e.g. ‘foo’, ‘id’, etc.)"
  where
    go :: ParsecT s Int m Expression
go = do
      (Text
v, Location
_) <-
        (Token -> Maybe Text) -> TokenParser (Text, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
          (\case
             VariableToken Text
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
             Token
_ -> Maybe Text
forall a. Maybe a
Nothing)
      Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Variable -> Expression
VariableExpression (Text -> Variable
Variable Text
v))

ifParser :: TokenParser Expression
ifParser :: ParsecT s Int m Expression
ifParser = ParsecT s Int m Expression
go ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"if expression (e.g. ‘if p then x else y’)"
  where
    go :: ParsecT s Int m Expression
go = do
      Location
_ <- Token -> TokenParser Location
equalToken Token
If
      Expression
p <- ParsecT s Int m Expression
TokenParser Expression
expressionParser ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"condition expresion of if-expression"
      Location
_ <- Token -> TokenParser Location
equalToken Token
Then ParsecT s Int m Location -> SourceName -> ParsecT s Int m Location
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"‘then’ keyword for if-expression"
      Expression
e1 <- ParsecT s Int m Expression
TokenParser Expression
expressionParser ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"‘then’ clause of if-expression"
      Location
_ <- Token -> TokenParser Location
equalToken Token
Else ParsecT s Int m Location -> SourceName -> ParsecT s Int m Location
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"‘else’ keyword for if-expression"
      Expression
e2 <- ParsecT s Int m Expression
TokenParser Expression
expressionParser ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"‘else’ clause of if-expression"
      Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> Expression -> Expression -> Expression
IfExpression Expression
p Expression
e1 Expression
e2)

atomic :: TokenParser Expression
atomic :: ParsecT s Int m Expression
atomic =
  ParsecT s Int m Expression
nullParser ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
boolParser ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
TokenParser Expression
varParser ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
TokenParser Expression
stringParser ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s Int m Expression
integerParser ParsecT s Int m Expression
-> ParsecT s Int m Expression -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  ParsecT s Int m Expression
decimalParser
  where

    integerParser :: ParsecT s Int m Expression
integerParser = ParsecT s Int m Expression
go ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"integer (e.g. 42, 123)"
      where
        go :: ParsecT s Int m Expression
go = do
          (Integer
c, Location
_) <-
            (Token -> Maybe Integer) -> TokenParser (Integer, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
              (\case
                 Integer Integer
c -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
c
                 Token
_ -> Maybe Integer
forall a. Maybe a
Nothing)
          Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant -> Expression
ConstantExpression (Scientific -> Constant
NumberConstant (Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c)))
    decimalParser :: ParsecT s Int m Expression
decimalParser = ParsecT s Int m Expression
go ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"decimal (e.g. 42, 123)"
      where
        go :: ParsecT s Int m Expression
go = do
          (Double
c, Location
_) <-
            (Token -> Maybe Double) -> TokenParser (Double, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
              (\case
                 Decimal Double
c -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
c
                 Token
_ -> Maybe Double
forall a. Maybe a
Nothing)
          Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant -> Expression
ConstantExpression (Scientific -> Constant
NumberConstant (Double -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
c)))
    boolParser :: ParsecT s Int m Expression
boolParser = ParsecT s Int m Expression
go ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"boolean (e.g. true, false)"
      where
        go :: ParsecT s Int m Expression
go = do
          (Bool
c, Location
_) <-
            (Token -> Maybe Bool) -> TokenParser (Bool, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
              (\case
                 Token
TrueToken -> Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                 Token
FalseToken -> Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                 Token
_ -> Maybe Bool
forall a. Maybe a
Nothing)
          Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant -> Expression
ConstantExpression (Bool -> Constant
BoolConstant Bool
c))
    nullParser :: ParsecT s Int m Expression
nullParser = ParsecT s Int m Expression
go ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"null"
      where
        go :: ParsecT s Int m Expression
go = do
          ((), Location
_) <-
            (Token -> Maybe ()) -> TokenParser ((), Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
              (\case
                 Token
NullToken -> () -> Maybe ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                 Token
_ -> Maybe ()
forall a. Maybe a
Nothing)
          Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant -> Expression
ConstantExpression Constant
NullConstant)

stringParser :: TokenParser Expression
stringParser :: ParsecT s Int m Expression
stringParser = ParsecT s Int m Expression
go ParsecT s Int m Expression
-> SourceName -> ParsecT s Int m Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"string (e.g. \"a\")"
  where
    go :: ParsecT s Int m Expression
go = do
      (Text
c, Location
_) <-
        (Token -> Maybe Text) -> TokenParser (Text, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
          (\case
             StringToken Text
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c
             Token
_ -> Maybe Text
forall a. Maybe a
Nothing)
      Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant -> Expression
ConstantExpression (Text -> Constant
StringConstant Text
c))

lambda :: TokenParser (Expression)
lambda :: ParsecT s Int m Expression
lambda = do
  Location
_ <- Token -> TokenParser Location
equalToken Token
Backslash ParsecT s Int m Location -> SourceName -> ParsecT s Int m Location
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"lambda expression (e.g. \\x -> x)"
  [Variable]
args <- ParsecT s Int m Variable -> ParsecT s Int m [Variable]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s Int m Variable
TokenParser Variable
funcParam ParsecT s Int m [Variable]
-> SourceName -> ParsecT s Int m [Variable]
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"lambda parameters"
  Location
_ <- Token -> TokenParser Location
equalToken Token
RightArrow
  Expression
e <- ParsecT s Int m Expression
TokenParser Expression
expressionParser
  Expression -> ParsecT s Int m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expression -> Variable -> Expression)
-> Expression -> [Variable] -> Expression
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Expression
e' Variable
arg -> Variable -> Expression -> Expression
LambdaExpression Variable
arg Expression
e') Expression
e ([Variable] -> [Variable]
forall a. [a] -> [a]
reverse [Variable]
args))

funcParam :: TokenParser Variable
funcParam :: ParsecT s Int m Variable
funcParam = ParsecT s Int m Variable
go ParsecT s Int m Variable -> SourceName -> ParsecT s Int m Variable
forall s u (m :: * -> *) a.
ParsecT s u m a -> SourceName -> ParsecT s u m a
<?> SourceName
"function parameter (e.g. ‘x’, ‘limit’, etc.)"
  where
    go :: ParsecT s Int m Variable
go = do
      (Text
v, Location
_) <-
        (Token -> Maybe Text) -> TokenParser (Text, Location)
forall a. (Token -> Maybe a) -> TokenParser (a, Location)
consumeToken
          (\case
             VariableToken Text
i -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
i
             Token
_ -> Maybe Text
forall a. Maybe a
Nothing)
      Variable -> ParsecT s Int m Variable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Variable
Variable Text
v)