{-# LANGUAGE OverloadedStrings #-}

module Aihc.Parser.Internal.Expr
  ( exprParser,
    equationRhsParser,
    simplePatternParser,
    appPatternParser,
    patternParser,
    typeParser,
    typeAppParser,
    typeAtomParser,
  )
where

import Aihc.Parser.Internal.Common
import Aihc.Parser.Lex (LexToken (..), LexTokenKind (..), lexTokenKind, lexTokenSpan, lexTokenText)
import Aihc.Parser.Syntax
import Control.Monad (guard)
import Data.Char (isLower, isUpper)
import Data.Text (Text)
import Data.Text qualified as T
import Text.Megaparsec (anySingle, lookAhead, (<|>))
import Text.Megaparsec qualified as MP

exprParser :: TokParser Expr
exprParser :: TokParser Expr
exprParser = do
  core <- TokParser Expr
exprCoreParser
  mWhere <- MP.optional whereClauseParser
  pure $
    case mWhere of
      Just [Decl]
decls -> SourceSpan -> Expr -> [Decl] -> Expr
EWhereDecls (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Expr -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Expr
core) ([Decl] -> SourceSpan
forall a. HasSourceSpan a => [a] -> SourceSpan
sourceSpanEnd [Decl]
decls)) Expr
core [Decl]
decls
      Maybe [Decl]
Nothing -> Expr
core

exprParserExcept :: [Text] -> TokParser Expr
exprParserExcept :: [Text] -> TokParser Expr
exprParserExcept [Text]
forbiddenInfix = do
  core <- [Text] -> TokParser Expr
exprCoreParserExcept [Text]
forbiddenInfix
  mWhere <- MP.optional whereClauseParser
  pure $
    case mWhere of
      Just [Decl]
decls -> SourceSpan -> Expr -> [Decl] -> Expr
EWhereDecls (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Expr -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Expr
core) ([Decl] -> SourceSpan
forall a. HasSourceSpan a => [a] -> SourceSpan
sourceSpanEnd [Decl]
decls)) Expr
core [Decl]
decls
      Maybe [Decl]
Nothing -> Expr
core

exprCoreParser :: TokParser Expr
exprCoreParser :: TokParser Expr
exprCoreParser = [Text] -> TokParser Expr
exprCoreParserExcept []

exprCoreParserExcept :: [Text] -> TokParser Expr
exprCoreParserExcept :: [Text] -> TokParser Expr
exprCoreParserExcept [Text]
forbiddenInfix = do
  tok <- ParsecT Void TokStream Identity LexToken
-> ParsecT Void TokStream Identity LexToken
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void TokStream Identity (Token TokStream)
ParsecT Void TokStream Identity LexToken
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
  base <- case lexTokenKind tok of
    LexTokenKind
TkKeywordDo -> TokParser Expr
doExprParser
    LexTokenKind
TkKeywordIf -> TokParser Expr
ifExprParser
    LexTokenKind
TkKeywordCase -> TokParser Expr
caseExprParser
    LexTokenKind
TkKeywordLet -> TokParser Expr
letExprParser
    LexTokenKind
TkReservedBackslash -> TokParser Expr
lambdaExprParser
    LexTokenKind
_ -> [Text] -> TokParser Expr
infixExprParserExcept [Text]
forbiddenInfix
  -- Optional type signature: expr :: type
  mTypeSig <- MP.optional (expectedTok TkReservedDoubleColon *> typeParser)
  pure $ case mTypeSig of
    Just Type
ty -> SourceSpan -> Expr -> Type -> Expr
ETypeSig (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Expr -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Expr
base) (Type -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Type
ty)) Expr
base Type
ty
    Maybe Type
Nothing -> Expr
base

ifExprParser :: TokParser Expr
ifExprParser :: TokParser Expr
ifExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordIf
  cond <- TokParser Expr
exprParser
  skipSemicolons
  keywordTok TkKeywordThen
  yes <- exprParser
  skipSemicolons
  keywordTok TkKeywordElse
  no <- exprParser
  pure (\SourceSpan
span' -> SourceSpan -> Expr -> Expr -> Expr -> Expr
EIf SourceSpan
span' Expr
cond Expr
yes Expr
no)

doExprParser :: TokParser Expr
doExprParser :: TokParser Expr
doExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordDo
  stmts <- TokParser DoStmt -> TokParser [DoStmt]
forall a. TokParser a -> TokParser [a]
bracedStmtListParser TokParser DoStmt
doStmtParser
  pure (`EDo` stmts)

bracedStmtListParser :: TokParser a -> TokParser [a]
bracedStmtListParser :: forall a. TokParser a -> TokParser [a]
bracedStmtListParser = TokParser a -> TokParser [a]
forall a. TokParser a -> TokParser [a]
bracedSemiSep1

doStmtParser :: TokParser DoStmt
doStmtParser :: TokParser DoStmt
doStmtParser = TokParser DoStmt -> TokParser DoStmt
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser DoStmt
doBindStmtParser TokParser DoStmt -> TokParser DoStmt -> TokParser DoStmt
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser DoStmt -> TokParser DoStmt
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser DoStmt
doLetStmtParser TokParser DoStmt -> TokParser DoStmt -> TokParser DoStmt
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser DoStmt
doExprStmtParser

doBindStmtParser :: TokParser DoStmt
doBindStmtParser :: TokParser DoStmt
doBindStmtParser = TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt)
-> TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt
forall a b. (a -> b) -> a -> b
$ do
  pat <- TokParser Pattern
patternParser
  expectedTok TkReservedLeftArrow
  expr <- exprParser
  pure (\SourceSpan
span' -> SourceSpan -> Pattern -> Expr -> DoStmt
DoBind SourceSpan
span' Pattern
pat Expr
expr)

parseLetDeclsParser :: TokParser [Decl]
parseLetDeclsParser :: ParsecT Void TokStream Identity [Decl]
parseLetDeclsParser = do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordLet
  ParsecT Void TokStream Identity [Decl]
bracedDeclsParser ParsecT Void TokStream Identity [Decl]
-> ParsecT Void TokStream Identity [Decl]
-> ParsecT Void TokStream Identity [Decl]
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity [Decl]
plainDeclsParser

parseLetDeclsStmtParser :: TokParser [Decl]
parseLetDeclsStmtParser :: ParsecT Void TokStream Identity [Decl]
parseLetDeclsStmtParser = do
  decls <- ParsecT Void TokStream Identity [Decl]
parseLetDeclsParser
  MP.notFollowedBy (keywordTok TkKeywordIn)
  pure decls

doLetStmtParser :: TokParser DoStmt
doLetStmtParser :: TokParser DoStmt
doLetStmtParser = TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt)
-> TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt
forall a b. (a -> b) -> a -> b
$ do
  decls <- ParsecT Void TokStream Identity [Decl]
parseLetDeclsStmtParser
  pure (`DoLetDecls` decls)

doExprStmtParser :: TokParser DoStmt
doExprStmtParser :: TokParser DoStmt
doExprStmtParser = TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt)
-> TokParser (SourceSpan -> DoStmt) -> TokParser DoStmt
forall a b. (a -> b) -> a -> b
$ do
  expr <- TokParser Expr
exprParser
  pure (`DoExpr` expr)

infixExprParserExcept :: [Text] -> TokParser Expr
infixExprParserExcept :: [Text] -> TokParser Expr
infixExprParserExcept [Text]
forbidden = do
  lhs <- TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Expr
negateExprParser TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
lexpParser
  rest <- MP.many ((,) <$> infixOperatorParserExcept forbidden <*> lexpParser)
  pure (foldl buildInfix lhs rest)

-- | Parse an lexp (left-expression) - includes do, if, case, let, lambda, and fexp.
-- This is used on both sides of infix operators per the Haskell Report grammar.
lexpParser :: TokParser Expr
lexpParser :: TokParser Expr
lexpParser = do
  tok <- ParsecT Void TokStream Identity LexToken
-> ParsecT Void TokStream Identity LexToken
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void TokStream Identity (Token TokStream)
ParsecT Void TokStream Identity LexToken
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
  case lexTokenKind tok of
    LexTokenKind
TkKeywordDo -> TokParser Expr
doExprParser
    LexTokenKind
TkKeywordIf -> TokParser Expr
ifExprParser
    LexTokenKind
TkKeywordCase -> TokParser Expr
caseExprParser
    LexTokenKind
TkKeywordLet -> TokParser Expr
letExprParser
    LexTokenKind
TkReservedBackslash -> TokParser Expr
lambdaExprParser
    LexTokenKind
_ -> TokParser Expr
appExprParser

buildInfix :: Expr -> (Text, Expr) -> Expr
buildInfix :: Expr -> (Text, Expr) -> Expr
buildInfix Expr
lhs (Text
op, Expr
rhs) =
  SourceSpan -> Expr -> Text -> Expr -> Expr
EInfix (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Expr -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Expr
lhs) (Expr -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Expr
rhs)) Expr
lhs Text
op Expr
rhs

infixOperatorParserExcept :: [Text] -> TokParser Text
infixOperatorParserExcept :: [Text] -> ParsecT Void TokStream Identity Text
infixOperatorParserExcept [Text]
forbidden =
  ParsecT Void TokStream Identity Text
symbolicOperatorParser ParsecT Void TokStream Identity Text
-> ParsecT Void TokStream Identity Text
-> ParsecT Void TokStream Identity Text
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Text
backtickIdentifierOperatorParser
  where
    symbolicOperatorParser :: ParsecT Void TokStream Identity Text
symbolicOperatorParser =
      String
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"infix operator" ((LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text)
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
        case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
          TkVarSym Text
op | Text
op Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
forbidden -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
          TkConSym Text
op | Text
op Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
forbidden -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
          TkQVarSym Text
op | Text
op Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
forbidden -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
          TkQConSym Text
op | Text
op Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
forbidden -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
          -- TkMinusOperator is minus when LexicalNegation is enabled but used as infix
          LexTokenKind
TkMinusOperator | Text
"-" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
forbidden -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"-"
          -- Reserved operators that can be used as infix operators
          LexTokenKind
TkReservedColon | Text
":" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
forbidden -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
":"
          LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing

    backtickIdentifierOperatorParser :: ParsecT Void TokStream Identity Text
backtickIdentifierOperatorParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialBacktick
      op <- ParsecT Void TokStream Identity Text
identifierTextParser
      expectedTok TkSpecialBacktick
      if op `elem` forbidden then fail "forbidden infix operator" else pure op

intExprParser :: TokParser Expr
intExprParser :: TokParser Expr
intExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  (n, repr) <- String
-> (LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"integer literal" ((LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text))
-> (LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkInteger Integer
i -> (Integer, Text) -> Maybe (Integer, Text)
forall a. a -> Maybe a
Just (Integer
i, LexToken -> Text
lexTokenText LexToken
tok)
      LexTokenKind
_ -> Maybe (Integer, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Integer -> Text -> Expr
EInt SourceSpan
span' Integer
n Text
repr)

intBaseExprParser :: TokParser Expr
intBaseExprParser :: TokParser Expr
intBaseExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  (n, repr) <- String
-> (LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"based integer literal" ((LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text))
-> (LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkIntegerBase Integer
i Text
txt -> (Integer, Text) -> Maybe (Integer, Text)
forall a. a -> Maybe a
Just (Integer
i, Text
txt)
      LexTokenKind
_ -> Maybe (Integer, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Integer -> Text -> Expr
EIntBase SourceSpan
span' Integer
n Text
repr)

floatExprParser :: TokParser Expr
floatExprParser :: TokParser Expr
floatExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  (n, repr) <- String
-> (LexToken -> Maybe (Double, Text)) -> TokParser (Double, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"floating literal" ((LexToken -> Maybe (Double, Text)) -> TokParser (Double, Text))
-> (LexToken -> Maybe (Double, Text)) -> TokParser (Double, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkFloat Double
x Text
txt -> (Double, Text) -> Maybe (Double, Text)
forall a. a -> Maybe a
Just (Double
x, Text
txt)
      LexTokenKind
_ -> Maybe (Double, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Double -> Text -> Expr
EFloat SourceSpan
span' Double
n Text
repr)

charExprParser :: TokParser Expr
charExprParser :: TokParser Expr
charExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  (c, repr) <- String
-> (LexToken -> Maybe (Char, Text)) -> TokParser (Char, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"character literal" ((LexToken -> Maybe (Char, Text)) -> TokParser (Char, Text))
-> (LexToken -> Maybe (Char, Text)) -> TokParser (Char, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkChar Char
x -> (Char, Text) -> Maybe (Char, Text)
forall a. a -> Maybe a
Just (Char
x, LexToken -> Text
lexTokenText LexToken
tok)
      LexTokenKind
_ -> Maybe (Char, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Char -> Text -> Expr
EChar SourceSpan
span' Char
c Text
repr)

stringExprParser :: TokParser Expr
stringExprParser :: TokParser Expr
stringExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  (s, repr) <- String
-> (LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"string literal" ((LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text))
-> (LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkString Text
x -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
x, LexToken -> Text
lexTokenText LexToken
tok)
      LexTokenKind
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Text -> Text -> Expr
EString SourceSpan
span' Text
s Text
repr)

appExprParser :: TokParser Expr
appExprParser :: TokParser Expr
appExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  first <- TokParser Expr
atomOrRecordExprParser
  rest <- MP.many atomOrRecordExprParser
  pure $ \SourceSpan
span' ->
    (Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SourceSpan -> Expr -> Expr -> Expr
EApp SourceSpan
span') Expr
first [Expr]
rest

-- | Parse an atom, optionally followed by one or more record construction/update syntax.
-- This handles cases like:
--   - Foo { x = 1 }  -- record construction
--   - expr { x = 1 } -- record update
--   - r { a = 1 } { b = 2 } -- chained record update
atomOrRecordExprParser :: TokParser Expr
atomOrRecordExprParser :: TokParser Expr
atomOrRecordExprParser = do
  base <- TokParser Expr
atomExprParser
  applyRecordSuffixes base
  where
    applyRecordSuffixes :: Expr -> TokParser Expr
    applyRecordSuffixes :: Expr -> TokParser Expr
applyRecordSuffixes Expr
e = do
      mRecordFields <- ParsecT Void TokStream Identity [(Text, Maybe Expr, SourceSpan)]
-> ParsecT
     Void TokStream Identity (Maybe [(Text, Maybe Expr, SourceSpan)])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional ParsecT Void TokStream Identity [(Text, Maybe Expr, SourceSpan)]
recordBracesParser
      case mRecordFields of
        Maybe [(Text, Maybe Expr, SourceSpan)]
Nothing -> Expr -> TokParser Expr
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
e
        Just [(Text, Maybe Expr, SourceSpan)]
fields -> do
          let result :: Expr
result = case Expr
e of
                EVar SourceSpan
span' Text
name
                  | Text -> Bool
isConLikeName Text
name ->
                      SourceSpan -> Text -> [(Text, Expr)] -> Expr
ERecordCon (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans SourceSpan
span' ([(Text, Maybe Expr, SourceSpan)] -> SourceSpan
fieldsEndSpan [(Text, Maybe Expr, SourceSpan)]
fields)) Text
name (((Text, Maybe Expr, SourceSpan) -> (Text, Expr))
-> [(Text, Maybe Expr, SourceSpan)] -> [(Text, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe Expr, SourceSpan) -> (Text, Expr)
normalizeField [(Text, Maybe Expr, SourceSpan)]
fields)
                Expr
_ ->
                  SourceSpan -> Expr -> [(Text, Expr)] -> Expr
ERecordUpd (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Expr -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Expr
e) ([(Text, Maybe Expr, SourceSpan)] -> SourceSpan
fieldsEndSpan [(Text, Maybe Expr, SourceSpan)]
fields)) Expr
e (((Text, Maybe Expr, SourceSpan) -> (Text, Expr))
-> [(Text, Maybe Expr, SourceSpan)] -> [(Text, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe Expr, SourceSpan) -> (Text, Expr)
normalizeField [(Text, Maybe Expr, SourceSpan)]
fields)
          -- Recursively check for more record braces (chained updates)
          Expr -> TokParser Expr
applyRecordSuffixes Expr
result

    -- Get the end span from the last field (or the opening brace position)
    fieldsEndSpan :: [(Text, Maybe Expr, SourceSpan)] -> SourceSpan
    fieldsEndSpan :: [(Text, Maybe Expr, SourceSpan)] -> SourceSpan
fieldsEndSpan [] = SourceSpan
NoSourceSpan
    fieldsEndSpan [(Text, Maybe Expr, SourceSpan)]
fs = case [(Text, Maybe Expr, SourceSpan)] -> (Text, Maybe Expr, SourceSpan)
forall a. HasCallStack => [a] -> a
last [(Text, Maybe Expr, SourceSpan)]
fs of (Text
_, Maybe Expr
_, SourceSpan
sp) -> SourceSpan
sp
    -- Normalize field: if no expression given (pun), use field name as expression
    normalizeField :: (Text, Maybe Expr, SourceSpan) -> (Text, Expr)
    normalizeField :: (Text, Maybe Expr, SourceSpan) -> (Text, Expr)
normalizeField (Text
fieldName, Maybe Expr
mExpr, SourceSpan
sp) =
      case Maybe Expr
mExpr of
        Just Expr
expr' -> (Text
fieldName, Expr
expr')
        Maybe Expr
Nothing -> (Text
fieldName, SourceSpan -> Text -> Expr
EVar SourceSpan
sp Text
fieldName) -- NamedFieldPuns: field name becomes variable

-- | Parse record braces: { field = value, field2 = value2, ... }
-- Supports both explicit assignment (field = value) and puns (field)
recordBracesParser :: TokParser [(Text, Maybe Expr, SourceSpan)]
recordBracesParser :: ParsecT Void TokStream Identity [(Text, Maybe Expr, SourceSpan)]
recordBracesParser = do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLBrace
  mClose <- TokParser () -> ParsecT Void TokStream Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRBrace)
  case mClose of
    Just () -> [(Text, Maybe Expr, SourceSpan)]
-> ParsecT Void TokStream Identity [(Text, Maybe Expr, SourceSpan)]
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Maybe ()
Nothing -> do
      fields <- TokParser (Text, Maybe Expr, SourceSpan)
recordFieldBindingParser TokParser (Text, Maybe Expr, SourceSpan)
-> TokParser ()
-> ParsecT Void TokStream Identity [(Text, Maybe Expr, SourceSpan)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
      expectedTok TkSpecialRBrace
      pure fields

-- | Parse a single record field binding: either "field = expr" or just "field" (pun)
recordFieldBindingParser :: TokParser (Text, Maybe Expr, SourceSpan)
recordFieldBindingParser :: TokParser (Text, Maybe Expr, SourceSpan)
recordFieldBindingParser = do
  startPos <- ParsecT Void TokStream Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
MP.getSourcePos
  fieldName <- tokenSatisfy "field name" $ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarId Text
name -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing
  mAssign <- MP.optional (expectedTok TkReservedEquals *> exprParser)
  endPos <- MP.getSourcePos
  pure (fieldName, mAssign, sourceSpanFromPositions startPos endPos)

atomExprParser :: TokParser Expr
atomExprParser :: TokParser Expr
atomExprParser =
  TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Expr
prefixNegateAtomExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Expr
parenOperatorExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
lambdaExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
letExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
parenExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
listExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
intBaseExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
floatExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
intExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
charExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
stringExprParser
    TokParser Expr -> TokParser Expr -> TokParser Expr
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Expr
varExprParser

prefixNegateAtomExprParser :: TokParser Expr
prefixNegateAtomExprParser :: TokParser Expr
prefixNegateAtomExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  TokParser ()
prefixMinusTokenParser
  inner <- TokParser Expr
atomExprParser
  pure (`ENegate` inner)

negateExprParser :: TokParser Expr
negateExprParser :: TokParser Expr
negateExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  _ <- ParsecT Void TokStream Identity LexToken
minusTokenValueParser
  inner <- appExprParser
  pure (`ENegate` inner)

minusTokenValueParser :: TokParser LexToken
minusTokenValueParser :: ParsecT Void TokStream Identity LexToken
minusTokenValueParser =
  String
-> (LexToken -> Maybe LexToken)
-> ParsecT Void TokStream Identity LexToken
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"minus operator" ((LexToken -> Maybe LexToken)
 -> ParsecT Void TokStream Identity LexToken)
-> (LexToken -> Maybe LexToken)
-> ParsecT Void TokStream Identity LexToken
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarSym Text
"-" -> LexToken -> Maybe LexToken
forall a. a -> Maybe a
Just LexToken
tok
      LexTokenKind
TkMinusOperator -> LexToken -> Maybe LexToken
forall a. a -> Maybe a
Just LexToken
tok
      LexTokenKind
TkPrefixMinus -> LexToken -> Maybe LexToken
forall a. a -> Maybe a
Just LexToken
tok
      LexTokenKind
_ -> Maybe LexToken
forall a. Maybe a
Nothing

prefixMinusTokenParser :: TokParser ()
prefixMinusTokenParser :: TokParser ()
prefixMinusTokenParser =
  String -> (LexToken -> Maybe ()) -> TokParser ()
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"prefix minus" ((LexToken -> Maybe ()) -> TokParser ())
-> (LexToken -> Maybe ()) -> TokParser ()
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      LexTokenKind
TkPrefixMinus -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      LexTokenKind
_ -> Maybe ()
forall a. Maybe a
Nothing

parenOperatorExprParser :: TokParser Expr
parenOperatorExprParser :: TokParser Expr
parenOperatorExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLParen
  op <- String
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"operator" ((LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text)
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarSym Text
sym -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
      TkConSym Text
sym -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
      TkQVarSym Text
sym -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
      TkQConSym Text
sym -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
      LexTokenKind
TkMinusOperator -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"-"
      LexTokenKind
TkReservedColon -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
":"
      LexTokenKind
TkReservedDoubleColon -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"::"
      LexTokenKind
TkReservedEquals -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"="
      LexTokenKind
TkReservedPipe -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"|"
      LexTokenKind
TkReservedLeftArrow -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"<-"
      LexTokenKind
TkReservedRightArrow -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"->"
      LexTokenKind
TkReservedDoubleArrow -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"=>"
      LexTokenKind
TkReservedDotDot -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
".."
      -- Note: ~ is now lexed as TkVarSym "~" so TkVarSym case handles it
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing
  expectedTok TkSpecialRParen
  pure (`EVar` op)

patternParser :: TokParser Pattern
patternParser :: TokParser Pattern
patternParser = TokParser Pattern
asPatternParser

asPatternParser :: TokParser Pattern
asPatternParser :: TokParser Pattern
asPatternParser =
  TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try
    ( TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
        name <- ParsecT Void TokStream Identity Text
identifierTextParser
        expectedTok TkReservedAt
        inner <- patternAtomParser
        pure (\SourceSpan
span' -> SourceSpan -> Text -> Pattern -> Pattern
PAs SourceSpan
span' Text
name Pattern
inner)
    )
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
infixPatternParser

infixPatternParser :: TokParser Pattern
infixPatternParser :: TokParser Pattern
infixPatternParser = do
  lhs <- TokParser Pattern
appPatternParser
  rest <- MP.many ((,) <$> conOperatorParser <*> appPatternParser)
  pure (foldl buildInfixPattern lhs rest)

buildInfixPattern :: Pattern -> (Text, Pattern) -> Pattern
buildInfixPattern :: Pattern -> (Text, Pattern) -> Pattern
buildInfixPattern Pattern
lhs (Text
op, Pattern
rhs) =
  SourceSpan -> Pattern -> Text -> Pattern -> Pattern
PInfix (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Pattern -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Pattern
lhs) (Pattern -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Pattern
rhs)) Pattern
lhs Text
op Pattern
rhs

conOperatorParser :: TokParser Text
conOperatorParser :: ParsecT Void TokStream Identity Text
conOperatorParser =
  String
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"constructor operator" ((LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text)
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkConSym Text
op -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
      TkQConSym Text
op -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
      LexTokenKind
TkReservedColon -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
":"
      LexTokenKind
TkReservedDoubleColon -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"::"
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing

appPatternParser :: TokParser Pattern
appPatternParser :: TokParser Pattern
appPatternParser = do
  first <- TokParser Pattern
patternAtomParser
  if isPatternAppHead first
    then do
      rest <- MP.many patternAtomParser
      pure (foldl buildPatternApp first rest)
    else pure first

buildPatternApp :: Pattern -> Pattern -> Pattern
buildPatternApp :: Pattern -> Pattern -> Pattern
buildPatternApp Pattern
lhs Pattern
rhs =
  case Pattern
lhs of
    PCon SourceSpan
lSpan Text
name [Pattern]
args -> SourceSpan -> Text -> [Pattern] -> Pattern
PCon (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans SourceSpan
lSpan (Pattern -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Pattern
rhs)) Text
name ([Pattern]
args [Pattern] -> [Pattern] -> [Pattern]
forall a. Semigroup a => a -> a -> a
<> [Pattern
rhs])
    PVar SourceSpan
lSpan Text
name
      | Text -> Bool
isConLikeName Text
name -> SourceSpan -> Text -> [Pattern] -> Pattern
PCon (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans SourceSpan
lSpan (Pattern -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Pattern
rhs)) Text
name [Pattern
rhs]
    Pattern
_ -> Pattern
lhs

patternAtomParser :: TokParser Pattern
patternAtomParser :: TokParser Pattern
patternAtomParser =
  TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Pattern
strictPatternParser
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Pattern
irrefutablePatternParser
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Pattern
negativeLiteralPatternParser
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
quasiQuotePatternParser
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
wildcardPatternParser
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
literalPatternParser
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
listPatternParser
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
parenOrTuplePatternParser
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
varOrConPatternParser

strictPatternParser :: TokParser Pattern
strictPatternParser :: TokParser Pattern
strictPatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkPrefixBang
  inner <- TokParser Pattern
patternAtomParser
  pure (`PStrict` inner)

irrefutablePatternParser :: TokParser Pattern
irrefutablePatternParser :: TokParser Pattern
irrefutablePatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkPrefixTilde
  inner <- TokParser Pattern
patternAtomParser
  pure (`PIrrefutable` inner)

negativeLiteralPatternParser :: TokParser Pattern
negativeLiteralPatternParser :: TokParser Pattern
negativeLiteralPatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok (Text -> LexTokenKind
TkVarSym Text
"-")
  lit <- TokParser Literal
literalParser
  pure (`PNegLit` lit)

wildcardPatternParser :: TokParser Pattern
wildcardPatternParser :: TokParser Pattern
wildcardPatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordUnderscore
  (SourceSpan -> Pattern) -> TokParser (SourceSpan -> Pattern)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceSpan -> Pattern
PWildcard

literalPatternParser :: TokParser Pattern
literalPatternParser :: TokParser Pattern
literalPatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  lit <- TokParser Literal
literalParser
  pure (`PLit` lit)

quasiQuotePatternParser :: TokParser Pattern
quasiQuotePatternParser :: TokParser Pattern
quasiQuotePatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  (quoter, body) <- String
-> (LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"quasi quote" ((LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text))
-> (LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkQuasiQuote Text
q Text
b -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
q, Text
b)
      LexTokenKind
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Text -> Text -> Pattern
PQuasiQuote SourceSpan
span' Text
quoter Text
body)

literalParser :: TokParser Literal
literalParser :: TokParser Literal
literalParser = TokParser Literal
intLiteralParser TokParser Literal -> TokParser Literal -> TokParser Literal
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Literal
intBaseLiteralParser TokParser Literal -> TokParser Literal -> TokParser Literal
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Literal
floatLiteralParser TokParser Literal -> TokParser Literal -> TokParser Literal
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Literal
charLiteralParser TokParser Literal -> TokParser Literal -> TokParser Literal
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Literal
stringLiteralParser

intLiteralParser :: TokParser Literal
intLiteralParser :: TokParser Literal
intLiteralParser = TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Literal) -> TokParser Literal)
-> TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a b. (a -> b) -> a -> b
$ do
  (n, repr) <- String
-> (LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"integer literal" ((LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text))
-> (LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkInteger Integer
i -> (Integer, Text) -> Maybe (Integer, Text)
forall a. a -> Maybe a
Just (Integer
i, LexToken -> Text
lexTokenText LexToken
tok)
      LexTokenKind
_ -> Maybe (Integer, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Integer -> Text -> Literal
LitInt SourceSpan
span' Integer
n Text
repr)

intBaseLiteralParser :: TokParser Literal
intBaseLiteralParser :: TokParser Literal
intBaseLiteralParser = TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Literal) -> TokParser Literal)
-> TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a b. (a -> b) -> a -> b
$ do
  (n, repr) <- String
-> (LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"based integer literal" ((LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text))
-> (LexToken -> Maybe (Integer, Text)) -> TokParser (Integer, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkIntegerBase Integer
i Text
txt -> (Integer, Text) -> Maybe (Integer, Text)
forall a. a -> Maybe a
Just (Integer
i, Text
txt)
      LexTokenKind
_ -> Maybe (Integer, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Integer -> Text -> Literal
LitIntBase SourceSpan
span' Integer
n Text
repr)

floatLiteralParser :: TokParser Literal
floatLiteralParser :: TokParser Literal
floatLiteralParser = TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Literal) -> TokParser Literal)
-> TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a b. (a -> b) -> a -> b
$ do
  (n, repr) <- String
-> (LexToken -> Maybe (Double, Text)) -> TokParser (Double, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"floating literal" ((LexToken -> Maybe (Double, Text)) -> TokParser (Double, Text))
-> (LexToken -> Maybe (Double, Text)) -> TokParser (Double, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkFloat Double
x Text
txt -> (Double, Text) -> Maybe (Double, Text)
forall a. a -> Maybe a
Just (Double
x, Text
txt)
      LexTokenKind
_ -> Maybe (Double, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Double -> Text -> Literal
LitFloat SourceSpan
span' Double
n Text
repr)

charLiteralParser :: TokParser Literal
charLiteralParser :: TokParser Literal
charLiteralParser = TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Literal) -> TokParser Literal)
-> TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a b. (a -> b) -> a -> b
$ do
  (c, repr) <- String
-> (LexToken -> Maybe (Char, Text)) -> TokParser (Char, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"character literal" ((LexToken -> Maybe (Char, Text)) -> TokParser (Char, Text))
-> (LexToken -> Maybe (Char, Text)) -> TokParser (Char, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkChar Char
x -> (Char, Text) -> Maybe (Char, Text)
forall a. a -> Maybe a
Just (Char
x, LexToken -> Text
lexTokenText LexToken
tok)
      LexTokenKind
_ -> Maybe (Char, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Char -> Text -> Literal
LitChar SourceSpan
span' Char
c Text
repr)

stringLiteralParser :: TokParser Literal
stringLiteralParser :: TokParser Literal
stringLiteralParser = TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Literal) -> TokParser Literal)
-> TokParser (SourceSpan -> Literal) -> TokParser Literal
forall a b. (a -> b) -> a -> b
$ do
  (s, repr) <- String
-> (LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"string literal" ((LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text))
-> (LexToken -> Maybe (Text, Text)) -> TokParser (Text, Text)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkString Text
x -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
x, LexToken -> Text
lexTokenText LexToken
tok)
      LexTokenKind
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
  pure (\SourceSpan
span' -> SourceSpan -> Text -> Text -> Literal
LitString SourceSpan
span' Text
s Text
repr)

rhsParser :: TokParser Rhs
rhsParser :: TokParser Rhs
rhsParser = RhsArrowKind -> TokParser Rhs
rhsParserWithArrow RhsArrowKind
RhsArrowCase

equationRhsParser :: TokParser Rhs
equationRhsParser :: TokParser Rhs
equationRhsParser = RhsArrowKind -> TokParser Rhs
rhsParserWithArrow RhsArrowKind
RhsArrowEquation

-- | The kind of arrow used in RHS parsing
data RhsArrowKind = RhsArrowCase | RhsArrowEquation

rhsArrowText :: RhsArrowKind -> Text
rhsArrowText :: RhsArrowKind -> Text
rhsArrowText RhsArrowKind
RhsArrowCase = Text
"->"
rhsArrowText RhsArrowKind
RhsArrowEquation = Text
"="

rhsArrowTok :: RhsArrowKind -> TokParser ()
rhsArrowTok :: RhsArrowKind -> TokParser ()
rhsArrowTok RhsArrowKind
RhsArrowCase = LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedRightArrow
rhsArrowTok RhsArrowKind
RhsArrowEquation = LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedEquals

rhsParserWithArrow :: RhsArrowKind -> TokParser Rhs
rhsParserWithArrow :: RhsArrowKind -> TokParser Rhs
rhsParserWithArrow RhsArrowKind
arrowKind = do
  tok <- ParsecT Void TokStream Identity LexToken
-> ParsecT Void TokStream Identity LexToken
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void TokStream Identity (Token TokStream)
ParsecT Void TokStream Identity LexToken
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
  case lexTokenKind tok of
    LexTokenKind
TkReservedPipe -> RhsArrowKind -> TokParser Rhs
guardedRhssParser RhsArrowKind
arrowKind
    LexTokenKind
TkReservedRightArrow | RhsArrowKind
RhsArrowCase <- RhsArrowKind
arrowKind -> RhsArrowKind -> TokParser Rhs
unguardedRhsParser RhsArrowKind
arrowKind
    LexTokenKind
TkReservedEquals | RhsArrowKind
RhsArrowEquation <- RhsArrowKind
arrowKind -> RhsArrowKind -> TokParser Rhs
unguardedRhsParser RhsArrowKind
arrowKind
    LexTokenKind
_ -> String -> TokParser Rhs
forall a. String -> ParsecT Void TokStream Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (RhsArrowKind -> Text
rhsArrowText RhsArrowKind
arrowKind) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" or guarded right-hand side")

unguardedRhsParser :: RhsArrowKind -> TokParser Rhs
unguardedRhsParser :: RhsArrowKind -> TokParser Rhs
unguardedRhsParser RhsArrowKind
arrowKind = TokParser (SourceSpan -> Rhs) -> TokParser Rhs
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Rhs) -> TokParser Rhs)
-> TokParser (SourceSpan -> Rhs) -> TokParser Rhs
forall a b. (a -> b) -> a -> b
$ do
  RhsArrowKind -> TokParser ()
rhsArrowTok RhsArrowKind
arrowKind
  body <- TokParser Expr
exprParser
  pure (`UnguardedRhs` body)

guardedRhssParser :: RhsArrowKind -> TokParser Rhs
guardedRhssParser :: RhsArrowKind -> TokParser Rhs
guardedRhssParser RhsArrowKind
arrowKind = TokParser (SourceSpan -> Rhs) -> TokParser Rhs
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Rhs) -> TokParser Rhs)
-> TokParser (SourceSpan -> Rhs) -> TokParser Rhs
forall a b. (a -> b) -> a -> b
$ do
  grhss <- ParsecT Void TokStream Identity GuardedRhs
-> ParsecT Void TokStream Identity [GuardedRhs]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some (RhsArrowKind -> ParsecT Void TokStream Identity GuardedRhs
guardedRhsParser RhsArrowKind
arrowKind)
  pure (`GuardedRhss` grhss)

guardedRhsParser :: RhsArrowKind -> TokParser GuardedRhs
guardedRhsParser :: RhsArrowKind -> ParsecT Void TokStream Identity GuardedRhs
guardedRhsParser RhsArrowKind
arrowKind = TokParser (SourceSpan -> GuardedRhs)
-> ParsecT Void TokStream Identity GuardedRhs
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> GuardedRhs)
 -> ParsecT Void TokStream Identity GuardedRhs)
-> TokParser (SourceSpan -> GuardedRhs)
-> ParsecT Void TokStream Identity GuardedRhs
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedPipe
  guards <- TokParser GuardQualifier
guardQualifierParser TokParser GuardQualifier
-> TokParser () -> ParsecT Void TokStream Identity [GuardQualifier]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepBy1` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
  rhsArrowTok arrowKind
  body <- exprParserExcept ["|", rhsArrowText arrowKind]
  pure $ \SourceSpan
span' ->
    GuardedRhs
      { guardedRhsSpan :: SourceSpan
guardedRhsSpan = SourceSpan
span',
        guardedRhsGuards :: [GuardQualifier]
guardedRhsGuards = [GuardQualifier]
guards,
        guardedRhsBody :: Expr
guardedRhsBody = Expr
body
      }

guardQualifierParser :: TokParser GuardQualifier
guardQualifierParser :: TokParser GuardQualifier
guardQualifierParser = TokParser GuardQualifier -> TokParser GuardQualifier
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser GuardQualifier
guardPatParser TokParser GuardQualifier
-> TokParser GuardQualifier -> TokParser GuardQualifier
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser GuardQualifier -> TokParser GuardQualifier
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser GuardQualifier
guardLetParser TokParser GuardQualifier
-> TokParser GuardQualifier -> TokParser GuardQualifier
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser GuardQualifier
guardExprParser
  where
    guardPatParser :: TokParser GuardQualifier
guardPatParser = TokParser (SourceSpan -> GuardQualifier)
-> TokParser GuardQualifier
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> GuardQualifier)
 -> TokParser GuardQualifier)
-> TokParser (SourceSpan -> GuardQualifier)
-> TokParser GuardQualifier
forall a b. (a -> b) -> a -> b
$ do
      pat <- TokParser Pattern
patternParser
      expectedTok TkReservedLeftArrow
      expr <- exprParser
      pure (\SourceSpan
span' -> SourceSpan -> Pattern -> Expr -> GuardQualifier
GuardPat SourceSpan
span' Pattern
pat Expr
expr)

    guardLetParser :: TokParser GuardQualifier
guardLetParser = TokParser (SourceSpan -> GuardQualifier)
-> TokParser GuardQualifier
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> GuardQualifier)
 -> TokParser GuardQualifier)
-> TokParser (SourceSpan -> GuardQualifier)
-> TokParser GuardQualifier
forall a b. (a -> b) -> a -> b
$ do
      decls <- ParsecT Void TokStream Identity [Decl]
parseLetDeclsStmtParser
      pure (`GuardLet` decls)

    guardExprParser :: TokParser GuardQualifier
guardExprParser = TokParser (SourceSpan -> GuardQualifier)
-> TokParser GuardQualifier
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> GuardQualifier)
 -> TokParser GuardQualifier)
-> TokParser (SourceSpan -> GuardQualifier)
-> TokParser GuardQualifier
forall a b. (a -> b) -> a -> b
$ do
      expr <- TokParser Expr
exprParser
      pure (`GuardExpr` expr)

caseAltParser :: TokParser CaseAlt
caseAltParser :: TokParser CaseAlt
caseAltParser = TokParser (SourceSpan -> CaseAlt) -> TokParser CaseAlt
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> CaseAlt) -> TokParser CaseAlt)
-> TokParser (SourceSpan -> CaseAlt) -> TokParser CaseAlt
forall a b. (a -> b) -> a -> b
$ do
  pat <- TokParser Pattern
patternParser
  rhs <- rhsParser
  pure $ \SourceSpan
span' ->
    CaseAlt
      { caseAltSpan :: SourceSpan
caseAltSpan = SourceSpan
span',
        caseAltPattern :: Pattern
caseAltPattern = Pattern
pat,
        caseAltRhs :: Rhs
caseAltRhs = Rhs
rhs
      }

caseExprParser :: TokParser Expr
caseExprParser :: TokParser Expr
caseExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordCase
  scrutinee <- TokParser Expr
exprParser
  keywordTok TkKeywordOf
  alts <- bracedAlts <|> plainAlts
  pure $ \SourceSpan
span' -> SourceSpan -> Expr -> [CaseAlt] -> Expr
ECase SourceSpan
span' Expr
scrutinee [CaseAlt]
alts
  where
    plainAlts :: TokParser [CaseAlt]
plainAlts = TokParser CaseAlt -> TokParser [CaseAlt]
forall a. TokParser a -> TokParser [a]
plainSemiSep1 TokParser CaseAlt
caseAltParser
    bracedAlts :: TokParser [CaseAlt]
bracedAlts = TokParser CaseAlt -> TokParser [CaseAlt]
forall a. TokParser a -> TokParser [a]
bracedSemiSep TokParser CaseAlt
caseAltParser

parenExprParser :: TokParser Expr
parenExprParser :: TokParser Expr
parenExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLParen
  mClosed <- TokParser () -> ParsecT Void TokStream Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRParen)
  case mClosed of
    Just () -> (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceSpan -> [Expr] -> Expr
`ETuple` [])
    Maybe ()
Nothing -> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Expr)
parseNegateParen TokParser (SourceSpan -> Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Expr)
parseSection TokParser (SourceSpan -> Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Expr)
parseTupleSectionExpr TokParser (SourceSpan -> Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Expr)
parseParenOrTupleExpr
  where
    parseNegateParen :: TokParser (SourceSpan -> Expr)
parseNegateParen = do
      minusTok <- ParsecT Void TokStream Identity LexToken
minusTokenValueParser
      nextTok <- lookAhead anySingle
      guard (parenNegateAllowed minusTok nextTok)
      inner <- exprParser
      expectedTok TkSpecialRParen
      pure $ \SourceSpan
span' ->
        case LexToken -> LexTokenKind
lexTokenKind LexToken
minusTok of
          LexTokenKind
TkPrefixMinus -> SourceSpan -> Expr -> Expr
ENegate SourceSpan
span' Expr
inner
          LexTokenKind
_ -> SourceSpan -> Expr -> Expr
EParen SourceSpan
span' (SourceSpan -> Expr -> Expr
ENegate SourceSpan
span' Expr
inner)

    parenNegateAllowed :: LexToken -> LexToken -> Bool
parenNegateAllowed LexToken
minusTok LexToken
nextTok =
      case LexToken -> LexTokenKind
lexTokenKind LexToken
minusTok of
        LexTokenKind
TkPrefixMinus -> Bool
True
        TkVarSym Text
"-" -> LexToken -> LexToken -> Bool
tokensAdjacent LexToken
minusTok LexToken
nextTok
        LexTokenKind
TkMinusOperator -> Bool
False
        LexTokenKind
_ -> Bool
False

    tokensAdjacent :: LexToken -> LexToken -> Bool
tokensAdjacent LexToken
first LexToken
second =
      case (LexToken -> SourceSpan
lexTokenSpan LexToken
first, LexToken -> SourceSpan
lexTokenSpan LexToken
second) of
        (SourceSpan Int
_ Int
_ Int
firstEndLine Int
firstEndCol, SourceSpan Int
secondStartLine Int
secondStartCol Int
_ Int
_) ->
          Int
firstEndLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
secondStartLine Bool -> Bool -> Bool
&& Int
firstEndCol Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
secondStartCol
        (SourceSpan, SourceSpan)
_ -> Bool
False

    parseSection :: TokParser (SourceSpan -> Expr)
parseSection = do
      TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Expr)
parseSectionR TokParser (SourceSpan -> Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Expr)
parseSectionL

    parseSectionR :: TokParser (SourceSpan -> Expr)
parseSectionR = do
      op <- [Text] -> ParsecT Void TokStream Identity Text
infixOperatorParserExcept []
      rhs <- exprParser
      expectedTok TkSpecialRParen
      pure (\SourceSpan
span' -> SourceSpan -> Expr -> Expr
EParen SourceSpan
span' (SourceSpan -> Text -> Expr -> Expr
ESectionR SourceSpan
span' Text
op Expr
rhs))

    parseSectionL :: TokParser (SourceSpan -> Expr)
parseSectionL = do
      lhs <- TokParser Expr
appExprParser
      op <- infixOperatorParserExcept []
      expectedTok TkSpecialRParen
      pure (\SourceSpan
span' -> SourceSpan -> Expr -> Expr
EParen SourceSpan
span' (SourceSpan -> Expr -> Text -> Expr
ESectionL SourceSpan
span' Expr
lhs Text
op))

    parseTupleSectionExpr :: TokParser (SourceSpan -> Expr)
parseTupleSectionExpr = do
      -- Try to parse as tuple section first (e.g., "(,1)" or "(1,)")
      -- If that fails, fall back to regular tuple/paren parsing
      values <- TokParser [Maybe Expr]
parseTupleSection
      pure (`ETupleSection` values)

    parseParenOrTupleExpr :: TokParser (SourceSpan -> Expr)
parseParenOrTupleExpr = do
      first <- TokParser Expr
exprParser
      mComma <- MP.optional (expectedTok TkSpecialComma)
      case mComma of
        Maybe ()
Nothing -> do
          LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRParen
          (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceSpan -> Expr -> Expr
`EParen` Expr
first)
        Just () -> do
          second <- TokParser Expr
exprParser
          more <- MP.many (expectedTok TkSpecialComma *> exprParser)
          expectedTok TkSpecialRParen
          pure (`ETuple` (first : second : more))

parseTupleSection :: TokParser [Maybe Expr]
parseTupleSection :: TokParser [Maybe Expr]
parseTupleSection = do
  first <- TokParser Expr -> ParsecT Void TokStream Identity (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional TokParser Expr
exprParser
  _ <- expectedTok TkSpecialComma
  middle <- MP.many (MP.try (MP.optional exprParser <* expectedTok TkSpecialComma))
  lastSlot <- MP.optional exprParser
  expectedTok TkSpecialRParen
  let vals = Maybe Expr
first Maybe Expr -> [Maybe Expr] -> [Maybe Expr]
forall a. a -> [a] -> [a]
: [Maybe Expr]
middle [Maybe Expr] -> [Maybe Expr] -> [Maybe Expr]
forall a. Semigroup a => a -> a -> a
<> [Maybe Expr
lastSlot]
  let hasMissing = (Maybe Expr -> Bool) -> [Maybe Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe Expr -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Expr]
vals
  if hasMissing && length vals > 1
    then pure vals
    else fail "not a tuple section"

isNothing :: Maybe a -> Bool
isNothing :: forall a. Maybe a -> Bool
isNothing Maybe a
Nothing = Bool
True
isNothing (Just a
_) = Bool
False

listExprParser :: TokParser Expr
listExprParser :: TokParser Expr
listExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLBracket
  mClose <- TokParser () -> ParsecT Void TokStream Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRBracket)
  case mClose of
    Just () -> (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceSpan -> [Expr] -> Expr
`EList` [])
    Maybe ()
Nothing -> do
      first <- TokParser Expr
exprParser
      parseListTail first

parseListTail :: Expr -> TokParser (SourceSpan -> Expr)
parseListTail :: Expr -> TokParser (SourceSpan -> Expr)
parseListTail Expr
first =
  TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Expr)
listCompTailParser
    TokParser (SourceSpan -> Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Expr)
arithFromToTailParser
    TokParser (SourceSpan -> Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Expr)
commaTailParser
    TokParser (SourceSpan -> Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Expr)
singletonTailParser
  where
    -- Parse list comprehension qualifiers, which can be:
    -- - Regular: [ expr | qual1, qual2, qual3 ]
    -- - Parallel (with ParallelListComp): [ expr | qual1, qual2 | qual3, qual4 ]
    listCompTailParser :: TokParser (SourceSpan -> Expr)
listCompTailParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedPipe
      firstGroup <- TokParser CompStmt
compStmtParser TokParser CompStmt
-> TokParser () -> ParsecT Void TokStream Identity [CompStmt]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepBy1` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
      -- Try to parse additional parallel groups separated by |
      moreGroups <- MP.many (expectedTok TkReservedPipe *> (compStmtParser `MP.sepBy1` expectedTok TkSpecialComma))
      expectedTok TkSpecialRBracket
      pure $ \SourceSpan
span' ->
        case [[CompStmt]]
moreGroups of
          [] -> SourceSpan -> Expr -> [CompStmt] -> Expr
EListComp SourceSpan
span' Expr
first [CompStmt]
firstGroup
          [[CompStmt]]
_ -> SourceSpan -> Expr -> [[CompStmt]] -> Expr
EListCompParallel SourceSpan
span' Expr
first ([CompStmt]
firstGroup [CompStmt] -> [[CompStmt]] -> [[CompStmt]]
forall a. a -> [a] -> [a]
: [[CompStmt]]
moreGroups)

    arithFromToTailParser :: TokParser (SourceSpan -> Expr)
arithFromToTailParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedDotDot
      mTo <- TokParser Expr -> ParsecT Void TokStream Identity (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional TokParser Expr
exprParser
      expectedTok TkSpecialRBracket
      pure $ \SourceSpan
span' ->
        SourceSpan -> ArithSeq -> Expr
EArithSeq SourceSpan
span' (ArithSeq -> Expr) -> ArithSeq -> Expr
forall a b. (a -> b) -> a -> b
$
          case Maybe Expr
mTo of
            Maybe Expr
Nothing -> SourceSpan -> Expr -> ArithSeq
ArithSeqFrom SourceSpan
span' Expr
first
            Just Expr
toExpr -> SourceSpan -> Expr -> Expr -> ArithSeq
ArithSeqFromTo SourceSpan
span' Expr
first Expr
toExpr

    commaTailParser :: TokParser (SourceSpan -> Expr)
commaTailParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
      second <- TokParser Expr
exprParser
      MP.try (arithFromThenTailParser second) <|> listTailParser second

    arithFromThenTailParser :: Expr -> TokParser (SourceSpan -> Expr)
arithFromThenTailParser Expr
second = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedDotDot
      mTo <- TokParser Expr -> ParsecT Void TokStream Identity (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional TokParser Expr
exprParser
      expectedTok TkSpecialRBracket
      pure $ \SourceSpan
span' ->
        SourceSpan -> ArithSeq -> Expr
EArithSeq SourceSpan
span' (ArithSeq -> Expr) -> ArithSeq -> Expr
forall a b. (a -> b) -> a -> b
$
          case Maybe Expr
mTo of
            Maybe Expr
Nothing -> SourceSpan -> Expr -> Expr -> ArithSeq
ArithSeqFromThen SourceSpan
span' Expr
first Expr
second
            Just Expr
toExpr -> SourceSpan -> Expr -> Expr -> Expr -> ArithSeq
ArithSeqFromThenTo SourceSpan
span' Expr
first Expr
second Expr
toExpr

    listTailParser :: Expr -> TokParser (SourceSpan -> Expr)
listTailParser Expr
second = do
      rest <- TokParser Expr -> ParsecT Void TokStream Identity [Expr]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma TokParser () -> TokParser Expr -> TokParser Expr
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TokParser Expr
exprParser)
      expectedTok TkSpecialRBracket
      pure (\SourceSpan
span' -> SourceSpan -> [Expr] -> Expr
EList SourceSpan
span' (Expr
first Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: Expr
second Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
rest))

    singletonTailParser :: TokParser (SourceSpan -> Expr)
singletonTailParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRBracket
      (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\SourceSpan
span' -> SourceSpan -> [Expr] -> Expr
EList SourceSpan
span' [Expr
first])

compStmtParser :: TokParser CompStmt
compStmtParser :: TokParser CompStmt
compStmtParser = TokParser CompStmt -> TokParser CompStmt
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser CompStmt
compGenStmtParser TokParser CompStmt -> TokParser CompStmt -> TokParser CompStmt
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser CompStmt -> TokParser CompStmt
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser CompStmt
compLetStmtParser TokParser CompStmt -> TokParser CompStmt -> TokParser CompStmt
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser CompStmt
compGuardStmtParser

compGenStmtParser :: TokParser CompStmt
compGenStmtParser :: TokParser CompStmt
compGenStmtParser = TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt)
-> TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt
forall a b. (a -> b) -> a -> b
$ do
  pat <- TokParser Pattern
patternParser
  expectedTok TkReservedLeftArrow
  expr <- exprParser
  pure (\SourceSpan
span' -> SourceSpan -> Pattern -> Expr -> CompStmt
CompGen SourceSpan
span' Pattern
pat Expr
expr)

compLetStmtParser :: TokParser CompStmt
compLetStmtParser :: TokParser CompStmt
compLetStmtParser = TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt)
-> TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt
forall a b. (a -> b) -> a -> b
$ do
  decls <- ParsecT Void TokStream Identity [Decl]
parseLetDeclsStmtParser
  pure (`CompLetDecls` decls)

lambdaExprParser :: TokParser Expr
lambdaExprParser :: TokParser Expr
lambdaExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedBackslash
  TokParser (SourceSpan -> Expr)
lambdaCaseParser TokParser (SourceSpan -> Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser (SourceSpan -> Expr)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Expr)
lambdaPatsParser
  where
    lambdaCaseParser :: TokParser (SourceSpan -> Expr)
lambdaCaseParser = do
      LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordCase
      alts <- TokParser [CaseAlt]
bracedAlts
      pure (`ELambdaCase` alts)

    lambdaPatsParser :: TokParser (SourceSpan -> Expr)
lambdaPatsParser = do
      pats <- TokParser Pattern -> ParsecT Void TokStream Identity [Pattern]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some TokParser Pattern
patternParser
      expectedTok TkReservedRightArrow
      body <- exprParser
      pure (\SourceSpan
span' -> SourceSpan -> [Pattern] -> Expr -> Expr
ELambdaPats SourceSpan
span' [Pattern]
pats Expr
body)

    bracedAlts :: TokParser [CaseAlt]
bracedAlts = TokParser CaseAlt -> TokParser [CaseAlt]
forall a. TokParser a -> TokParser [a]
bracedSemiSep1 TokParser CaseAlt
caseAltParser

letExprParser :: TokParser Expr
letExprParser :: TokParser Expr
letExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  decls <- ParsecT Void TokStream Identity [Decl]
parseLetDeclsParser
  keywordTok TkKeywordIn
  body <- exprParser
  pure (\SourceSpan
span' -> SourceSpan -> [Decl] -> Expr -> Expr
ELetDecls SourceSpan
span' [Decl]
decls Expr
body)

whereClauseParser :: TokParser [Decl]
whereClauseParser :: ParsecT Void TokStream Identity [Decl]
whereClauseParser = do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordWhere
  ParsecT Void TokStream Identity [Decl]
bracedDeclsParser ParsecT Void TokStream Identity [Decl]
-> ParsecT Void TokStream Identity [Decl]
-> ParsecT Void TokStream Identity [Decl]
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity [Decl]
plainDeclsParser

plainDeclsParser :: TokParser [Decl]
plainDeclsParser :: ParsecT Void TokStream Identity [Decl]
plainDeclsParser = TokParser Decl -> ParsecT Void TokStream Identity [Decl]
forall a. TokParser a -> TokParser [a]
plainSemiSep1 TokParser Decl
localDeclParser

bracedDeclsParser :: TokParser [Decl]
bracedDeclsParser :: ParsecT Void TokStream Identity [Decl]
bracedDeclsParser = TokParser Decl -> ParsecT Void TokStream Identity [Decl]
forall a. TokParser a -> TokParser [a]
bracedSemiSep1 TokParser Decl
localDeclParser

localDeclParser :: TokParser Decl
localDeclParser :: TokParser Decl
localDeclParser = TokParser Decl -> TokParser Decl
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Decl
localTypeSigDeclParser TokParser Decl -> TokParser Decl -> TokParser Decl
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Decl -> TokParser Decl
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Decl
localFunctionDeclParser TokParser Decl -> TokParser Decl -> TokParser Decl
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Decl
localPatternDeclParser

localTypeSigDeclParser :: TokParser Decl
localTypeSigDeclParser :: TokParser Decl
localTypeSigDeclParser = TokParser (SourceSpan -> Decl) -> TokParser Decl
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Decl) -> TokParser Decl)
-> TokParser (SourceSpan -> Decl) -> TokParser Decl
forall a b. (a -> b) -> a -> b
$ do
  names <- ParsecT Void TokStream Identity Text
binderNameParser ParsecT Void TokStream Identity Text
-> TokParser () -> ParsecT Void TokStream Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepBy1` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
  expectedTok TkReservedDoubleColon
  ty <- typeParser
  pure (\SourceSpan
span' -> SourceSpan -> [Text] -> Type -> Decl
DeclTypeSig SourceSpan
span' [Text]
names Type
ty)

localFunctionDeclParser :: TokParser Decl
localFunctionDeclParser :: TokParser Decl
localFunctionDeclParser = TokParser (SourceSpan -> Decl) -> TokParser Decl
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Decl) -> TokParser Decl)
-> TokParser (SourceSpan -> Decl) -> TokParser Decl
forall a b. (a -> b) -> a -> b
$ TokParser (SourceSpan -> Decl) -> TokParser (SourceSpan -> Decl)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Decl)
infixLocalFunctionParser TokParser (SourceSpan -> Decl)
-> TokParser (SourceSpan -> Decl) -> TokParser (SourceSpan -> Decl)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Decl)
prefixLocalFunctionParser
  where
    prefixLocalFunctionParser :: TokParser (SourceSpan -> Decl)
prefixLocalFunctionParser = do
      name <- ParsecT Void TokStream Identity Text
binderNameParser
      pats <- MP.many simplePatternParser
      rhs <- equationRhsParser
      pure (\SourceSpan
span' -> SourceSpan -> Text -> [Pattern] -> Rhs -> Decl
functionBindDecl SourceSpan
span' Text
name [Pattern]
pats Rhs
rhs)

    infixLocalFunctionParser :: TokParser (SourceSpan -> Decl)
infixLocalFunctionParser = do
      lhsPat <- TokParser Pattern
patternParser
      op <- infixOperatorNameParser
      rhsPat <- patternParser
      rhs <- equationRhsParser
      pure (\SourceSpan
span' -> SourceSpan -> Text -> [Pattern] -> Rhs -> Decl
functionBindDecl SourceSpan
span' Text
op [Pattern
lhsPat, Pattern
rhsPat] Rhs
rhs)

localPatternDeclParser :: TokParser Decl
localPatternDeclParser :: TokParser Decl
localPatternDeclParser = TokParser (SourceSpan -> Decl) -> TokParser Decl
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Decl) -> TokParser Decl)
-> TokParser (SourceSpan -> Decl) -> TokParser Decl
forall a b. (a -> b) -> a -> b
$ do
  pat <- TokParser Pattern
patternParser
  expectedTok TkReservedEquals
  rhsExpr <- exprParser
  pure (\SourceSpan
span' -> SourceSpan -> ValueDecl -> Decl
DeclValue SourceSpan
span' (SourceSpan -> Pattern -> Rhs -> ValueDecl
PatternBind SourceSpan
span' Pattern
pat (SourceSpan -> Expr -> Rhs
UnguardedRhs SourceSpan
span' Expr
rhsExpr)))

varOrConPatternParser :: TokParser Pattern
varOrConPatternParser :: TokParser Pattern
varOrConPatternParser = TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Pattern
recordPatternParser TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
bareVarOrConPatternParser

bareVarOrConPatternParser :: TokParser Pattern
bareVarOrConPatternParser :: TokParser Pattern
bareVarOrConPatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  name <- ParsecT Void TokStream Identity Text
identifierTextParser
  pure $ \SourceSpan
span' ->
    if Text -> Bool
isConLikeName Text
name
      then SourceSpan -> Text -> [Pattern] -> Pattern
PCon SourceSpan
span' Text
name []
      else SourceSpan -> Text -> Pattern
PVar SourceSpan
span' Text
name

recordPatternParser :: TokParser Pattern
recordPatternParser :: TokParser Pattern
recordPatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  con <- ParsecT Void TokStream Identity Text
constructorIdentifierParser
  expectedTok TkSpecialLBrace
  mClose <- MP.optional (expectedTok TkSpecialRBrace)
  case mClose of
    Just () -> (SourceSpan -> Pattern) -> TokParser (SourceSpan -> Pattern)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\SourceSpan
span' -> SourceSpan -> Text -> [(Text, Pattern)] -> Pattern
PRecord SourceSpan
span' Text
con [])
    Maybe ()
Nothing -> do
      fields <- ParsecT Void TokStream Identity (Text, Pattern)
recordFieldPatternParser ParsecT Void TokStream Identity (Text, Pattern)
-> TokParser ()
-> ParsecT Void TokStream Identity [(Text, Pattern)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
      expectedTok TkSpecialRBrace
      pure (\SourceSpan
span' -> SourceSpan -> Text -> [(Text, Pattern)] -> Pattern
PRecord SourceSpan
span' Text
con [(Text, Pattern)]
fields)

recordFieldPatternParser :: TokParser (Text, Pattern)
recordFieldPatternParser :: ParsecT Void TokStream Identity (Text, Pattern)
recordFieldPatternParser = do
  startPos <- ParsecT Void TokStream Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
MP.getSourcePos
  field <- identifierTextParser
  mEq <- MP.optional (expectedTok TkReservedEquals)
  endPos <- MP.getSourcePos
  case mEq of
    Just () -> do
      pat <- TokParser Pattern
patternParser
      pure (field, pat)
    Maybe ()
Nothing -> do
      -- NamedFieldPuns: just "field" means "field = field"
      let span' :: SourceSpan
span' = SourcePos -> SourcePos -> SourceSpan
sourceSpanFromPositions SourcePos
startPos SourcePos
endPos
      (Text, Pattern) -> ParsecT Void TokStream Identity (Text, Pattern)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
field, SourceSpan -> Text -> Pattern
PVar SourceSpan
span' Text
field)

listPatternParser :: TokParser Pattern
listPatternParser :: TokParser Pattern
listPatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLBracket
  elems <- TokParser Pattern
patternParser TokParser Pattern
-> TokParser () -> ParsecT Void TokStream Identity [Pattern]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
  expectedTok TkSpecialRBracket
  pure (`PList` elems)

parenOrTuplePatternParser :: TokParser Pattern
parenOrTuplePatternParser :: TokParser Pattern
parenOrTuplePatternParser = TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLParen
  TokParser (SourceSpan -> Pattern)
-> TokParser (SourceSpan -> Pattern)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Pattern)
unitPatternParser TokParser (SourceSpan -> Pattern)
-> TokParser (SourceSpan -> Pattern)
-> TokParser (SourceSpan -> Pattern)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Pattern)
-> TokParser (SourceSpan -> Pattern)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Pattern)
viewPatternParser TokParser (SourceSpan -> Pattern)
-> TokParser (SourceSpan -> Pattern)
-> TokParser (SourceSpan -> Pattern)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Pattern)
tupleOrParenPatternParser
  where
    unitPatternParser :: TokParser (SourceSpan -> Pattern)
unitPatternParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRParen
      (SourceSpan -> Pattern) -> TokParser (SourceSpan -> Pattern)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceSpan -> [Pattern] -> Pattern
`PTuple` [])

    viewPatternParser :: TokParser (SourceSpan -> Pattern)
viewPatternParser = do
      viewExpr <- TokParser Expr
exprParser
      expectedTok TkReservedRightArrow
      inner <- patternParser
      expectedTok TkSpecialRParen
      pure (\SourceSpan
span' -> SourceSpan -> Expr -> Pattern -> Pattern
PView SourceSpan
span' Expr
viewExpr Pattern
inner)

    tupleOrParenPatternParser :: TokParser (SourceSpan -> Pattern)
tupleOrParenPatternParser = do
      first <- TokParser Pattern
patternParser
      mComma <- MP.optional (expectedTok TkSpecialComma)
      case mComma of
        Maybe ()
Nothing -> do
          LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRParen
          (SourceSpan -> Pattern) -> TokParser (SourceSpan -> Pattern)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceSpan -> Pattern -> Pattern
`PParen` Pattern
first)
        Just () -> do
          second <- TokParser Pattern
patternParser
          more <- MP.many (expectedTok TkSpecialComma *> patternParser)
          expectedTok TkSpecialRParen
          pure (`PTuple` (first : second : more))

isConLikeName :: Text -> Bool
isConLikeName :: Text -> Bool
isConLikeName Text
name =
  case Text -> Maybe (Char, Text)
T.uncons Text
name of
    Just (Char
c, Text
_) -> Char -> Bool
isUpper Char
c
    Maybe (Char, Text)
Nothing -> Bool
False

isPatternAppHead :: Pattern -> Bool
isPatternAppHead :: Pattern -> Bool
isPatternAppHead Pattern
pat =
  case Pattern
pat of
    PCon {} -> Bool
True
    PVar SourceSpan
_ Text
name -> Text -> Bool
isConLikeName Text
name
    Pattern
_ -> Bool
False

compGuardStmtParser :: TokParser CompStmt
compGuardStmtParser :: TokParser CompStmt
compGuardStmtParser = TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt)
-> TokParser (SourceSpan -> CompStmt) -> TokParser CompStmt
forall a b. (a -> b) -> a -> b
$ do
  expr <- TokParser Expr
exprParser
  pure (`CompGuard` expr)

varExprParser :: TokParser Expr
varExprParser :: TokParser Expr
varExprParser = TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Expr) -> TokParser Expr)
-> TokParser (SourceSpan -> Expr) -> TokParser Expr
forall a b. (a -> b) -> a -> b
$ do
  name <- ParsecT Void TokStream Identity Text
identifierTextParser
  pure (`EVar` name)

simplePatternParser :: TokParser Pattern
simplePatternParser :: TokParser Pattern
simplePatternParser =
  TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try
    ( TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Pattern) -> TokParser Pattern)
-> TokParser (SourceSpan -> Pattern) -> TokParser Pattern
forall a b. (a -> b) -> a -> b
$ do
        name <- ParsecT Void TokStream Identity Text
identifierTextParser
        expectedTok TkReservedAt
        inner <- patternAtomParser
        pure (\SourceSpan
span' -> SourceSpan -> Text -> Pattern -> Pattern
PAs SourceSpan
span' Text
name Pattern
inner)
    )
    TokParser Pattern -> TokParser Pattern -> TokParser Pattern
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser Pattern
patternAtomParser

typeParser :: TokParser Type
typeParser :: ParsecT Void TokStream Identity Type
typeParser = ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity Type
forallTypeParser ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity Type
contextTypeParser ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
typeFunParser

forallTypeParser :: TokParser Type
forallTypeParser :: ParsecT Void TokStream Identity Type
forallTypeParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  Text -> TokParser ()
varIdTok Text
"forall"
  binders <- ParsecT Void TokStream Identity Text
-> ParsecT Void TokStream Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some ParsecT Void TokStream Identity Text
identifierTextParser
  expectedTok (TkVarSym ".")
  inner <- MP.try contextTypeParser <|> typeFunParser
  pure (\SourceSpan
span' -> SourceSpan -> [Text] -> Type -> Type
TForall SourceSpan
span' [Text]
binders Type
inner)

contextTypeParser :: TokParser Type
contextTypeParser :: ParsecT Void TokStream Identity Type
contextTypeParser = do
  constraints <- TokParser [Constraint]
constraintsParser
  expectedTok TkReservedDoubleArrow
  inner <- typeParser
  pure (TContext (mergeSourceSpans (constraintHeadSpan constraints) (getSourceSpan inner)) constraints inner)

constraintHeadSpan :: [Constraint] -> SourceSpan
constraintHeadSpan :: [Constraint] -> SourceSpan
constraintHeadSpan [Constraint]
constraints =
  case [Constraint]
constraints of
    [] -> SourceSpan
NoSourceSpan
    Constraint
constraint : [Constraint]
_ -> Constraint -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Constraint
constraint

constraintsParser :: TokParser [Constraint]
constraintsParser :: TokParser [Constraint]
constraintsParser = ParsecT Void TokStream Identity Type -> TokParser [Constraint]
constraintsParserWith ParsecT Void TokStream Identity Type
typeAtomParser

typeFunParser :: TokParser Type
typeFunParser :: ParsecT Void TokStream Identity Type
typeFunParser = do
  lhs <- ParsecT Void TokStream Identity Type
typeInfixParser
  mRhs <- MP.optional (expectedTok TkReservedRightArrow *> typeParser)
  pure $
    case mRhs of
      Just Type
rhs -> SourceSpan -> Type -> Type -> Type
TFun (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Type -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Type
lhs) (Type -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Type
rhs)) Type
lhs Type
rhs
      Maybe Type
Nothing -> Type
lhs

typeInfixParser :: TokParser Type
typeInfixParser :: ParsecT Void TokStream Identity Type
typeInfixParser = do
  lhs <- ParsecT Void TokStream Identity Type
typeAppParser
  rest <- MP.many ((,) <$> typeInfixOperatorParser <*> typeAppParser)
  pure (foldl buildInfixType lhs rest)

buildInfixType :: Type -> (Text, Type) -> Type
buildInfixType :: Type -> (Text, Type) -> Type
buildInfixType Type
lhs (Text
op, Type
rhs) =
  let span' :: SourceSpan
span' = SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Type -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Type
lhs) (Type -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Type
rhs)
      opType :: Type
opType = SourceSpan -> Text -> TypePromotion -> Type
TCon SourceSpan
span' Text
op TypePromotion
Unpromoted
   in SourceSpan -> Type -> Type -> Type
TApp SourceSpan
span' (SourceSpan -> Type -> Type -> Type
TApp SourceSpan
span' Type
opType Type
lhs) Type
rhs

typeInfixOperatorParser :: TokParser Text
typeInfixOperatorParser :: ParsecT Void TokStream Identity Text
typeInfixOperatorParser =
  String
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"type infix operator" ((LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text)
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarSym Text
op
        | Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"."
            Bool -> Bool -> Bool
&& Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"!"
            Bool -> Bool -> Bool
&& Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"-" ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
      TkConSym Text
op -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
      TkQVarSym Text
op -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
      TkQConSym Text
op -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing

typeAppParser :: TokParser Type
typeAppParser :: ParsecT Void TokStream Identity Type
typeAppParser = do
  first <- ParsecT Void TokStream Identity Type
typeAtomParser
  rest <- MP.many typeAtomParser
  pure (foldl buildTypeApp first rest)

buildTypeApp :: Type -> Type -> Type
buildTypeApp :: Type -> Type -> Type
buildTypeApp Type
lhs Type
rhs =
  SourceSpan -> Type -> Type -> Type
TApp (SourceSpan -> SourceSpan -> SourceSpan
mergeSourceSpans (Type -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Type
lhs) (Type -> SourceSpan
forall a. HasSourceSpan a => a -> SourceSpan
getSourceSpan Type
rhs)) Type
lhs Type
rhs

typeAtomParser :: TokParser Type
typeAtomParser :: ParsecT Void TokStream Identity Type
typeAtomParser =
  ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity Type
promotedTypeParser
    ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
typeLiteralTypeParser
    ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
typeQuasiQuoteParser
    ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
typeListParser
    ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity Type
typeParenOperatorParser
    ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
typeParenOrTupleParser
    ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
typeStarParser
    ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
typeIdentifierParser

typeLiteralTypeParser :: TokParser Type
typeLiteralTypeParser :: ParsecT Void TokStream Identity Type
typeLiteralTypeParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  lit <- String -> (LexToken -> Maybe TypeLiteral) -> TokParser TypeLiteral
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"type literal" ((LexToken -> Maybe TypeLiteral) -> TokParser TypeLiteral)
-> (LexToken -> Maybe TypeLiteral) -> TokParser TypeLiteral
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkInteger Integer
n -> TypeLiteral -> Maybe TypeLiteral
forall a. a -> Maybe a
Just (Integer -> Text -> TypeLiteral
TypeLitInteger Integer
n (LexToken -> Text
lexTokenText LexToken
tok))
      TkIntegerBase Integer
n Text
_ -> TypeLiteral -> Maybe TypeLiteral
forall a. a -> Maybe a
Just (Integer -> Text -> TypeLiteral
TypeLitInteger Integer
n (LexToken -> Text
lexTokenText LexToken
tok))
      TkString Text
s -> TypeLiteral -> Maybe TypeLiteral
forall a. a -> Maybe a
Just (Text -> Text -> TypeLiteral
TypeLitSymbol Text
s (LexToken -> Text
lexTokenText LexToken
tok))
      TkChar Char
c -> TypeLiteral -> Maybe TypeLiteral
forall a. a -> Maybe a
Just (Char -> Text -> TypeLiteral
TypeLitChar Char
c (LexToken -> Text
lexTokenText LexToken
tok))
      LexTokenKind
_ -> Maybe TypeLiteral
forall a. Maybe a
Nothing
  pure (`TTypeLit` lit)

promotedTypeParser :: TokParser Type
promotedTypeParser :: ParsecT Void TokStream Identity Type
promotedTypeParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok (Text -> LexTokenKind
TkVarSym Text
"'")
  promotedTy <- ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity Type
promotedStructuredTypeParser ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
promotedRawTypeParser
  pure (`setTypeSpan` promotedTy)

promotedStructuredTypeParser :: TokParser Type
promotedStructuredTypeParser :: ParsecT Void TokStream Identity Type
promotedStructuredTypeParser = do
  ty <-
    ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity Type
typeListParser
      ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity Type
typeParenOrTupleParser
      ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity Type
typeParenOperatorParser
      ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
-> ParsecT Void TokStream Identity Type
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Type
typeIdentifierParser
  maybe (fail "promoted type") pure (markTypePromoted ty)

promotedRawTypeParser :: TokParser Type
promotedRawTypeParser :: ParsecT Void TokStream Identity Type
promotedRawTypeParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  suffix <- ParsecT Void TokStream Identity Text
promotedBracketedSuffixParser ParsecT Void TokStream Identity Text
-> ParsecT Void TokStream Identity Text
-> ParsecT Void TokStream Identity Text
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void TokStream Identity Text
promotedParenthesizedSuffixParser
  pure (\SourceSpan
span' -> SourceSpan -> Text -> TypePromotion -> Type
TCon SourceSpan
span' Text
suffix TypePromotion
Promoted)

promotedBracketedSuffixParser :: TokParser Text
promotedBracketedSuffixParser :: ParsecT Void TokStream Identity Text
promotedBracketedSuffixParser = LexTokenKind
-> LexTokenKind -> ParsecT Void TokStream Identity Text
collectDelimitedRaw LexTokenKind
TkSpecialLBracket LexTokenKind
TkSpecialRBracket

promotedParenthesizedSuffixParser :: TokParser Text
promotedParenthesizedSuffixParser :: ParsecT Void TokStream Identity Text
promotedParenthesizedSuffixParser = LexTokenKind
-> LexTokenKind -> ParsecT Void TokStream Identity Text
collectDelimitedRaw LexTokenKind
TkSpecialLParen LexTokenKind
TkSpecialRParen

collectDelimitedRaw :: LexTokenKind -> LexTokenKind -> TokParser Text
collectDelimitedRaw :: LexTokenKind
-> LexTokenKind -> ParsecT Void TokStream Identity Text
collectDelimitedRaw LexTokenKind
openKind LexTokenKind
closeKind = do
  openTxt <- String
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy (String
"opening delimiter " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> LexTokenKind -> String
forall a. Show a => a -> String
show LexTokenKind
openKind) ((LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text)
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    if LexToken -> LexTokenKind
lexTokenKind LexToken
tok LexTokenKind -> LexTokenKind -> Bool
forall a. Eq a => a -> a -> Bool
== LexTokenKind
openKind then Text -> Maybe Text
forall a. a -> Maybe a
Just (LexToken -> Text
lexTokenText LexToken
tok) else Maybe Text
forall a. Maybe a
Nothing
  go 1 openTxt
  where
    go :: Int -> Text -> TokParser Text
    go :: Int -> Text -> ParsecT Void TokStream Identity Text
go Int
depth Text
acc = do
      tok <- ParsecT Void TokStream Identity (Token TokStream)
ParsecT Void TokStream Identity LexToken
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
      let kind = LexToken -> LexTokenKind
lexTokenKind LexToken
tok
          txt = LexToken -> Text
lexTokenText LexToken
tok
          acc' = Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt
      case () of
        ()
_
          | LexTokenKind
kind LexTokenKind -> LexTokenKind -> Bool
forall a. Eq a => a -> a -> Bool
== LexTokenKind
openKind -> Int -> Text -> ParsecT Void TokStream Identity Text
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
acc'
          | LexTokenKind
kind LexTokenKind -> LexTokenKind -> Bool
forall a. Eq a => a -> a -> Bool
== LexTokenKind
closeKind ->
              if Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                then Text -> ParsecT Void TokStream Identity Text
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
acc'
                else Int -> Text -> ParsecT Void TokStream Identity Text
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
acc'
          | Bool
otherwise -> Int -> Text -> ParsecT Void TokStream Identity Text
go Int
depth Text
acc'

typeParenOperatorParser :: TokParser Type
typeParenOperatorParser :: ParsecT Void TokStream Identity Type
typeParenOperatorParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLParen
  op <- String
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"type operator" ((LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text)
-> (LexToken -> Maybe Text) -> ParsecT Void TokStream Identity Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarSym Text
sym | Text
sym Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"*" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
      TkConSym Text
sym | Text
sym Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"*" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
      TkQVarSym Text
sym -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
      TkQConSym Text
sym -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sym
      -- Handle reserved operators that can be used as type constructors
      LexTokenKind
TkReservedRightArrow -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"->"
      -- Note: ~ is now lexed as TkVarSym "~" so TkVarSym case handles it
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing
  expectedTok TkSpecialRParen
  pure (\SourceSpan
span' -> SourceSpan -> Text -> TypePromotion -> Type
TCon SourceSpan
span' Text
op TypePromotion
Unpromoted)

typeQuasiQuoteParser :: TokParser Type
typeQuasiQuoteParser :: ParsecT Void TokStream Identity Type
typeQuasiQuoteParser =
  String
-> (LexToken -> Maybe Type) -> ParsecT Void TokStream Identity Type
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"type quasi quote" ((LexToken -> Maybe Type) -> ParsecT Void TokStream Identity Type)
-> (LexToken -> Maybe Type) -> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkQuasiQuote Text
quoter Text
body -> Type -> Maybe Type
forall a. a -> Maybe a
Just (SourceSpan -> Text -> Text -> Type
TQuasiQuote (LexToken -> SourceSpan
lexTokenSpan LexToken
tok) Text
quoter Text
body)
      LexTokenKind
_ -> Maybe Type
forall a. Maybe a
Nothing

typeIdentifierParser :: TokParser Type
typeIdentifierParser :: ParsecT Void TokStream Identity Type
typeIdentifierParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  name <- ParsecT Void TokStream Identity Text
identifierTextParser
  pure $ \SourceSpan
span' ->
    case Text -> Maybe (Char, Text)
T.uncons Text
name of
      Just (Char
c, Text
_) | Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' -> SourceSpan -> Text -> Type
TVar SourceSpan
span' Text
name
      Maybe (Char, Text)
_ -> SourceSpan -> Text -> TypePromotion -> Type
TCon SourceSpan
span' Text
name TypePromotion
Unpromoted

typeStarParser :: TokParser Type
typeStarParser :: ParsecT Void TokStream Identity Type
typeStarParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok (Text -> LexTokenKind
TkVarSym Text
"*")
  (SourceSpan -> Type) -> TokParser (SourceSpan -> Type)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceSpan -> Type
TStar

typeListParser :: TokParser Type
typeListParser :: ParsecT Void TokStream Identity Type
typeListParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLBracket
  inner <- ParsecT Void TokStream Identity Type
typeParser
  expectedTok TkSpecialRBracket
  pure (\SourceSpan
span' -> SourceSpan -> TypePromotion -> Type -> Type
TList SourceSpan
span' TypePromotion
Unpromoted Type
inner)

typeParenOrTupleParser :: TokParser Type
typeParenOrTupleParser :: ParsecT Void TokStream Identity Type
typeParenOrTupleParser = TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Type)
 -> ParsecT Void TokStream Identity Type)
-> TokParser (SourceSpan -> Type)
-> ParsecT Void TokStream Identity Type
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLParen
  mClosed <- TokParser () -> ParsecT Void TokStream Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRParen)
  case mClosed of
    Just () -> (SourceSpan -> Type) -> TokParser (SourceSpan -> Type)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\SourceSpan
span' -> SourceSpan -> TypePromotion -> [Type] -> Type
TTuple SourceSpan
span' TypePromotion
Unpromoted [])
    Maybe ()
Nothing -> do
      TokParser (SourceSpan -> Type) -> TokParser (SourceSpan -> Type)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Type)
tupleConstructorParser TokParser (SourceSpan -> Type)
-> TokParser (SourceSpan -> Type) -> TokParser (SourceSpan -> Type)
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TokParser (SourceSpan -> Type)
parenthesizedTypeOrTupleParser
  where
    tupleConstructorParser :: TokParser (SourceSpan -> Type)
tupleConstructorParser = do
      _ <- LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
      moreCommas <- MP.many (expectedTok TkSpecialComma)
      expectedTok TkSpecialRParen
      let arity = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [()]
moreCommas
          tupleConName = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      pure (\SourceSpan
span' -> SourceSpan -> Text -> TypePromotion -> Type
TCon SourceSpan
span' Text
tupleConName TypePromotion
Unpromoted)

    parenthesizedTypeOrTupleParser :: TokParser (SourceSpan -> Type)
parenthesizedTypeOrTupleParser = do
      first <- ParsecT Void TokStream Identity Type
typeParser
      mComma <- MP.optional (expectedTok TkSpecialComma)
      case mComma of
        Maybe ()
Nothing -> do
          LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialRParen
          (SourceSpan -> Type) -> TokParser (SourceSpan -> Type)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceSpan -> Type -> Type
`TParen` Type
first)
        Just () -> do
          second <- ParsecT Void TokStream Identity Type
typeParser
          more <- MP.many (expectedTok TkSpecialComma *> typeParser)
          expectedTok TkSpecialRParen
          pure (\SourceSpan
span' -> SourceSpan -> TypePromotion -> [Type] -> Type
TTuple SourceSpan
span' TypePromotion
Unpromoted (Type
first Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type
second Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: [Type]
more))

markTypePromoted :: Type -> Maybe Type
markTypePromoted :: Type -> Maybe Type
markTypePromoted Type
ty =
  case Type
ty of
    TCon SourceSpan
span' Text
name TypePromotion
_ -> Type -> Maybe Type
forall a. a -> Maybe a
Just (SourceSpan -> Text -> TypePromotion -> Type
TCon SourceSpan
span' Text
name TypePromotion
Promoted)
    TList SourceSpan
span' TypePromotion
_ Type
inner -> Type -> Maybe Type
forall a. a -> Maybe a
Just (SourceSpan -> TypePromotion -> Type -> Type
TList SourceSpan
span' TypePromotion
Promoted Type
inner)
    TTuple SourceSpan
span' TypePromotion
_ [Type]
elems -> Type -> Maybe Type
forall a. a -> Maybe a
Just (SourceSpan -> TypePromotion -> [Type] -> Type
TTuple SourceSpan
span' TypePromotion
Promoted [Type]
elems)
    Type
_ -> Maybe Type
forall a. Maybe a
Nothing

setTypeSpan :: SourceSpan -> Type -> Type
setTypeSpan :: SourceSpan -> Type -> Type
setTypeSpan SourceSpan
span' Type
ty =
  case Type
ty of
    TVar SourceSpan
_ Text
name -> SourceSpan -> Text -> Type
TVar SourceSpan
span' Text
name
    TCon SourceSpan
_ Text
name TypePromotion
promoted -> SourceSpan -> Text -> TypePromotion -> Type
TCon SourceSpan
span' Text
name TypePromotion
promoted
    TTypeLit SourceSpan
_ TypeLiteral
lit -> SourceSpan -> TypeLiteral -> Type
TTypeLit SourceSpan
span' TypeLiteral
lit
    TStar SourceSpan
_ -> SourceSpan -> Type
TStar SourceSpan
span'
    TQuasiQuote SourceSpan
_ Text
quoter Text
body -> SourceSpan -> Text -> Text -> Type
TQuasiQuote SourceSpan
span' Text
quoter Text
body
    TForall SourceSpan
_ [Text]
binders Type
inner -> SourceSpan -> [Text] -> Type -> Type
TForall SourceSpan
span' [Text]
binders Type
inner
    TApp SourceSpan
_ Type
lhs Type
rhs -> SourceSpan -> Type -> Type -> Type
TApp SourceSpan
span' Type
lhs Type
rhs
    TFun SourceSpan
_ Type
lhs Type
rhs -> SourceSpan -> Type -> Type -> Type
TFun SourceSpan
span' Type
lhs Type
rhs
    TTuple SourceSpan
_ TypePromotion
promoted [Type]
elems -> SourceSpan -> TypePromotion -> [Type] -> Type
TTuple SourceSpan
span' TypePromotion
promoted [Type]
elems
    TList SourceSpan
_ TypePromotion
promoted Type
inner -> SourceSpan -> TypePromotion -> Type -> Type
TList SourceSpan
span' TypePromotion
promoted Type
inner
    TParen SourceSpan
_ Type
inner -> SourceSpan -> Type -> Type
TParen SourceSpan
span' Type
inner
    TContext SourceSpan
_ [Constraint]
constraints Type
inner -> SourceSpan -> [Constraint] -> Type -> Type
TContext SourceSpan
span' [Constraint]
constraints Type
inner