{-# LANGUAGE OverloadedStrings #-}

module Aihc.Parser.Internal.Decl
  ( declParser,
    importDeclParser,
    moduleHeaderParser,
    languagePragmaParser,
  )
where

import Aihc.Parser.Internal.Common
import Aihc.Parser.Internal.Expr (equationRhsParser, exprParser, patternParser, simplePatternParser, typeAppParser, typeAtomParser, typeParser)
import Aihc.Parser.Lex (LexTokenKind (..), lexTokenKind)
import Aihc.Parser.Syntax
import Control.Monad (when)
import Data.Char (isAsciiLower, isUpper)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Text.Megaparsec (anySingle, lookAhead, (<|>))
import Text.Megaparsec qualified as MP

languagePragmaParser :: TokParser [ExtensionSetting]
languagePragmaParser :: TokParser [ExtensionSetting]
languagePragmaParser =
  String
-> (LexToken -> Maybe [ExtensionSetting])
-> TokParser [ExtensionSetting]
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"LANGUAGE pragma" ((LexToken -> Maybe [ExtensionSetting])
 -> TokParser [ExtensionSetting])
-> (LexToken -> Maybe [ExtensionSetting])
-> TokParser [ExtensionSetting]
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkPragmaLanguage [ExtensionSetting]
names -> [ExtensionSetting] -> Maybe [ExtensionSetting]
forall a. a -> Maybe a
Just [ExtensionSetting]
names
      LexTokenKind
_ -> Maybe [ExtensionSetting]
forall a. Maybe a
Nothing

moduleHeaderParser :: TokParser ModuleHead
moduleHeaderParser :: TokParser ModuleHead
moduleHeaderParser = TokParser (SourceSpan -> ModuleHead) -> TokParser ModuleHead
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> ModuleHead) -> TokParser ModuleHead)
-> TokParser (SourceSpan -> ModuleHead) -> TokParser ModuleHead
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordModule
  name <- TokParser Text
moduleNameParser
  mWarning <- MP.optional warningTextParser
  exports <- MP.optional exportSpecListParser
  keywordTok TkKeywordWhere
  pure $ \SourceSpan
span' ->
    ModuleHead
      { moduleHeadSpan :: SourceSpan
moduleHeadSpan = SourceSpan
span',
        moduleHeadName :: Text
moduleHeadName = Text
name,
        moduleHeadWarningText :: Maybe WarningText
moduleHeadWarningText = Maybe WarningText
mWarning,
        moduleHeadExports :: Maybe [ExportSpec]
moduleHeadExports = Maybe [ExportSpec]
exports
      }

warningTextParser :: TokParser WarningText
warningTextParser :: ParsecT Void TokStream Identity WarningText
warningTextParser =
  TokParser (SourceSpan -> WarningText)
-> ParsecT Void TokStream Identity WarningText
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> WarningText)
 -> ParsecT Void TokStream Identity WarningText)
-> TokParser (SourceSpan -> WarningText)
-> ParsecT Void TokStream Identity WarningText
forall a b. (a -> b) -> a -> b
$
    String
-> (LexToken -> Maybe (SourceSpan -> WarningText))
-> TokParser (SourceSpan -> WarningText)
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"warning pragma" ((LexToken -> Maybe (SourceSpan -> WarningText))
 -> TokParser (SourceSpan -> WarningText))
-> (LexToken -> Maybe (SourceSpan -> WarningText))
-> TokParser (SourceSpan -> WarningText)
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
      case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
        TkPragmaWarning Text
msg -> (SourceSpan -> WarningText) -> Maybe (SourceSpan -> WarningText)
forall a. a -> Maybe a
Just (SourceSpan -> Text -> WarningText
`WarnText` Text
msg)
        TkPragmaDeprecated Text
msg -> (SourceSpan -> WarningText) -> Maybe (SourceSpan -> WarningText)
forall a. a -> Maybe a
Just (SourceSpan -> Text -> WarningText
`DeprText` Text
msg)
        LexTokenKind
_ -> Maybe (SourceSpan -> WarningText)
forall a. Maybe a
Nothing

exportSpecListParser :: TokParser [ExportSpec]
exportSpecListParser :: ParsecT Void TokStream Identity [ExportSpec]
exportSpecListParser = ParsecT Void TokStream Identity [ExportSpec]
-> ParsecT Void TokStream Identity [ExportSpec]
forall a. TokParser a -> TokParser a
parens (ParsecT Void TokStream Identity [ExportSpec]
 -> ParsecT Void TokStream Identity [ExportSpec])
-> ParsecT Void TokStream Identity [ExportSpec]
-> ParsecT Void TokStream Identity [ExportSpec]
forall a b. (a -> b) -> a -> b
$ TokParser ExportSpec
exportSpecParser TokParser ExportSpec
-> TokParser () -> ParsecT Void TokStream Identity [ExportSpec]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma

exportSpecParser :: TokParser ExportSpec
exportSpecParser :: TokParser ExportSpec
exportSpecParser =
  TokParser (SourceSpan -> ExportSpec) -> TokParser ExportSpec
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> ExportSpec) -> TokParser ExportSpec)
-> TokParser (SourceSpan -> ExportSpec) -> TokParser ExportSpec
forall a b. (a -> b) -> a -> b
$
    TokParser (SourceSpan -> ExportSpec)
-> TokParser (SourceSpan -> ExportSpec)
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> ExportSpec)
exportModuleParser TokParser (SourceSpan -> ExportSpec)
-> TokParser (SourceSpan -> ExportSpec)
-> TokParser (SourceSpan -> ExportSpec)
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 -> ExportSpec)
exportNameParser

exportModuleParser :: TokParser (SourceSpan -> ExportSpec)
exportModuleParser :: TokParser (SourceSpan -> ExportSpec)
exportModuleParser = do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordModule
  modName <- TokParser Text
moduleNameParser
  pure (`ExportModule` modName)

exportNameParser :: TokParser (SourceSpan -> ExportSpec)
exportNameParser :: TokParser (SourceSpan -> ExportSpec)
exportNameParser = do
  namespace <- TokParser Text -> ParsecT Void TokStream Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional TokParser Text
exportImportNamespaceParser
  name <- identifierTextParser <|> parens operatorTextParser
  members <- MP.optional exportMembersParser
  pure $ \SourceSpan
span' ->
    case Maybe (Maybe [Text])
members of
      Just Maybe [Text]
Nothing -> SourceSpan -> Maybe Text -> Text -> ExportSpec
ExportAll SourceSpan
span' Maybe Text
namespace Text
name
      Just (Just [Text]
names) -> SourceSpan -> Maybe Text -> Text -> [Text] -> ExportSpec
ExportWith SourceSpan
span' Maybe Text
namespace Text
name [Text]
names
      Maybe (Maybe [Text])
Nothing
        | Maybe Text
namespace Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"type" Bool -> Bool -> Bool
|| Text -> Bool
isTypeName Text
name -> SourceSpan -> Maybe Text -> Text -> ExportSpec
ExportAbs SourceSpan
span' Maybe Text
namespace Text
name
        | Bool
otherwise -> SourceSpan -> Maybe Text -> Text -> ExportSpec
ExportVar SourceSpan
span' Maybe Text
namespace Text
name

exportMembersParser :: TokParser (Maybe [Text])
exportMembersParser :: ParsecT Void TokStream Identity (Maybe [Text])
exportMembersParser =
  ParsecT Void TokStream Identity (Maybe [Text])
-> ParsecT Void TokStream Identity (Maybe [Text])
forall a. TokParser a -> TokParser a
parens (ParsecT Void TokStream Identity (Maybe [Text])
 -> ParsecT Void TokStream Identity (Maybe [Text]))
-> ParsecT Void TokStream Identity (Maybe [Text])
-> ParsecT Void TokStream Identity (Maybe [Text])
forall a b. (a -> b) -> a -> b
$
    (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedDotDot TokParser ()
-> ParsecT Void TokStream Identity (Maybe [Text])
-> ParsecT Void TokStream Identity (Maybe [Text])
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe [Text] -> ParsecT Void TokStream Identity (Maybe [Text])
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Text]
forall a. Maybe a
Nothing)
      ParsecT Void TokStream Identity (Maybe [Text])
-> ParsecT Void TokStream Identity (Maybe [Text])
-> ParsecT Void TokStream Identity (Maybe [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
<|> ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text])
-> ParsecT Void TokStream Identity [Text]
-> ParsecT Void TokStream Identity (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TokParser Text
memberNameParser TokParser Text
-> TokParser () -> ParsecT Void TokStream Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma))
  where
    memberNameParser :: TokParser Text
memberNameParser = 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. TokParser a -> TokParser a
parens TokParser Text
operatorTextParser

-- | Checks if a name refers to a type/class (as opposed to a variable/function).
-- In Haskell:
-- - Identifiers starting with uppercase letters are type constructors/classes
-- - Symbolic operators starting with ':' are constructor operators (type-level)
isTypeName :: Text -> Bool
isTypeName :: Text -> Bool
isTypeName Text
txt =
  case Text -> Maybe (Char, Text)
T.uncons Text
txt of
    Just (Char
c, Text
_) -> Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'
    Maybe (Char, Text)
Nothing -> Bool
False

importDeclParser :: TokParser ImportDecl
importDeclParser :: TokParser ImportDecl
importDeclParser = TokParser (SourceSpan -> ImportDecl) -> TokParser ImportDecl
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> ImportDecl) -> TokParser ImportDecl)
-> TokParser (SourceSpan -> ImportDecl) -> TokParser ImportDecl
forall a b. (a -> b) -> a -> b
$ do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordImport
  preQualified <-
    Bool
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
MP.option Bool
False (LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordQualified TokParser ()
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Void TokStream Identity Bool
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
  importedLevel <- MP.optional importLevelParser
  importedPackage <- MP.optional packageNameParser
  importedModule <- moduleNameParser
  postQualified <-
    MP.option False (keywordTok TkKeywordQualified >> pure True)
  when (preQualified && postQualified) $
    fail "import declaration cannot contain 'qualified' both before and after the module name"
  importAlias <- MP.optional (keywordTok TkKeywordAs *> moduleNameParser)
  importSpec <- MP.optional importSpecParser
  let isQualified = Bool
preQualified Bool -> Bool -> Bool
|| Bool
postQualified
  pure $ \SourceSpan
span' ->
    ImportDecl
      { importDeclSpan :: SourceSpan
importDeclSpan = SourceSpan
span',
        importDeclLevel :: Maybe ImportLevel
importDeclLevel = Maybe ImportLevel
importedLevel,
        importDeclPackage :: Maybe Text
importDeclPackage = Maybe Text
importedPackage,
        importDeclQualified :: Bool
importDeclQualified = Bool
isQualified,
        importDeclQualifiedPost :: Bool
importDeclQualifiedPost = Bool
postQualified,
        importDeclModule :: Text
importDeclModule = Text
importedModule,
        importDeclAs :: Maybe Text
importDeclAs = Maybe Text
importAlias,
        importDeclSpec :: Maybe ImportSpec
importDeclSpec = Maybe ImportSpec
importSpec
      }

importLevelParser :: TokParser ImportLevel
importLevelParser :: ParsecT Void TokStream Identity ImportLevel
importLevelParser =
  (Text -> TokParser ()
varIdTok Text
"quote" TokParser ()
-> ParsecT Void TokStream Identity ImportLevel
-> ParsecT Void TokStream Identity ImportLevel
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ImportLevel -> ParsecT Void TokStream Identity ImportLevel
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportLevel
ImportLevelQuote)
    ParsecT Void TokStream Identity ImportLevel
-> ParsecT Void TokStream Identity ImportLevel
-> ParsecT Void TokStream Identity ImportLevel
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
<|> (Text -> TokParser ()
varIdTok Text
"splice" TokParser ()
-> ParsecT Void TokStream Identity ImportLevel
-> ParsecT Void TokStream Identity ImportLevel
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ImportLevel -> ParsecT Void TokStream Identity ImportLevel
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImportLevel
ImportLevelSplice)

packageNameParser :: TokParser Text
packageNameParser :: TokParser Text
packageNameParser = TokParser Text
stringTextParser

importSpecParser :: TokParser ImportSpec
importSpecParser :: ParsecT Void TokStream Identity ImportSpec
importSpecParser = TokParser (SourceSpan -> ImportSpec)
-> ParsecT Void TokStream Identity ImportSpec
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> ImportSpec)
 -> ParsecT Void TokStream Identity ImportSpec)
-> TokParser (SourceSpan -> ImportSpec)
-> ParsecT Void TokStream Identity ImportSpec
forall a b. (a -> b) -> a -> b
$ do
  isHiding <-
    Bool
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
MP.option Bool
False (LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordHiding TokParser ()
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Void TokStream Identity Bool
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
  items <- parens $ importItemParser `MP.sepEndBy` expectedTok TkSpecialComma
  pure $ \SourceSpan
span' ->
    ImportSpec
      { importSpecSpan :: SourceSpan
importSpecSpan = SourceSpan
span',
        importSpecHiding :: Bool
importSpecHiding = Bool
isHiding,
        importSpecItems :: [ImportItem]
importSpecItems = [ImportItem]
items
      }

importItemParser :: TokParser ImportItem
importItemParser :: TokParser ImportItem
importItemParser = TokParser (SourceSpan -> ImportItem) -> TokParser ImportItem
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> ImportItem) -> TokParser ImportItem)
-> TokParser (SourceSpan -> ImportItem) -> TokParser ImportItem
forall a b. (a -> b) -> a -> b
$ do
  namespace <- TokParser Text -> ParsecT Void TokStream Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional TokParser Text
exportImportNamespaceParser
  itemName <- identifierTextParser <|> parens importOperatorParser
  -- When there's no explicit namespace, we still need to try parsing members
  -- for type constructors and type classes (uppercase names or parenthesized operators)
  let shouldTryMembers = case Maybe Text
namespace of
        Just Text
_ -> Bool
True
        Maybe Text
Nothing -> Text -> Bool
isTypeName Text
itemName
  members <- if shouldTryMembers then MP.optional exportMembersParser else pure Nothing
  let effectiveNamespace = Maybe Text
namespace
  pure $ \SourceSpan
span' ->
    case Maybe (Maybe [Text])
members of
      Just Maybe [Text]
Nothing -> SourceSpan -> Maybe Text -> Text -> ImportItem
ImportItemAll SourceSpan
span' Maybe Text
effectiveNamespace Text
itemName
      Just (Just [Text]
names) -> SourceSpan -> Maybe Text -> Text -> [Text] -> ImportItem
ImportItemWith SourceSpan
span' Maybe Text
effectiveNamespace Text
itemName [Text]
names
      Maybe (Maybe [Text])
Nothing
        | Maybe Text
effectiveNamespace Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"type" Bool -> Bool -> Bool
|| Text -> Bool
isTypeName Text
itemName -> SourceSpan -> Maybe Text -> Text -> ImportItem
ImportItemAbs SourceSpan
span' Maybe Text
effectiveNamespace Text
itemName
        | Bool
otherwise -> SourceSpan -> Maybe Text -> Text -> ImportItem
ImportItemVar SourceSpan
span' Maybe Text
effectiveNamespace Text
itemName

importOperatorParser :: TokParser Text
importOperatorParser :: TokParser Text
importOperatorParser = TokParser Text
operatorTextParser

exportImportNamespaceParser :: TokParser Text
exportImportNamespaceParser :: TokParser Text
exportImportNamespaceParser =
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordType TokParser () -> TokParser Text -> TokParser Text
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> TokParser Text
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"type"

declParser :: TokParser Decl
declParser :: TokParser Decl
declParser = do
  tok <- ParsecT Void TokStream Identity LexToken
-> ParsecT Void TokStream Identity LexToken
forall a. TokParser a -> TokParser 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
TkKeywordData -> TokParser Decl
dataDeclParser
    LexTokenKind
TkKeywordClass -> TokParser Decl
classDeclParser
    LexTokenKind
TkKeywordDefault -> TokParser Decl
defaultDeclParser
    LexTokenKind
TkKeywordDeriving -> TokParser Decl
standaloneDerivingDeclParser
    LexTokenKind
TkKeywordForeign -> TokParser Decl
foreignDeclParser
    LexTokenKind
TkKeywordInfix -> FixityAssoc -> TokParser Decl
fixityDeclParser FixityAssoc
Infix
    LexTokenKind
TkKeywordInfixl -> FixityAssoc -> TokParser Decl
fixityDeclParser FixityAssoc
InfixL
    LexTokenKind
TkKeywordInfixr -> FixityAssoc -> TokParser Decl
fixityDeclParser FixityAssoc
InfixR
    LexTokenKind
TkKeywordInstance -> TokParser Decl
instanceDeclParser
    LexTokenKind
TkKeywordNewtype -> TokParser Decl
newtypeDeclParser
    LexTokenKind
TkKeywordType -> TokParser Decl -> TokParser Decl
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Decl
standaloneKindSigDeclParser 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
typeSynDeclParser
    TkVarId Text
ident ->
      case Text
ident of
        Text
"pattern" -> String -> TokParser Decl
unsupportedDeclParser String
"pattern synonym declarations are not implemented yet"
        Text
_ -> TokParser Decl -> TokParser Decl
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Decl
typeSigDeclParser 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
valueDeclParser
    TkConId Text
ident ->
      case Text
ident of
        Text
"pattern" -> String -> TokParser Decl
unsupportedDeclParser String
"pattern synonym declarations are not implemented yet"
        Text
_ -> TokParser Decl -> TokParser Decl
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Decl
typeSigDeclParser 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
valueDeclParser
    LexTokenKind
TkSpecialLParen -> TokParser Decl -> TokParser Decl
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Decl
typeSigDeclParser 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. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Decl
patternBindDeclParser 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
valueDeclParser
    LexTokenKind
TkSpecialLBracket -> TokParser Decl
patternBindDeclParser
    LexTokenKind
TkPrefixTilde -> TokParser Decl
patternBindDeclParser
    LexTokenKind
TkKeywordUnderscore -> TokParser Decl
patternBindDeclParser
    LexTokenKind
_ -> TokParser Decl -> TokParser Decl
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser Decl
typeSigDeclParser 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
valueDeclParser

standaloneKindSigDeclParser :: TokParser Decl
standaloneKindSigDeclParser :: TokParser Decl
standaloneKindSigDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordType
  typeName <- TokParser Text
constructorIdentifierParser
  expectedTok TkReservedDoubleColon
  kind <- typeParser
  pure (\SourceSpan
span' -> SourceSpan -> Text -> Type -> Decl
DeclStandaloneKindSig SourceSpan
span' Text
typeName Type
kind)

typeSynDeclParser :: TokParser Decl
typeSynDeclParser :: TokParser Decl
typeSynDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordType
  typeName <- TokParser Text
constructorIdentifierParser
  typeParams <- MP.many typeParamParser
  expectedTok TkReservedEquals
  body <- typeParser
  pure $ \SourceSpan
span' ->
    SourceSpan -> TypeSynDecl -> Decl
DeclTypeSyn
      SourceSpan
span'
      TypeSynDecl
        { typeSynSpan :: SourceSpan
typeSynSpan = SourceSpan
span',
          typeSynName :: Text
typeSynName = Text
typeName,
          typeSynParams :: [TyVarBinder]
typeSynParams = [TyVarBinder]
typeParams,
          typeSynBody :: Type
typeSynBody = Type
body
        }

typeSigDeclParser :: TokParser Decl
typeSigDeclParser :: TokParser Decl
typeSigDeclParser = 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 <- TokParser Text
binderNameParser TokParser 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)

defaultDeclParser :: TokParser Decl
defaultDeclParser :: TokParser Decl
defaultDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordDefault
  tys <- TokParser [Type] -> TokParser [Type]
forall a. TokParser a -> TokParser a
parens (TokParser Type
typeParser TokParser Type -> TokParser () -> TokParser [Type]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy1` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma)
  pure (`DeclDefault` tys)

fixityDeclParser :: FixityAssoc -> TokParser Decl
fixityDeclParser :: FixityAssoc -> TokParser Decl
fixityDeclParser FixityAssoc
assoc = 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
  (parsedAssoc, prec, ops) <- TokParser (FixityAssoc, Maybe Int, [Text])
fixityDeclPartsParser
  when (assoc /= parsedAssoc) $
    fail "internal fixity dispatch mismatch"
  pure (\SourceSpan
span' -> SourceSpan -> FixityAssoc -> Maybe Int -> [Text] -> Decl
DeclFixity SourceSpan
span' FixityAssoc
parsedAssoc Maybe Int
prec [Text]
ops)

fixityDeclPartsParser :: TokParser (FixityAssoc, Maybe Int, [Text])
fixityDeclPartsParser :: TokParser (FixityAssoc, Maybe Int, [Text])
fixityDeclPartsParser = do
  assoc <- TokParser FixityAssoc
fixityAssocParser
  prec <- MP.optional fixityPrecedenceParser
  ops <- fixityOperatorParser `MP.sepBy1` expectedTok TkSpecialComma
  pure (assoc, prec, ops)

fixityAssocParser :: TokParser FixityAssoc
fixityAssocParser :: TokParser FixityAssoc
fixityAssocParser =
  (LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordInfix TokParser () -> TokParser FixityAssoc -> TokParser FixityAssoc
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FixityAssoc -> TokParser FixityAssoc
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityAssoc
Infix)
    TokParser FixityAssoc
-> TokParser FixityAssoc -> TokParser FixityAssoc
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
<|> (LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordInfixl TokParser () -> TokParser FixityAssoc -> TokParser FixityAssoc
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FixityAssoc -> TokParser FixityAssoc
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityAssoc
InfixL)
    TokParser FixityAssoc
-> TokParser FixityAssoc -> TokParser FixityAssoc
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
<|> (LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordInfixr TokParser () -> TokParser FixityAssoc -> TokParser FixityAssoc
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FixityAssoc -> TokParser FixityAssoc
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FixityAssoc
InfixR)

fixityPrecedenceParser :: TokParser Int
fixityPrecedenceParser :: ParsecT Void TokStream Identity Int
fixityPrecedenceParser =
  String
-> (LexToken -> Maybe Int) -> ParsecT Void TokStream Identity Int
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"fixity precedence" ((LexToken -> Maybe Int) -> ParsecT Void TokStream Identity Int)
-> (LexToken -> Maybe Int) -> ParsecT Void TokStream Identity Int
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      TkInteger Integer
n
        | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
9 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
      LexTokenKind
_ -> Maybe Int
forall a. Maybe a
Nothing

fixityOperatorParser :: TokParser Text
fixityOperatorParser :: TokParser Text
fixityOperatorParser =
  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
"fixity 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
    backtickIdentifierParser :: TokParser Text
backtickIdentifierParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialBacktick
      op <- TokParser Text
identifierTextParser
      expectedTok TkSpecialBacktick
      pure op

classDeclParser :: TokParser Decl
classDeclParser :: TokParser Decl
classDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordClass
  context <- ParsecT Void TokStream Identity [Constraint]
-> ParsecT Void TokStream Identity (Maybe [Constraint])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (ParsecT Void TokStream Identity [Constraint]
-> ParsecT Void TokStream Identity [Constraint]
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void TokStream Identity [Constraint]
declContextParser ParsecT Void TokStream Identity [Constraint]
-> TokParser () -> ParsecT Void TokStream Identity [Constraint]
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
<* LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedDoubleArrow))
  className <- constructorIdentifierParser
  classParams <- MP.some typeParamParser
  items <- MP.option [] classWhereClauseParser
  pure $ \SourceSpan
span' ->
    SourceSpan -> ClassDecl -> Decl
DeclClass
      SourceSpan
span'
      ClassDecl
        { classDeclSpan :: SourceSpan
classDeclSpan = SourceSpan
span',
          classDeclContext :: Maybe [Constraint]
classDeclContext = Maybe [Constraint]
context,
          classDeclName :: Text
classDeclName = Text
className,
          classDeclParams :: [TyVarBinder]
classDeclParams = [TyVarBinder]
classParams,
          classDeclItems :: [ClassDeclItem]
classDeclItems = [ClassDeclItem]
items
        }

classWhereClauseParser :: TokParser [ClassDeclItem]
classWhereClauseParser :: ParsecT Void TokStream Identity [ClassDeclItem]
classWhereClauseParser = ParsecT Void TokStream Identity [ClassDeclItem]
-> ParsecT Void TokStream Identity [ClassDeclItem]
-> ParsecT Void TokStream Identity [ClassDeclItem]
forall item.
TokParser [item] -> TokParser [item] -> TokParser [item]
whereClauseItemsParser ParsecT Void TokStream Identity [ClassDeclItem]
classItemsBracedParser ParsecT Void TokStream Identity [ClassDeclItem]
classItemsPlainParser

whereClauseItemsParser :: TokParser [item] -> TokParser [item] -> TokParser [item]
whereClauseItemsParser :: forall item.
TokParser [item] -> TokParser [item] -> TokParser [item]
whereClauseItemsParser TokParser [item]
bracedParser TokParser [item]
plainParser = do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordWhere
  TokParser [item]
bracedParser TokParser [item] -> TokParser [item] -> TokParser [item]
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 [item]
plainParser TokParser [item] -> TokParser [item] -> TokParser [item]
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
<|> [item] -> TokParser [item]
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

classItemsPlainParser :: TokParser [ClassDeclItem]
classItemsPlainParser :: ParsecT Void TokStream Identity [ClassDeclItem]
classItemsPlainParser = TokParser ClassDeclItem
-> ParsecT Void TokStream Identity [ClassDeclItem]
forall a. TokParser a -> TokParser [a]
plainSemiSep1 TokParser ClassDeclItem
classDeclItemParser

classItemsBracedParser :: TokParser [ClassDeclItem]
classItemsBracedParser :: ParsecT Void TokStream Identity [ClassDeclItem]
classItemsBracedParser = TokParser ClassDeclItem
-> ParsecT Void TokStream Identity [ClassDeclItem]
forall a. TokParser a -> TokParser [a]
bracedSemiSep TokParser ClassDeclItem
classDeclItemParser

classDeclItemParser :: TokParser ClassDeclItem
classDeclItemParser :: TokParser ClassDeclItem
classDeclItemParser = TokParser ClassDeclItem -> TokParser ClassDeclItem
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser ClassDeclItem
classFixityItemParser TokParser ClassDeclItem
-> TokParser ClassDeclItem -> TokParser ClassDeclItem
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 ClassDeclItem -> TokParser ClassDeclItem
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser ClassDeclItem
classTypeSigItemParser TokParser ClassDeclItem
-> TokParser ClassDeclItem -> TokParser ClassDeclItem
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 ClassDeclItem
classDefaultItemParser

classTypeSigItemParser :: TokParser ClassDeclItem
classTypeSigItemParser :: TokParser ClassDeclItem
classTypeSigItemParser = TokParser (SourceSpan -> ClassDeclItem) -> TokParser ClassDeclItem
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> ClassDeclItem)
 -> TokParser ClassDeclItem)
-> TokParser (SourceSpan -> ClassDeclItem)
-> TokParser ClassDeclItem
forall a b. (a -> b) -> a -> b
$ do
  names <- TokParser Text
binderNameParser TokParser 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 -> ClassDeclItem
ClassItemTypeSig SourceSpan
span' [Text]
names Type
ty)

classFixityItemParser :: TokParser ClassDeclItem
classFixityItemParser :: TokParser ClassDeclItem
classFixityItemParser = TokParser (SourceSpan -> ClassDeclItem) -> TokParser ClassDeclItem
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> ClassDeclItem)
 -> TokParser ClassDeclItem)
-> TokParser (SourceSpan -> ClassDeclItem)
-> TokParser ClassDeclItem
forall a b. (a -> b) -> a -> b
$ do
  (assoc, prec, ops) <- TokParser (FixityAssoc, Maybe Int, [Text])
fixityDeclPartsParser
  pure (\SourceSpan
span' -> SourceSpan -> FixityAssoc -> Maybe Int -> [Text] -> ClassDeclItem
ClassItemFixity SourceSpan
span' FixityAssoc
assoc Maybe Int
prec [Text]
ops)

classDefaultItemParser :: TokParser ClassDeclItem
classDefaultItemParser :: TokParser ClassDeclItem
classDefaultItemParser = TokParser (SourceSpan -> ClassDeclItem) -> TokParser ClassDeclItem
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> ClassDeclItem)
 -> TokParser ClassDeclItem)
-> TokParser (SourceSpan -> ClassDeclItem)
-> TokParser ClassDeclItem
forall a b. (a -> b) -> a -> b
$ TokParser (SourceSpan -> ClassDeclItem)
-> TokParser (SourceSpan -> ClassDeclItem)
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> ClassDeclItem)
infixClassDefaultParser TokParser (SourceSpan -> ClassDeclItem)
-> TokParser (SourceSpan -> ClassDeclItem)
-> TokParser (SourceSpan -> ClassDeclItem)
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 -> ClassDeclItem)
prefixClassDefaultParser
  where
    prefixClassDefaultParser :: TokParser (SourceSpan -> ClassDeclItem)
prefixClassDefaultParser = do
      name <- TokParser Text
binderNameParser
      pats <- MP.many simplePatternParser
      expectedTok TkReservedEquals
      rhsExpr <- exprParser
      pure (\SourceSpan
span' -> SourceSpan -> ValueDecl -> ClassDeclItem
ClassItemDefault SourceSpan
span' (SourceSpan -> Text -> [Pattern] -> Rhs -> ValueDecl
functionBindValue SourceSpan
span' Text
name [Pattern]
pats (SourceSpan -> Expr -> Rhs
UnguardedRhs SourceSpan
span' Expr
rhsExpr)))

    infixClassDefaultParser :: TokParser (SourceSpan -> ClassDeclItem)
infixClassDefaultParser = do
      lhsPat <- ParsecT Void TokStream Identity Pattern
patternParser
      op <- infixOperatorNameParser
      rhsPat <- patternParser
      expectedTok TkReservedEquals
      rhsExpr <- exprParser
      pure (\SourceSpan
span' -> SourceSpan -> ValueDecl -> ClassDeclItem
ClassItemDefault SourceSpan
span' (SourceSpan -> Text -> [Pattern] -> Rhs -> ValueDecl
functionBindValue SourceSpan
span' Text
op [Pattern
lhsPat, Pattern
rhsPat] (SourceSpan -> Expr -> Rhs
UnguardedRhs SourceSpan
span' Expr
rhsExpr)))

instanceDeclParser :: TokParser Decl
instanceDeclParser :: TokParser Decl
instanceDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordInstance
  context <- ParsecT Void TokStream Identity [Constraint]
-> ParsecT Void TokStream Identity (Maybe [Constraint])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (ParsecT Void TokStream Identity [Constraint]
-> ParsecT Void TokStream Identity [Constraint]
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void TokStream Identity [Constraint]
declContextParser ParsecT Void TokStream Identity [Constraint]
-> TokParser () -> ParsecT Void TokStream Identity [Constraint]
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
<* LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedDoubleArrow))
  className <- constructorIdentifierParser
  instanceTypes <- MP.some typeAtomParser
  items <- MP.option [] instanceWhereClauseParser
  pure $ \SourceSpan
span' ->
    SourceSpan -> InstanceDecl -> Decl
DeclInstance
      SourceSpan
span'
      InstanceDecl
        { instanceDeclSpan :: SourceSpan
instanceDeclSpan = SourceSpan
span',
          instanceDeclContext :: [Constraint]
instanceDeclContext = [Constraint] -> Maybe [Constraint] -> [Constraint]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Constraint]
context,
          instanceDeclClassName :: Text
instanceDeclClassName = Text
className,
          instanceDeclTypes :: [Type]
instanceDeclTypes = [Type]
instanceTypes,
          instanceDeclItems :: [InstanceDeclItem]
instanceDeclItems = [InstanceDeclItem]
items
        }

standaloneDerivingDeclParser :: TokParser Decl
standaloneDerivingDeclParser :: TokParser Decl
standaloneDerivingDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordDeriving
  strategy <- ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity (Maybe DerivingStrategy)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional ParsecT Void TokStream Identity DerivingStrategy
derivingStrategyParser
  keywordTok TkKeywordInstance
  context <- MP.optional (MP.try (declContextParser <* expectedTok TkReservedDoubleArrow))
  className <- constructorIdentifierParser
  instanceTypes <- MP.some typeAtomParser
  pure $ \SourceSpan
span' ->
    SourceSpan -> StandaloneDerivingDecl -> Decl
DeclStandaloneDeriving
      SourceSpan
span'
      StandaloneDerivingDecl
        { standaloneDerivingSpan :: SourceSpan
standaloneDerivingSpan = SourceSpan
span',
          standaloneDerivingStrategy :: Maybe DerivingStrategy
standaloneDerivingStrategy = Maybe DerivingStrategy
strategy,
          standaloneDerivingContext :: [Constraint]
standaloneDerivingContext = [Constraint] -> Maybe [Constraint] -> [Constraint]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Constraint]
context,
          standaloneDerivingClassName :: Text
standaloneDerivingClassName = Text
className,
          standaloneDerivingTypes :: [Type]
standaloneDerivingTypes = [Type]
instanceTypes
        }

instanceWhereClauseParser :: TokParser [InstanceDeclItem]
instanceWhereClauseParser :: ParsecT Void TokStream Identity [InstanceDeclItem]
instanceWhereClauseParser = ParsecT Void TokStream Identity [InstanceDeclItem]
-> ParsecT Void TokStream Identity [InstanceDeclItem]
-> ParsecT Void TokStream Identity [InstanceDeclItem]
forall item.
TokParser [item] -> TokParser [item] -> TokParser [item]
whereClauseItemsParser ParsecT Void TokStream Identity [InstanceDeclItem]
instanceItemsBracedParser ParsecT Void TokStream Identity [InstanceDeclItem]
instanceItemsPlainParser

instanceItemsPlainParser :: TokParser [InstanceDeclItem]
instanceItemsPlainParser :: ParsecT Void TokStream Identity [InstanceDeclItem]
instanceItemsPlainParser = TokParser InstanceDeclItem
-> ParsecT Void TokStream Identity [InstanceDeclItem]
forall a. TokParser a -> TokParser [a]
plainSemiSep1 TokParser InstanceDeclItem
instanceDeclItemParser

instanceItemsBracedParser :: TokParser [InstanceDeclItem]
instanceItemsBracedParser :: ParsecT Void TokStream Identity [InstanceDeclItem]
instanceItemsBracedParser = TokParser InstanceDeclItem
-> ParsecT Void TokStream Identity [InstanceDeclItem]
forall a. TokParser a -> TokParser [a]
bracedSemiSep TokParser InstanceDeclItem
instanceDeclItemParser

instanceDeclItemParser :: TokParser InstanceDeclItem
instanceDeclItemParser :: TokParser InstanceDeclItem
instanceDeclItemParser = TokParser InstanceDeclItem -> TokParser InstanceDeclItem
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser InstanceDeclItem
instanceFixityItemParser TokParser InstanceDeclItem
-> TokParser InstanceDeclItem -> TokParser InstanceDeclItem
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 InstanceDeclItem -> TokParser InstanceDeclItem
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser InstanceDeclItem
instanceTypeSigItemParser TokParser InstanceDeclItem
-> TokParser InstanceDeclItem -> TokParser InstanceDeclItem
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 InstanceDeclItem
instanceValueItemParser

instanceTypeSigItemParser :: TokParser InstanceDeclItem
instanceTypeSigItemParser :: TokParser InstanceDeclItem
instanceTypeSigItemParser = TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser InstanceDeclItem
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> InstanceDeclItem)
 -> TokParser InstanceDeclItem)
-> TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser InstanceDeclItem
forall a b. (a -> b) -> a -> b
$ do
  names <- TokParser Text
binderNameParser TokParser 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 -> InstanceDeclItem
InstanceItemTypeSig SourceSpan
span' [Text]
names Type
ty)

instanceFixityItemParser :: TokParser InstanceDeclItem
instanceFixityItemParser :: TokParser InstanceDeclItem
instanceFixityItemParser = TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser InstanceDeclItem
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> InstanceDeclItem)
 -> TokParser InstanceDeclItem)
-> TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser InstanceDeclItem
forall a b. (a -> b) -> a -> b
$ do
  (assoc, prec, ops) <- TokParser (FixityAssoc, Maybe Int, [Text])
fixityDeclPartsParser
  pure (\SourceSpan
span' -> SourceSpan
-> FixityAssoc -> Maybe Int -> [Text] -> InstanceDeclItem
InstanceItemFixity SourceSpan
span' FixityAssoc
assoc Maybe Int
prec [Text]
ops)

instanceValueItemParser :: TokParser InstanceDeclItem
instanceValueItemParser :: TokParser InstanceDeclItem
instanceValueItemParser = TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser InstanceDeclItem
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> InstanceDeclItem)
 -> TokParser InstanceDeclItem)
-> TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser InstanceDeclItem
forall a b. (a -> b) -> a -> b
$ TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser (SourceSpan -> InstanceDeclItem)
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> InstanceDeclItem)
infixInstanceValueParser TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser (SourceSpan -> InstanceDeclItem)
-> TokParser (SourceSpan -> InstanceDeclItem)
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 -> InstanceDeclItem)
prefixInstanceValueParser
  where
    prefixInstanceValueParser :: TokParser (SourceSpan -> InstanceDeclItem)
prefixInstanceValueParser = do
      name <- TokParser Text
binderNameParser
      pats <- MP.many simplePatternParser
      rhs <- equationRhsParser
      pure (\SourceSpan
span' -> SourceSpan -> ValueDecl -> InstanceDeclItem
InstanceItemBind SourceSpan
span' (SourceSpan -> Text -> [Pattern] -> Rhs -> ValueDecl
functionBindValue SourceSpan
span' Text
name [Pattern]
pats Rhs
rhs))

    infixInstanceValueParser :: TokParser (SourceSpan -> InstanceDeclItem)
infixInstanceValueParser = do
      lhsPat <- ParsecT Void TokStream Identity Pattern
patternParser
      op <- infixOperatorNameParser
      rhsPat <- patternParser
      rhs <- equationRhsParser
      pure (\SourceSpan
span' -> SourceSpan -> ValueDecl -> InstanceDeclItem
InstanceItemBind SourceSpan
span' (SourceSpan -> Text -> [Pattern] -> Rhs -> ValueDecl
functionBindValue SourceSpan
span' Text
op [Pattern
lhsPat, Pattern
rhsPat] Rhs
rhs))

foreignDeclParser :: TokParser Decl
foreignDeclParser :: TokParser Decl
foreignDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordForeign
  direction <- TokParser ForeignDirection
foreignDirectionParser
  callConv <- callConvParser
  safety <-
    case direction of
      ForeignDirection
ForeignImport -> ParsecT Void TokStream Identity ForeignSafety
-> ParsecT Void TokStream Identity (Maybe ForeignSafety)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional ParsecT Void TokStream Identity ForeignSafety
foreignSafetyParser
      ForeignDirection
ForeignExport -> Maybe ForeignSafety
-> ParsecT Void TokStream Identity (Maybe ForeignSafety)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ForeignSafety
forall a. Maybe a
Nothing
  entity <- MP.optional foreignEntityParser
  name <- identifierTextParser
  expectedTok TkReservedDoubleColon
  ty <- typeParser
  pure $ \SourceSpan
span' ->
    SourceSpan -> ForeignDecl -> Decl
DeclForeign
      SourceSpan
span'
      ForeignDecl
        { foreignDeclSpan :: SourceSpan
foreignDeclSpan = SourceSpan
span',
          foreignDirection :: ForeignDirection
foreignDirection = ForeignDirection
direction,
          foreignCallConv :: CallConv
foreignCallConv = CallConv
callConv,
          foreignSafety :: Maybe ForeignSafety
foreignSafety = Maybe ForeignSafety
safety,
          foreignEntity :: ForeignEntitySpec
foreignEntity = ForeignEntitySpec -> Maybe ForeignEntitySpec -> ForeignEntitySpec
forall a. a -> Maybe a -> a
fromMaybe ForeignEntitySpec
ForeignEntityOmitted Maybe ForeignEntitySpec
entity,
          foreignName :: Text
foreignName = Text
name,
          foreignType :: Type
foreignType = Type
ty
        }

foreignDirectionParser :: TokParser ForeignDirection
foreignDirectionParser :: TokParser ForeignDirection
foreignDirectionParser =
  (LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordImport TokParser ()
-> TokParser ForeignDirection -> TokParser ForeignDirection
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignDirection -> TokParser ForeignDirection
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignDirection
ForeignImport)
    TokParser ForeignDirection
-> TokParser ForeignDirection -> TokParser ForeignDirection
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
<|> (Text -> TokParser ()
varIdTok Text
"export" TokParser ()
-> TokParser ForeignDirection -> TokParser ForeignDirection
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignDirection -> TokParser ForeignDirection
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignDirection
ForeignExport)

callConvParser :: TokParser CallConv
callConvParser :: TokParser CallConv
callConvParser =
  (Text -> TokParser ()
varIdTok Text
"ccall" TokParser () -> TokParser CallConv -> TokParser CallConv
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CallConv -> TokParser CallConv
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CallConv
CCall)
    TokParser CallConv -> TokParser CallConv -> TokParser CallConv
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
<|> (Text -> TokParser ()
varIdTok Text
"stdcall" TokParser () -> TokParser CallConv -> TokParser CallConv
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CallConv -> TokParser CallConv
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CallConv
StdCall)

foreignSafetyParser :: TokParser ForeignSafety
foreignSafetyParser :: ParsecT Void TokStream Identity ForeignSafety
foreignSafetyParser =
  (Text -> TokParser ()
varIdTok Text
"safe" TokParser ()
-> ParsecT Void TokStream Identity ForeignSafety
-> ParsecT Void TokStream Identity ForeignSafety
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignSafety -> ParsecT Void TokStream Identity ForeignSafety
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignSafety
Safe)
    ParsecT Void TokStream Identity ForeignSafety
-> ParsecT Void TokStream Identity ForeignSafety
-> ParsecT Void TokStream Identity ForeignSafety
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
<|> (Text -> TokParser ()
varIdTok Text
"unsafe" TokParser ()
-> ParsecT Void TokStream Identity ForeignSafety
-> ParsecT Void TokStream Identity ForeignSafety
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignSafety -> ParsecT Void TokStream Identity ForeignSafety
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ForeignSafety
Unsafe)

foreignEntityParser :: TokParser ForeignEntitySpec
foreignEntityParser :: ParsecT Void TokStream Identity ForeignEntitySpec
foreignEntityParser = Text -> ForeignEntitySpec
foreignEntityFromString (Text -> ForeignEntitySpec)
-> TokParser Text
-> ParsecT Void TokStream Identity ForeignEntitySpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokParser Text
stringTextParser

foreignEntityFromString :: Text -> ForeignEntitySpec
foreignEntityFromString :: Text -> ForeignEntitySpec
foreignEntityFromString Text
txt
  | Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dynamic" = ForeignEntitySpec
ForeignEntityDynamic
  | Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"wrapper" = ForeignEntitySpec
ForeignEntityWrapper
  | Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"static" = Maybe Text -> ForeignEntitySpec
ForeignEntityStatic Maybe Text
forall a. Maybe a
Nothing
  | Just Text
rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
"static " Text
txt = Maybe Text -> ForeignEntitySpec
ForeignEntityStatic (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rest)
  | Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"&" = Maybe Text -> ForeignEntitySpec
ForeignEntityAddress Maybe Text
forall a. Maybe a
Nothing
  | Just Text
rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
"&" Text
txt = Maybe Text -> ForeignEntitySpec
ForeignEntityAddress (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rest)
  | Bool
otherwise = Text -> ForeignEntitySpec
ForeignEntityNamed Text
txt

dataDeclParser :: TokParser Decl
dataDeclParser :: TokParser Decl
dataDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordData
  context <- ParsecT Void TokStream Identity [Constraint]
-> ParsecT Void TokStream Identity (Maybe [Constraint])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (ParsecT Void TokStream Identity [Constraint]
-> ParsecT Void TokStream Identity [Constraint]
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void TokStream Identity [Constraint]
declContextParser ParsecT Void TokStream Identity [Constraint]
-> TokParser () -> ParsecT Void TokStream Identity [Constraint]
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
<* LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedDoubleArrow))
  (typeName, typeParams) <- typeDeclHeadParser
  -- Try GADT syntax (where) first, then traditional syntax (=)
  (constructors, derivingClauses) <- MP.try gadtStyleDataDecl <|> traditionalStyleDataDecl
  pure $ \SourceSpan
span' ->
    SourceSpan -> DataDecl -> Decl
DeclData
      SourceSpan
span'
      DataDecl
        { dataDeclSpan :: SourceSpan
dataDeclSpan = SourceSpan
span',
          dataDeclContext :: [Constraint]
dataDeclContext = [Constraint] -> Maybe [Constraint] -> [Constraint]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Constraint]
context,
          dataDeclName :: Text
dataDeclName = Text
typeName,
          dataDeclParams :: [TyVarBinder]
dataDeclParams = [TyVarBinder]
typeParams,
          dataDeclConstructors :: [DataConDecl]
dataDeclConstructors = [DataConDecl]
constructors,
          dataDeclDeriving :: [DerivingClause]
dataDeclDeriving = [DerivingClause]
derivingClauses
        }
  where
    traditionalStyleDataDecl :: ParsecT Void TokStream Identity ([DataConDecl], [DerivingClause])
traditionalStyleDataDecl = do
      constructors <- ParsecT Void TokStream Identity [DataConDecl]
-> ParsecT Void TokStream Identity (Maybe [DataConDecl])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedEquals TokParser ()
-> ParsecT Void TokStream Identity [DataConDecl]
-> ParsecT Void TokStream Identity [DataConDecl]
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 DataConDecl
dataConDeclParser TokParser DataConDecl
-> TokParser () -> ParsecT Void TokStream Identity [DataConDecl]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepBy1` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedPipe)
      derivingClauses <- MP.many derivingClauseParser
      pure (fromMaybe [] constructors, derivingClauses)

    gadtStyleDataDecl :: ParsecT Void TokStream Identity ([DataConDecl], [DerivingClause])
gadtStyleDataDecl = do
      constructors <- ParsecT Void TokStream Identity [DataConDecl]
gadtWhereClauseParser
      derivingClauses <- MP.many derivingClauseParser
      pure (constructors, derivingClauses)

dataConDeclParser :: TokParser DataConDecl
dataConDeclParser :: TokParser DataConDecl
dataConDeclParser = TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl)
-> TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl
forall a b. (a -> b) -> a -> b
$ do
  (forallVars, context) <- TokParser ([Text], [Constraint])
dataConQualifiersParser
  MP.try (dataConRecordOrPrefixParser forallVars context) <|> dataConInfixParser forallVars context

newtypeDeclParser :: TokParser Decl
newtypeDeclParser :: TokParser Decl
newtypeDeclParser = 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
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordNewtype
  context <- ParsecT Void TokStream Identity [Constraint]
-> ParsecT Void TokStream Identity (Maybe [Constraint])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (ParsecT Void TokStream Identity [Constraint]
-> ParsecT Void TokStream Identity [Constraint]
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void TokStream Identity [Constraint]
declContextParser ParsecT Void TokStream Identity [Constraint]
-> TokParser () -> ParsecT Void TokStream Identity [Constraint]
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
<* LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedDoubleArrow))
  (typeName, typeParams) <- typeDeclHeadParser
  -- Try GADT syntax (where) first, then traditional syntax (=)
  (constructor, derivingClauses) <- MP.try gadtStyleNewtypeDecl <|> traditionalStyleNewtypeDecl
  pure $ \SourceSpan
span' ->
    SourceSpan -> NewtypeDecl -> Decl
DeclNewtype
      SourceSpan
span'
      NewtypeDecl
        { newtypeDeclSpan :: SourceSpan
newtypeDeclSpan = SourceSpan
span',
          newtypeDeclContext :: [Constraint]
newtypeDeclContext = [Constraint] -> Maybe [Constraint] -> [Constraint]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Constraint]
context,
          newtypeDeclName :: Text
newtypeDeclName = Text
typeName,
          newtypeDeclParams :: [TyVarBinder]
newtypeDeclParams = [TyVarBinder]
typeParams,
          newtypeDeclConstructor :: Maybe DataConDecl
newtypeDeclConstructor = Maybe DataConDecl
constructor,
          newtypeDeclDeriving :: [DerivingClause]
newtypeDeclDeriving = [DerivingClause]
derivingClauses
        }
  where
    traditionalStyleNewtypeDecl :: ParsecT
  Void TokStream Identity (Maybe DataConDecl, [DerivingClause])
traditionalStyleNewtypeDecl = do
      constructor <- TokParser DataConDecl
-> ParsecT Void TokStream Identity (Maybe DataConDecl)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkReservedEquals TokParser () -> TokParser DataConDecl -> TokParser DataConDecl
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 DataConDecl
newtypeConDeclParser)
      derivingClauses <- MP.many derivingClauseParser
      pure (constructor, derivingClauses)

    gadtStyleNewtypeDecl :: ParsecT
  Void TokStream Identity (Maybe DataConDecl, [DerivingClause])
gadtStyleNewtypeDecl = do
      constructors <- ParsecT Void TokStream Identity [DataConDecl]
gadtWhereClauseParser
      -- newtype can only have one constructor
      case constructors of
        [DataConDecl
ctor] -> do
          derivingClauses <- ParsecT Void TokStream Identity DerivingClause
-> ParsecT Void TokStream Identity [DerivingClause]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many ParsecT Void TokStream Identity DerivingClause
derivingClauseParser
          pure (Just ctor, derivingClauses)
        [DataConDecl]
_ -> String
-> ParsecT
     Void TokStream Identity (Maybe DataConDecl, [DerivingClause])
forall a. String -> ParsecT Void TokStream Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"newtype must have exactly one constructor"

newtypeConDeclParser :: TokParser DataConDecl
newtypeConDeclParser :: TokParser DataConDecl
newtypeConDeclParser = TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl)
-> TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl
forall a b. (a -> b) -> a -> b
$ do
  (forallVars, context) <- TokParser ([Text], [Constraint])
dataConQualifiersParser
  MP.try (dataConRecordOrPrefixParser forallVars context) <|> dataConInfixParser forallVars context

-- | Parse GADT-style constructors after 'where'
gadtWhereClauseParser :: TokParser [DataConDecl]
gadtWhereClauseParser :: ParsecT Void TokStream Identity [DataConDecl]
gadtWhereClauseParser = ParsecT Void TokStream Identity [DataConDecl]
-> ParsecT Void TokStream Identity [DataConDecl]
-> ParsecT Void TokStream Identity [DataConDecl]
forall item.
TokParser [item] -> TokParser [item] -> TokParser [item]
whereClauseItemsParser ParsecT Void TokStream Identity [DataConDecl]
gadtConsBracedParser ParsecT Void TokStream Identity [DataConDecl]
gadtConsPlainParser

gadtConsPlainParser :: TokParser [DataConDecl]
gadtConsPlainParser :: ParsecT Void TokStream Identity [DataConDecl]
gadtConsPlainParser = TokParser DataConDecl
-> ParsecT Void TokStream Identity [DataConDecl]
forall a. TokParser a -> TokParser [a]
plainSemiSep1 TokParser DataConDecl
gadtConDeclParser

gadtConsBracedParser :: TokParser [DataConDecl]
gadtConsBracedParser :: ParsecT Void TokStream Identity [DataConDecl]
gadtConsBracedParser = TokParser DataConDecl
-> ParsecT Void TokStream Identity [DataConDecl]
forall a. TokParser a -> TokParser [a]
bracedSemiSep TokParser DataConDecl
gadtConDeclParser

-- | Parse a GADT constructor declaration: @Con1, Con2 :: forall a. Ctx => Type@
gadtConDeclParser :: TokParser DataConDecl
gadtConDeclParser :: TokParser DataConDecl
gadtConDeclParser = TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl)
-> TokParser (SourceSpan -> DataConDecl) -> TokParser DataConDecl
forall a b. (a -> b) -> a -> b
$ do
  -- Parse constructor names (can be multiple separated by commas)
  names <- TokParser Text
gadtConNameParser TokParser 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
  -- Parse optional forall
  forallBinders <- MP.option [] gadtForallParser
  -- Parse optional context
  context <- MP.option [] (MP.try (declContextParser <* expectedTok TkReservedDoubleArrow))
  -- Parse the body (record or prefix style)
  body <- gadtBodyParser
  pure $ \SourceSpan
span' -> SourceSpan
-> [TyVarBinder]
-> [Constraint]
-> [Text]
-> GadtBody
-> DataConDecl
GadtCon SourceSpan
span' [TyVarBinder]
forallBinders [Constraint]
context [Text]
names GadtBody
body

-- | Parse constructor name for GADT - can be regular or operator in parens
gadtConNameParser :: TokParser Text
gadtConNameParser :: TokParser Text
gadtConNameParser =
  TokParser Text
constructorIdentifierParser
    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. TokParser a -> TokParser a
parens TokParser Text
constructorOperatorParser

-- | Parse forall in GADT context: @forall a b.@
gadtForallParser :: TokParser [TyVarBinder]
gadtForallParser :: ParsecT Void TokStream Identity [TyVarBinder]
gadtForallParser = do
  Text -> TokParser ()
varIdTok Text
"forall"
  binders <- ParsecT Void TokStream Identity TyVarBinder
-> ParsecT Void TokStream Identity [TyVarBinder]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some ParsecT Void TokStream Identity TyVarBinder
typeParamParser
  expectedTok (TkVarSym ".")
  pure binders

-- | Parse the body of a GADT constructor (after :: and optional forall/context)
-- Can be either prefix style: @a -> b -> T a@
-- Or record style: @{ field :: Type } -> T a@
gadtBodyParser :: TokParser GadtBody
gadtBodyParser :: TokParser GadtBody
gadtBodyParser = TokParser GadtBody -> TokParser GadtBody
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser GadtBody
gadtRecordBodyParser TokParser GadtBody -> TokParser GadtBody -> TokParser GadtBody
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 GadtBody
gadtPrefixBodyParser

-- | Parse record-style GADT body: @{ field :: Type, ... } -> ResultType@
gadtRecordBodyParser :: TokParser GadtBody
gadtRecordBodyParser :: TokParser GadtBody
gadtRecordBodyParser = do
  fields <- TokParser [FieldDecl]
recordFieldsParser
  expectedTok TkReservedRightArrow
  GadtRecordBody fields <$> gadtResultTypeParser

-- | Parse prefix-style GADT body: @!Type1 -> Type2 -> ... -> ResultType@
-- Each argument can have an optional strictness annotation (!).
-- The result type is the final type in a chain of arrows.
gadtPrefixBodyParser :: TokParser GadtBody
gadtPrefixBodyParser :: TokParser GadtBody
gadtPrefixBodyParser = do
  -- Parse the first component (could be an argument with bang or the result type)
  firstBang <- TokParser BangType
gadtBangTypeParser
  -- Try to parse more arguments after ->
  moreArgs <- MP.many $ do
    expectedTok TkReservedRightArrow
    gadtBangTypeParser
  -- The last component is the result type, everything before it are arguments
  case moreArgs of
    [] ->
      -- No arrows - this is just a result type
      GadtBody -> TokParser GadtBody
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([BangType] -> Type -> GadtBody
GadtPrefixBody [] (BangType -> Type
bangType BangType
firstBang))
    [BangType]
_ ->
      -- Multiple components - last is result, rest are args
      let allBangs :: [BangType]
allBangs = BangType
firstBang BangType -> [BangType] -> [BangType]
forall a. a -> [a] -> [a]
: [BangType]
moreArgs
          args :: [BangType]
args = [BangType] -> [BangType]
forall a. HasCallStack => [a] -> [a]
init [BangType]
allBangs
          result :: BangType
result = [BangType] -> BangType
forall a. HasCallStack => [a] -> a
last [BangType]
allBangs
       in GadtBody -> TokParser GadtBody
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([BangType] -> Type -> GadtBody
GadtPrefixBody [BangType]
args (BangType -> Type
bangType BangType
result))

-- | Parse a potentially strict type for GADT prefix body: @!Type@ or @Type@
-- This handles strictness annotations on both simple and complex (parenthesized) types.
gadtBangTypeParser :: TokParser BangType
gadtBangTypeParser :: TokParser BangType
gadtBangTypeParser = TokParser (SourceSpan -> BangType) -> TokParser BangType
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> BangType) -> TokParser BangType)
-> TokParser (SourceSpan -> BangType) -> TokParser BangType
forall a b. (a -> b) -> a -> b
$ do
  strict <- Bool
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
MP.option Bool
False (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkPrefixBang TokParser ()
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Void TokStream Identity Bool
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
  ty <- typeAppParser
  pure $ \SourceSpan
span' ->
    BangType
      { bangSpan :: SourceSpan
bangSpan = SourceSpan
span',
        bangStrict :: Bool
bangStrict = Bool
strict,
        bangType :: Type
bangType = Type
ty
      }

-- | Parse the result type of a GADT constructor
-- This is a simple type application like @T a b@
gadtResultTypeParser :: TokParser Type
gadtResultTypeParser :: TokParser Type
gadtResultTypeParser = TokParser Type
typeParser

declContextParser :: TokParser [Constraint]
declContextParser :: ParsecT Void TokStream Identity [Constraint]
declContextParser = TokParser Type -> ParsecT Void TokStream Identity [Constraint]
contextParserWith TokParser Type
typeAtomParser

typeDeclHeadParser :: TokParser (Text, [TyVarBinder])
typeDeclHeadParser :: TokParser (Text, [TyVarBinder])
typeDeclHeadParser =
  TokParser (Text, [TyVarBinder]) -> TokParser (Text, [TyVarBinder])
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (Text, [TyVarBinder])
infixHeadParser TokParser (Text, [TyVarBinder])
-> TokParser (Text, [TyVarBinder])
-> TokParser (Text, [TyVarBinder])
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, [TyVarBinder])
prefixHeadParser
  where
    prefixHeadParser :: TokParser (Text, [TyVarBinder])
prefixHeadParser = do
      name <- TokParser Text
constructorIdentifierParser
      params <- MP.many typeParamParser
      pure (name, params)

    infixHeadParser :: TokParser (Text, [TyVarBinder])
infixHeadParser = do
      lhs <- ParsecT Void TokStream Identity TyVarBinder
typeParamParser
      op <- constructorOperatorParser
      rhs <- typeParamParser
      pure (op, [lhs, rhs])

typeParamParser :: TokParser TyVarBinder
typeParamParser :: ParsecT Void TokStream Identity TyVarBinder
typeParamParser =
  TokParser (SourceSpan -> TyVarBinder)
-> ParsecT Void TokStream Identity TyVarBinder
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> TyVarBinder)
 -> ParsecT Void TokStream Identity TyVarBinder)
-> TokParser (SourceSpan -> TyVarBinder)
-> ParsecT Void TokStream Identity TyVarBinder
forall a b. (a -> b) -> a -> b
$
    ( do
        ident <-
          String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"type parameter binder" ((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
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"deriving",
                  Text -> Bool
isTypeVarName Text
name ->
                    Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
              LexTokenKind
_ -> Maybe Text
forall a. Maybe a
Nothing
        pure (\SourceSpan
span' -> SourceSpan -> Text -> Maybe Type -> TyVarBinder
TyVarBinder SourceSpan
span' Text
ident Maybe Type
forall a. Maybe a
Nothing)
    )
      TokParser (SourceSpan -> TyVarBinder)
-> TokParser (SourceSpan -> TyVarBinder)
-> TokParser (SourceSpan -> TyVarBinder)
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
<|> ( do
              LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLParen
              ident <- TokParser Text
lowerIdentifierParser
              expectedTok TkReservedDoubleColon
              kind <- typeParser
              expectedTok TkSpecialRParen
              pure (\SourceSpan
span' -> SourceSpan -> Text -> Maybe Type -> TyVarBinder
TyVarBinder SourceSpan
span' Text
ident (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
kind))
          )

isTypeVarName :: Text -> Bool
isTypeVarName :: Text -> Bool
isTypeVarName Text
name =
  case Text -> Maybe (Char, Text)
T.uncons Text
name of
    Just (Char
c, Text
_) -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
isAsciiLower Char
c
    Maybe (Char, Text)
Nothing -> Bool
False

derivingClauseParser :: TokParser DerivingClause
derivingClauseParser :: ParsecT Void TokStream Identity DerivingClause
derivingClauseParser = do
  LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordDeriving
  strategy <- ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity (Maybe DerivingStrategy)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional ParsecT Void TokStream Identity DerivingStrategy
derivingStrategyParser
  classes <- parenClasses <|> singleClass
  pure (DerivingClause strategy classes)
  where
    singleClass :: ParsecT Void TokStream Identity [Text]
singleClass = (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: []) (Text -> [Text])
-> TokParser Text -> ParsecT Void TokStream Identity [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokParser Text
identifierTextParser
    parenClasses :: ParsecT Void TokStream Identity [Text]
parenClasses = ParsecT Void TokStream Identity [Text]
-> ParsecT Void TokStream Identity [Text]
forall a. TokParser a -> TokParser a
parens (ParsecT Void TokStream Identity [Text]
 -> ParsecT Void TokStream Identity [Text])
-> ParsecT Void TokStream Identity [Text]
-> ParsecT Void TokStream Identity [Text]
forall a b. (a -> b) -> a -> b
$ TokParser Text
identifierTextParser TokParser Text
-> TokParser () -> ParsecT Void TokStream Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma

derivingStrategyParser :: TokParser DerivingStrategy
derivingStrategyParser :: ParsecT Void TokStream Identity DerivingStrategy
derivingStrategyParser =
  (Text -> TokParser ()
varIdTok Text
"stock" TokParser ()
-> ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivingStrategy
DerivingStock)
    ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
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
<|> (LexTokenKind -> TokParser ()
keywordTok LexTokenKind
TkKeywordNewtype TokParser ()
-> ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivingStrategy
DerivingNewtype)
    ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
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
<|> (Text -> TokParser ()
varIdTok Text
"anyclass" TokParser ()
-> ParsecT Void TokStream Identity DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DerivingStrategy
-> ParsecT Void TokStream Identity DerivingStrategy
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DerivingStrategy
DerivingAnyclass)

dataConQualifiersParser :: TokParser ([Text], [Constraint])
dataConQualifiersParser :: TokParser ([Text], [Constraint])
dataConQualifiersParser = do
  mForall <- ParsecT Void TokStream Identity [Text]
-> ParsecT Void TokStream Identity (Maybe [Text])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
MP.optional (ParsecT Void TokStream Identity [Text]
-> ParsecT Void TokStream Identity [Text]
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try ParsecT Void TokStream Identity [Text]
forallBindersParser)
  mContext <- MP.optional (MP.try (declContextParser <* expectedTok TkReservedDoubleArrow))
  pure (fromMaybe [] mForall, fromMaybe [] mContext)

forallBindersParser :: TokParser [Text]
forallBindersParser :: ParsecT Void TokStream Identity [Text]
forallBindersParser = do
  Text -> TokParser ()
varIdTok Text
"forall"
  binders <- ParsecT Void TokStream Identity TyVarBinder
-> ParsecT Void TokStream Identity [TyVarBinder]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some ParsecT Void TokStream Identity TyVarBinder
typeParamParser
  expectedTok (TkVarSym ".")
  pure (map tyVarBinderName binders)

dataConRecordOrPrefixParser :: [Text] -> [Constraint] -> TokParser (SourceSpan -> DataConDecl)
dataConRecordOrPrefixParser :: [Text] -> [Constraint] -> TokParser (SourceSpan -> DataConDecl)
dataConRecordOrPrefixParser [Text]
forallVars [Constraint]
context = do
  name <- TokParser Text
constructorNameParser
  mRecordFields <- MP.optional (MP.try recordFieldsParserAfterLayoutSemicolon)
  case mRecordFields of
    Just [FieldDecl]
fields -> (SourceSpan -> DataConDecl)
-> TokParser (SourceSpan -> DataConDecl)
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\SourceSpan
span' -> SourceSpan
-> [Text] -> [Constraint] -> Text -> [FieldDecl] -> DataConDecl
RecordCon SourceSpan
span' [Text]
forallVars [Constraint]
context Text
name [FieldDecl]
fields)
    Maybe [FieldDecl]
Nothing -> do
      args <- TokParser BangType -> ParsecT Void TokStream Identity [BangType]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many TokParser BangType
constructorArgParser
      -- Ensure we're not leaving a constructor operator unconsumed.
      -- If there's a constructor operator next, this is actually an infix form
      -- and we should backtrack to let dataConInfixParser handle it.
      MP.notFollowedBy constructorOperatorParser
      pure (\SourceSpan
span' -> SourceSpan
-> [Text] -> [Constraint] -> Text -> [BangType] -> DataConDecl
PrefixCon SourceSpan
span' [Text]
forallVars [Constraint]
context Text
name [BangType]
args)
  where
    -- Layout may inject a virtual ';' before a newline-started record field block.
    -- Accept it as part of the constructor declaration.
    recordFieldsParserAfterLayoutSemicolon :: TokParser [FieldDecl]
recordFieldsParserAfterLayoutSemicolon =
      TokParser [FieldDecl]
recordFieldsParser
        TokParser [FieldDecl]
-> TokParser [FieldDecl] -> TokParser [FieldDecl]
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
<|> (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialSemicolon TokParser () -> TokParser [FieldDecl] -> TokParser [FieldDecl]
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 [FieldDecl]
recordFieldsParser)

dataConInfixParser :: [Text] -> [Constraint] -> TokParser (SourceSpan -> DataConDecl)
dataConInfixParser :: [Text] -> [Constraint] -> TokParser (SourceSpan -> DataConDecl)
dataConInfixParser [Text]
forallVars [Constraint]
context = do
  lhs <- TokParser BangType
infixConstructorArgParser
  op <- constructorOperatorParser
  rhs <- infixConstructorArgParser
  pure (\SourceSpan
span' -> SourceSpan
-> [Text]
-> [Constraint]
-> BangType
-> Text
-> BangType
-> DataConDecl
InfixCon SourceSpan
span' [Text]
forallVars [Constraint]
context BangType
lhs Text
op BangType
rhs)

recordFieldsParser :: TokParser [FieldDecl]
recordFieldsParser :: TokParser [FieldDecl]
recordFieldsParser = do
  LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialLBrace
  fields <- TokParser FieldDecl
recordFieldDeclParser TokParser FieldDecl -> TokParser () -> TokParser [FieldDecl]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`MP.sepEndBy` LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialComma
  expectedTok TkSpecialRBrace
  pure fields

recordFieldDeclParser :: TokParser FieldDecl
recordFieldDeclParser :: TokParser FieldDecl
recordFieldDeclParser = TokParser (SourceSpan -> FieldDecl) -> TokParser FieldDecl
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> FieldDecl) -> TokParser FieldDecl)
-> TokParser (SourceSpan -> FieldDecl) -> TokParser FieldDecl
forall a b. (a -> b) -> a -> b
$ do
  names <- TokParser Text
identifierTextParser TokParser 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
  fieldTy <- recordFieldBangTypeParser
  pure $ \SourceSpan
span' ->
    FieldDecl
      { fieldSpan :: SourceSpan
fieldSpan = SourceSpan
span',
        fieldNames :: [Text]
fieldNames = [Text]
names,
        fieldType :: BangType
fieldType = BangType
fieldTy
      }

constructorArgParser :: TokParser BangType
constructorArgParser :: TokParser BangType
constructorArgParser = TokParser BangType -> TokParser BangType
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (TokParser BangType -> TokParser BangType)
-> TokParser BangType -> TokParser BangType
forall a b. (a -> b) -> a -> b
$ do
  TokParser () -> TokParser ()
forall a. ParsecT Void TokStream Identity a -> TokParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
MP.notFollowedBy TokParser ()
derivingKeywordParser
  TokParser BangType
bangTypeParser

infixConstructorArgParser :: TokParser BangType
infixConstructorArgParser :: TokParser BangType
infixConstructorArgParser = TokParser BangType -> TokParser BangType
forall a. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (TokParser BangType -> TokParser BangType)
-> TokParser BangType -> TokParser BangType
forall a b. (a -> b) -> a -> b
$ do
  TokParser () -> TokParser ()
forall a. ParsecT Void TokStream Identity a -> TokParser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
MP.notFollowedBy TokParser ()
derivingKeywordParser
  TokParser (SourceSpan -> BangType) -> TokParser BangType
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> BangType) -> TokParser BangType)
-> TokParser (SourceSpan -> BangType) -> TokParser BangType
forall a b. (a -> b) -> a -> b
$ do
    strict <- Bool
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
MP.option Bool
False (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkPrefixBang TokParser ()
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Void TokStream Identity Bool
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
    ty <- typeAppParser
    pure $ \SourceSpan
span' ->
      BangType
        { bangSpan :: SourceSpan
bangSpan = SourceSpan
span',
          bangStrict :: Bool
bangStrict = Bool
strict,
          bangType :: Type
bangType = Type
ty
        }

derivingKeywordParser :: TokParser ()
derivingKeywordParser :: TokParser ()
derivingKeywordParser =
  String -> (LexToken -> Maybe ()) -> TokParser ()
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"identifier \"deriving\"" ((LexToken -> Maybe ()) -> TokParser ())
-> (LexToken -> Maybe ()) -> TokParser ()
forall a b. (a -> b) -> a -> b
$ \LexToken
tok ->
    case LexToken -> LexTokenKind
lexTokenKind LexToken
tok of
      LexTokenKind
TkKeywordDeriving -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      LexTokenKind
_ -> Maybe ()
forall a. Maybe a
Nothing

bangTypeParser :: TokParser BangType
bangTypeParser :: TokParser BangType
bangTypeParser = TokParser (SourceSpan -> BangType) -> TokParser BangType
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> BangType) -> TokParser BangType)
-> TokParser (SourceSpan -> BangType) -> TokParser BangType
forall a b. (a -> b) -> a -> b
$ do
  strict <- Bool
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
MP.option Bool
False (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkPrefixBang TokParser ()
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Void TokStream Identity Bool
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
  ty <- typeAtomParser
  pure $ \SourceSpan
span' ->
    BangType
      { bangSpan :: SourceSpan
bangSpan = SourceSpan
span',
        bangStrict :: Bool
bangStrict = Bool
strict,
        bangType :: Type
bangType = Type
ty
      }

recordFieldBangTypeParser :: TokParser BangType
recordFieldBangTypeParser :: TokParser BangType
recordFieldBangTypeParser = TokParser (SourceSpan -> BangType) -> TokParser BangType
forall a. TokParser (SourceSpan -> a) -> TokParser a
withSpan (TokParser (SourceSpan -> BangType) -> TokParser BangType)
-> TokParser (SourceSpan -> BangType) -> TokParser BangType
forall a b. (a -> b) -> a -> b
$ do
  strict <- Bool
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
MP.option Bool
False (LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkPrefixBang TokParser ()
-> ParsecT Void TokStream Identity Bool
-> ParsecT Void TokStream Identity Bool
forall a b.
ParsecT Void TokStream Identity a
-> ParsecT Void TokStream Identity b
-> ParsecT Void TokStream Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Void TokStream Identity Bool
forall a. a -> ParsecT Void TokStream Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
  ty <- constructorFieldTypeParser
  pure $ \SourceSpan
span' ->
    BangType
      { bangSpan :: SourceSpan
bangSpan = SourceSpan
span',
        bangStrict :: Bool
bangStrict = Bool
strict,
        bangType :: Type
bangType = Type
ty
      }

-- | Parse a type in a constructor field position.
-- This supports function types (Int -> Int) and type applications (Maybe Int).
constructorFieldTypeParser :: TokParser Type
constructorFieldTypeParser :: TokParser Type
constructorFieldTypeParser = TokParser Type
typeParser

constructorNameParser :: TokParser Text
constructorNameParser :: TokParser Text
constructorNameParser = TokParser Text
constructorIdentifierParser

constructorOperatorParser :: TokParser Text
constructorOperatorParser :: TokParser Text
constructorOperatorParser =
  TokParser Text
symbolicConstructorOperatorParser 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
backtickConstructorIdentifierParser
  where
    symbolicConstructorOperatorParser :: TokParser Text
symbolicConstructorOperatorParser =
      String -> (LexToken -> Maybe Text) -> TokParser Text
forall a. String -> (LexToken -> Maybe a) -> TokParser a
tokenSatisfy String
"constructor 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
          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
_ -> Maybe Text
forall a. Maybe a
Nothing
    backtickConstructorIdentifierParser :: TokParser Text
backtickConstructorIdentifierParser = do
      LexTokenKind -> TokParser ()
expectedTok LexTokenKind
TkSpecialBacktick
      op <- TokParser Text
constructorIdentifierParser
      expectedTok TkSpecialBacktick
      pure op

unsupportedDeclParser :: String -> TokParser Decl
unsupportedDeclParser :: String -> TokParser Decl
unsupportedDeclParser = String -> TokParser Decl
forall a. String -> ParsecT Void TokStream Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

-- | Parse a pattern binding declaration like @(x, y) = (1, 2)@.
-- This handles bindings where the LHS is a pattern rather than a function name.
patternBindDeclParser :: TokParser Decl
patternBindDeclParser :: TokParser Decl
patternBindDeclParser = 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 <- ParsecT Void TokStream Identity Pattern
patternParser
  rhs <- equationRhsParser
  pure (\SourceSpan
span' -> SourceSpan -> ValueDecl -> Decl
DeclValue SourceSpan
span' (SourceSpan -> Pattern -> Rhs -> ValueDecl
PatternBind SourceSpan
span' Pattern
pat Rhs
rhs))

valueDeclParser :: TokParser Decl
valueDeclParser :: TokParser Decl
valueDeclParser = 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. TokParser a -> TokParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try TokParser (SourceSpan -> Decl)
infixValueDeclParser 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)
prefixValueDeclParser
  where
    -- Prefix form: f x y = ...
    prefixValueDeclParser :: TokParser (SourceSpan -> Decl)
prefixValueDeclParser = do
      name <- TokParser 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)

    -- Infix form: x `op` y = ... or x <op> y = ...
    infixValueDeclParser :: TokParser (SourceSpan -> Decl)
infixValueDeclParser = do
      lhsPat <- ParsecT Void TokStream Identity 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)