{-# LANGUAGE OverloadedStrings #-}

module Aihc.Parser.Internal.Common
  ( TokParser,
    keywordTok,
    expectedTok,
    varIdTok,
    tokenSatisfy,
    moduleNameParser,
    identifierTextParser,
    lowerIdentifierParser,
    constructorIdentifierParser,
    binderNameParser,
    operatorTextParser,
    infixOperatorNameParser,
    stringTextParser,
    withSpan,
    sourceSpanFromPositions,
    markSingleParenConstraint,
    parens,
    skipSemicolons,
    bracedSemiSep,
    bracedSemiSep1,
    plainSemiSep1,
    constraintParserWith,
    constraintsParserWith,
    contextParserWith,
    functionBindValue,
    functionBindDecl,
  )
where

import Aihc.Parser.Lex (LexToken (..), LexTokenKind (..))
import Aihc.Parser.Syntax
import Aihc.Parser.Types (TokStream)
import Data.Char (isUpper)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void (Void)
import Text.Megaparsec (Parsec, anySingle, lookAhead, (<|>))
import Text.Megaparsec qualified as MP
import Text.Megaparsec.Pos (SourcePos (..))

type TokParser = Parsec Void TokStream

keywordTok :: LexTokenKind -> TokParser ()
keywordTok :: LexTokenKind -> TokParser ()
keywordTok LexTokenKind
expected =
  String -> (LexToken -> Maybe ()) -> TokParser ()
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy (String
"keyword " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> LexTokenKind -> String
renderKeyword LexTokenKind
expected) ((LexToken -> Maybe ()) -> TokParser ())
-> (LexToken -> Maybe ()) -> TokParser ()
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
expected then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing

-- | Match a specific token kind exactly.
expectedTok :: LexTokenKind -> TokParser ()
expectedTok :: LexTokenKind -> TokParser ()
expectedTok LexTokenKind
expected =
  String -> (LexToken -> Maybe ()) -> TokParser ()
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy (LexTokenKind -> String
renderTokenKind LexTokenKind
expected) ((LexToken -> Maybe ()) -> TokParser ())
-> (LexToken -> Maybe ()) -> TokParser ()
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
expected then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing

-- | Match a specific variable identifier (contextual keyword).
varIdTok :: Text -> TokParser ()
varIdTok :: Text -> TokParser ()
varIdTok Text
expected =
  String -> (LexToken -> Maybe ()) -> TokParser ()
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy (String
"identifier '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
expected String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'") ((LexToken -> Maybe ()) -> TokParser ())
-> (LexToken -> Maybe ()) -> TokParser ()
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarId Text
ident | Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expected -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      LexTokenKind
_ -> Maybe ()
forall a. Maybe a
Nothing

renderTokenKind :: LexTokenKind -> String
renderTokenKind :: LexTokenKind -> String
renderTokenKind LexTokenKind
tk = case LexTokenKind
tk of
  LexTokenKind
TkSpecialLParen -> String
"symbol '('"
  LexTokenKind
TkSpecialRParen -> String
"symbol ')'"
  LexTokenKind
TkSpecialComma -> String
"symbol ','"
  LexTokenKind
TkSpecialSemicolon -> String
"symbol ';'"
  LexTokenKind
TkSpecialLBracket -> String
"symbol '['"
  LexTokenKind
TkSpecialRBracket -> String
"symbol ']'"
  LexTokenKind
TkSpecialBacktick -> String
"symbol '`'"
  LexTokenKind
TkSpecialLBrace -> String
"symbol '{'"
  LexTokenKind
TkSpecialRBrace -> String
"symbol '}'"
  LexTokenKind
TkReservedDotDot -> String
"operator '..'"
  LexTokenKind
TkReservedColon -> String
"operator ':'"
  LexTokenKind
TkReservedDoubleColon -> String
"operator '::'"
  LexTokenKind
TkReservedEquals -> String
"operator '='"
  LexTokenKind
TkReservedBackslash -> String
"operator '\\'"
  LexTokenKind
TkReservedPipe -> String
"operator '|'"
  LexTokenKind
TkReservedLeftArrow -> String
"operator '<-'"
  LexTokenKind
TkReservedRightArrow -> String
"operator '->'"
  LexTokenKind
TkReservedAt -> String
"operator '@'"
  LexTokenKind
TkReservedDoubleArrow -> String
"operator '=>'"
  LexTokenKind
TkPrefixBang -> String
"bang pattern '!'"
  LexTokenKind
TkPrefixTilde -> String
"irrefutable pattern '~'"
  TkVarSym Text
op -> String
"operator '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
op String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
  TkConSym Text
op -> String
"operator '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
op String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
  LexTokenKind
_ -> LexTokenKind -> String
forall a. Show a => a -> String
show LexTokenKind
tk

tokenSatisfy :: String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy :: forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
label LexToken -> Maybe a
f =
  String
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall a.
String
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
MP.label String
label (ParsecT Void TokStream Identity a
 -> ParsecT Void TokStream Identity a)
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
forall a b. (a -> b) -> a -> b
$ 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 f tok of
      Just a
out -> a
out a
-> ParsecT Void TokStream Identity (Token TokStream)
-> ParsecT Void TokStream Identity a
forall a b.
a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void TokStream Identity (Token TokStream)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
      Maybe a
Nothing -> String -> ParsecT Void TokStream Identity a
forall a. String -> ParsecT Void TokStream Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
label

moduleNameParser :: TokParser Text
moduleNameParser :: TokParser Text
moduleNameParser =
  String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"module name" ((LexToken -> Maybe Text) -> TokParser Text)
-> (LexToken -> Maybe Text) -> TokParser Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkConId Text
ident | Text -> Bool
isModuleName Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      TkQConId Text
ident | Text -> Bool
isModuleName Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing

identifierTextParser :: TokParser Text
identifierTextParser :: TokParser Text
identifierTextParser =
  String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"identifier" ((LexToken -> Maybe Text) -> TokParser Text)
-> (LexToken -> Maybe Text) -> TokParser Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarId Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      TkConId Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      TkQVarId Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      TkQConId Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing

lowerIdentifierParser :: TokParser Text
lowerIdentifierParser :: TokParser Text
lowerIdentifierParser =
  String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"lowercase identifier" ((LexToken -> Maybe Text) -> TokParser Text)
-> (LexToken -> Maybe Text) -> TokParser Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarId Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      TkQVarId Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing

constructorIdentifierParser :: TokParser Text
constructorIdentifierParser :: TokParser Text
constructorIdentifierParser =
  String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"constructor identifier" ((LexToken -> Maybe Text) -> TokParser Text)
-> (LexToken -> Maybe Text) -> TokParser Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkConId Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      TkQConId Text
ident -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ident
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing

binderNameParser :: TokParser Text
binderNameParser :: TokParser Text
binderNameParser =
  TokParser Text
identifierTextParser
    TokParser Text -> TokParser Text -> TokParser 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
<|> TokParser Text -> TokParser Text
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
parens TokParser Text
operatorTextParser

operatorTextParser :: TokParser Text
operatorTextParser :: TokParser Text
operatorTextParser =
  String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"operator" ((LexToken -> Maybe Text) -> TokParser Text)
-> (LexToken -> Maybe Text) -> TokParser Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkVarSym Text
op -> 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

-- | Parse an infix operator name (varop) for function definitions.
-- Per Haskell Report section 4.4.3, funlhs uses 'varop' which is:
--   varop → varsym | ` varid `
-- This excludes constructor operators (consym) and qualified operators.
-- Note: Whitespace-sensitive lexing (GHC proposal 0229) now distinguishes
-- TkVarSym "!" (infix operator) from TkPrefixBang (bang pattern), so we
-- can accept all VarSym operators here.
infixOperatorNameParser :: TokParser Text
infixOperatorNameParser :: TokParser Text
infixOperatorNameParser =
  TokParser Text
symbolicOperatorParser TokParser Text -> TokParser Text -> TokParser 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
<|> TokParser Text
backtickIdentifierParser
  where
    symbolicOperatorParser :: TokParser Text
symbolicOperatorParser =
      String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"variable operator" ((LexToken -> Maybe Text) -> TokParser Text)
-> (LexToken -> Maybe Text) -> TokParser Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
        case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
          TkVarSym Text
op -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
op
          LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing
    backtickIdentifierParser :: TokParser Text
backtickIdentifierParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialBacktick
      op <- TokParser Text
varIdTextParser
      expectedTok TkSpecialBacktick
      pure op
    varIdTextParser :: TokParser Text
varIdTextParser =
      String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"variable identifier" ((LexToken -> Maybe Text) -> TokParser Text)
-> (LexToken -> Maybe Text) -> TokParser Text
forall a b. (a -> b) -> a -> b
$ \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

stringTextParser :: TokParser Text
stringTextParser :: TokParser Text
stringTextParser =
  String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"string literal" ((LexToken -> Maybe Text) -> TokParser Text)
-> (LexToken -> Maybe Text) -> TokParser Text
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkString Text
txt -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
      LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing

withSpan :: TokParser (SourceSpan -> a) -> TokParser a
withSpan :: forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan TokParser (SourceSpan -> a)
parser = do
  start <- ParsecT Void TokStream Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
MP.getSourcePos
  out <- parser
  out . sourceSpanFromPositions start <$> MP.getSourcePos

sourceSpanFromPositions :: SourcePos -> SourcePos -> SourceSpan
sourceSpanFromPositions :: SourcePos -> SourcePos -> SourceSpan
sourceSpanFromPositions SourcePos
start SourcePos
end =
  SourceSpan
    { sourceSpanStartLine :: Int
sourceSpanStartLine = Pos -> Int
MP.unPos (SourcePos -> Pos
sourceLine SourcePos
start),
      sourceSpanStartCol :: Int
sourceSpanStartCol = Pos -> Int
MP.unPos (SourcePos -> Pos
sourceColumn SourcePos
start),
      sourceSpanEndLine :: Int
sourceSpanEndLine = Pos -> Int
MP.unPos (SourcePos -> Pos
sourceLine SourcePos
end),
      sourceSpanEndCol :: Int
sourceSpanEndCol = Pos -> Int
MP.unPos (SourcePos -> Pos
sourceColumn SourcePos
end)
    }

markSingleParenConstraint :: [Constraint] -> [Constraint]
markSingleParenConstraint :: [Constraint] -> [Constraint]
markSingleParenConstraint [Constraint]
constraints =
  case [Constraint]
constraints of
    [Constraint
constraint] -> [Constraint
constraint {constraintParen = True}]
    [Constraint]
_ -> [Constraint]
constraints

parens :: TokParser a -> TokParser a
parens :: forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
parens TokParser a
parser = do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLParen
  res <- TokParser a
parser
  expectedTok TkSpecialRParen
  pure res

skipSemicolons :: TokParser ()
skipSemicolons :: TokParser ()
skipSemicolons = TokParser () -> TokParser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
MP.skipMany (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialSemicolon)

bracedSemiSep :: TokParser a -> TokParser [a]
bracedSemiSep :: forall a. TokParser a -> TokParser [a]
bracedSemiSep TokParser a
parser = do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLBrace
  TokParser ()
skipSemicolons
  items <- TokParser a
parser TokParser a -> TokParser () -> ParsecT Void TokStream Identity [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialSemicolon
  expectedTok TkSpecialRBrace
  pure items

bracedSemiSep1 :: TokParser a -> TokParser [a]
bracedSemiSep1 :: forall a. TokParser a -> TokParser [a]
bracedSemiSep1 TokParser a
parser = do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLBrace
  TokParser ()
skipSemicolons
  items <- TokParser a
parser TokParser a -> TokParser () -> ParsecT Void TokStream Identity [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy1` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialSemicolon
  expectedTok TkSpecialRBrace
  pure items

plainSemiSep1 :: TokParser a -> TokParser [a]
plainSemiSep1 :: forall a. TokParser a -> TokParser [a]
plainSemiSep1 TokParser a
parser = TokParser a -> ParsecT Void TokStream Identity [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some (TokParser a
parser TokParser a -> TokParser () -> TokParser a
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* TokParser ()
skipSemicolons)

constraintParserWith :: TokParser Type -> TokParser Constraint
constraintParserWith :: TokParser Type -> TokParser Constraint
constraintParserWith TokParser Type
typeAtomParser = TokParser (SourceSpan -> Constraint) -> TokParser Constraint
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> Constraint) -> TokParser Constraint)
-> TokParser (SourceSpan -> Constraint) -> TokParser Constraint
forall a b. (a -> b) -> a -> b
$ do
  className <- TokParser Text
constructorIdentifierParser
  args <- MP.many typeAtomParser
  pure $ \SourceSpan
span' ->
    Constraint
      { constraintSpan :: SourceSpan
constraintSpan = SourceSpan
span',
        constraintClass :: Text
constraintClass = Text
className,
        constraintArgs :: [Type]
constraintArgs = [Type]
args,
        constraintParen :: Bool
constraintParen = Bool
False
      }

constraintsParserWith :: TokParser Type -> TokParser [Constraint]
constraintsParserWith :: TokParser Type -> TokParser [Constraint]
constraintsParserWith TokParser Type
typeAtomParser =
  TokParser [Constraint] -> TokParser [Constraint]
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 [Constraint] -> TokParser [Constraint]
forall a.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity a
parens ([Constraint] -> [Constraint]
markSingleParenConstraint ([Constraint] -> [Constraint])
-> TokParser [Constraint] -> TokParser [Constraint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TokParser Type -> TokParser Constraint
constraintParserWith TokParser Type
typeAtomParser TokParser Constraint -> TokParser () -> TokParser [Constraint]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma)))
    TokParser [Constraint]
-> TokParser [Constraint] -> TokParser [Constraint]
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
<|> (Constraint -> [Constraint])
-> TokParser Constraint -> TokParser [Constraint]
forall a b.
(a -> b)
-> ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Constraint -> [Constraint]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TokParser Type -> TokParser Constraint
constraintParserWith TokParser Type
typeAtomParser)

contextParserWith :: TokParser Type -> TokParser [Constraint]
contextParserWith :: TokParser Type -> TokParser [Constraint]
contextParserWith = TokParser Type -> TokParser [Constraint]
constraintsParserWith

functionBindValue :: SourceSpan -> Text -> [Pattern] -> Rhs -> ValueDecl
functionBindValue :: SourceSpan -> Text -> [Pattern] -> Rhs -> ValueDecl
functionBindValue SourceSpan
span' Text
name [Pattern]
pats Rhs
rhs =
  SourceSpan -> Text -> [Match] -> ValueDecl
FunctionBind
    SourceSpan
span'
    Text
name
    [ Match
        { matchSpan :: SourceSpan
matchSpan = SourceSpan
span',
          matchPats :: [Pattern]
matchPats = [Pattern]
pats,
          matchRhs :: Rhs
matchRhs = Rhs
rhs
        }
    ]

functionBindDecl :: SourceSpan -> Text -> [Pattern] -> Rhs -> Decl
functionBindDecl :: SourceSpan -> Text -> [Pattern] -> Rhs -> Decl
functionBindDecl SourceSpan
span' Text
name [Pattern]
pats Rhs
rhs =
  SourceSpan -> ValueDecl -> Decl
DeclValue SourceSpan
span' (SourceSpan -> Text -> [Pattern] -> Rhs -> ValueDecl
functionBindValue SourceSpan
span' Text
name [Pattern]
pats Rhs
rhs)

renderKeyword :: LexTokenKind -> String
renderKeyword :: LexTokenKind -> String
renderKeyword LexTokenKind
keyword =
  case LexTokenKind
keyword of
    LexTokenKind
TkKeywordModule -> String
"'module'"
    LexTokenKind
TkKeywordWhere -> String
"'where'"
    LexTokenKind
TkKeywordDo -> String
"'do'"
    LexTokenKind
TkKeywordData -> String
"'data'"
    LexTokenKind
TkKeywordImport -> String
"'import'"
    LexTokenKind
TkKeywordQualified -> String
"'qualified'"
    LexTokenKind
TkKeywordAs -> String
"'as'"
    LexTokenKind
TkKeywordHiding -> String
"'hiding'"
    LexTokenKind
TkKeywordCase -> String
"'case'"
    LexTokenKind
TkKeywordOf -> String
"'of'"
    LexTokenKind
TkKeywordLet -> String
"'let'"
    LexTokenKind
TkKeywordIn -> String
"'in'"
    LexTokenKind
TkKeywordIf -> String
"'if'"
    LexTokenKind
TkKeywordThen -> String
"'then'"
    LexTokenKind
TkKeywordElse -> String
"'else'"
    LexTokenKind
_ -> String
"keyword"

isModuleName :: Text -> Bool
isModuleName :: Text -> Bool
isModuleName Text
name =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
name of
    [] -> Bool
False
    [Text]
segments -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
isConstructorIdentifier [Text]
segments

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