{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Data types for modules and declarations
--
module Language.PureScript.AST.Declarations where

import Prelude
import Protolude.Exceptions (hush)

import Codec.Serialise (Serialise)
import Control.DeepSeq (NFData)
import Data.Functor.Identity (Identity(..))

import Data.Aeson.TH (Options(..), SumEncoding(..), defaultOptions, deriveJSON)
import Data.Map qualified as M
import Data.Text (Text)
import Data.List.NonEmpty qualified as NEL
import GHC.Generics (Generic)

import Language.PureScript.AST.Binders (Binder)
import Language.PureScript.AST.Literals (Literal(..))
import Language.PureScript.AST.Operators (Fixity)
import Language.PureScript.AST.SourcePos (SourceAnn, SourceSpan)
import Language.PureScript.AST.Declarations.ChainId (ChainId)
import Language.PureScript.Types (SourceConstraint, SourceType)
import Language.PureScript.PSString (PSString)
import Language.PureScript.Label (Label)
import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName(..), Name(..), OpName, OpNameType(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), toMaybeModuleName)
import Language.PureScript.Roles (Role)
import Language.PureScript.TypeClassDictionaries (NamedDict)
import Language.PureScript.Comments (Comment)
import Language.PureScript.Environment (DataDeclType, Environment, FunctionalDependency, NameKind)
import Language.PureScript.Constants.Prim qualified as C

-- | A map of locally-bound names in scope.
type Context = [(Ident, SourceType)]

-- | Holds the data necessary to do type directed search for typed holes
data TypeSearch
  = TSBefore Environment
  -- ^ An Environment captured for later consumption by type directed search
  | TSAfter
  -- ^ Results of applying type directed search to the previously captured
  -- Environment
    { TypeSearch -> [(Qualified Text, SourceType)]
tsAfterIdentifiers :: [(Qualified Text, SourceType)]
    -- ^ The identifiers that fully satisfy the subsumption check
    , TypeSearch -> Maybe [(Label, SourceType)]
tsAfterRecordFields :: Maybe [(Label, SourceType)]
    -- ^ Record fields that are available on the first argument to the typed
    -- hole
    }
  deriving Int -> TypeSearch -> ShowS
[TypeSearch] -> ShowS
TypeSearch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSearch] -> ShowS
$cshowList :: [TypeSearch] -> ShowS
show :: TypeSearch -> String
$cshow :: TypeSearch -> String
showsPrec :: Int -> TypeSearch -> ShowS
$cshowsPrec :: Int -> TypeSearch -> ShowS
Show

onTypeSearchTypes :: (SourceType -> SourceType) -> TypeSearch -> TypeSearch
onTypeSearchTypes :: (SourceType -> SourceType) -> TypeSearch -> TypeSearch
onTypeSearchTypes SourceType -> SourceType
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
Applicative m =>
(SourceType -> m SourceType) -> TypeSearch -> m TypeSearch
onTypeSearchTypesM (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceType -> SourceType
f)

onTypeSearchTypesM :: (Applicative m) => (SourceType -> m SourceType) -> TypeSearch -> m TypeSearch
onTypeSearchTypesM :: forall (m :: * -> *).
Applicative m =>
(SourceType -> m SourceType) -> TypeSearch -> m TypeSearch
onTypeSearchTypesM SourceType -> m SourceType
f (TSAfter [(Qualified Text, SourceType)]
i Maybe [(Label, SourceType)]
r) = [(Qualified Text, SourceType)]
-> Maybe [(Label, SourceType)] -> TypeSearch
TSAfter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SourceType -> m SourceType
f) [(Qualified Text, SourceType)]
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SourceType -> m SourceType
f)) Maybe [(Label, SourceType)]
r
onTypeSearchTypesM SourceType -> m SourceType
_ (TSBefore Environment
env) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Environment -> TypeSearch
TSBefore Environment
env)

-- | Error message hints, providing more detailed information about failure.
data ErrorMessageHint
  = ErrorUnifyingTypes SourceType SourceType
  | ErrorInExpression Expr
  | ErrorInModule ModuleName
  | ErrorInInstance (Qualified (ProperName 'ClassName)) [SourceType]
  | ErrorInSubsumption SourceType SourceType
  | ErrorInRowLabel Label
  | ErrorCheckingAccessor Expr PSString
  | ErrorCheckingType Expr SourceType
  | ErrorCheckingKind SourceType SourceType
  | ErrorCheckingGuard
  | ErrorInferringType Expr
  | ErrorInferringKind SourceType
  | ErrorInApplication Expr SourceType Expr
  | ErrorInDataConstructor (ProperName 'ConstructorName)
  | ErrorInTypeConstructor (ProperName 'TypeName)
  | ErrorInBindingGroup (NEL.NonEmpty Ident)
  | ErrorInDataBindingGroup [ProperName 'TypeName]
  | ErrorInTypeSynonym (ProperName 'TypeName)
  | ErrorInValueDeclaration Ident
  | ErrorInTypeDeclaration Ident
  | ErrorInTypeClassDeclaration (ProperName 'ClassName)
  | ErrorInKindDeclaration (ProperName 'TypeName)
  | ErrorInRoleDeclaration (ProperName 'TypeName)
  | ErrorInForeignImport Ident
  | ErrorInForeignImportData (ProperName 'TypeName)
  | ErrorSolvingConstraint SourceConstraint
  | MissingConstructorImportForCoercible (Qualified (ProperName 'ConstructorName))
  | PositionedError (NEL.NonEmpty SourceSpan)
  | RelatedPositions (NEL.NonEmpty SourceSpan)
  deriving (Int -> ErrorMessageHint -> ShowS
[ErrorMessageHint] -> ShowS
ErrorMessageHint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorMessageHint] -> ShowS
$cshowList :: [ErrorMessageHint] -> ShowS
show :: ErrorMessageHint -> String
$cshow :: ErrorMessageHint -> String
showsPrec :: Int -> ErrorMessageHint -> ShowS
$cshowsPrec :: Int -> ErrorMessageHint -> ShowS
Show)

-- | Categories of hints
data HintCategory
  = ExprHint
  | KindHint
  | CheckHint
  | PositionHint
  | SolverHint
  | DeclarationHint
  | OtherHint
  deriving (Int -> HintCategory -> ShowS
[HintCategory] -> ShowS
HintCategory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HintCategory] -> ShowS
$cshowList :: [HintCategory] -> ShowS
show :: HintCategory -> String
$cshow :: HintCategory -> String
showsPrec :: Int -> HintCategory -> ShowS
$cshowsPrec :: Int -> HintCategory -> ShowS
Show, HintCategory -> HintCategory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HintCategory -> HintCategory -> Bool
$c/= :: HintCategory -> HintCategory -> Bool
== :: HintCategory -> HintCategory -> Bool
$c== :: HintCategory -> HintCategory -> Bool
Eq)

-- |
-- A module declaration, consisting of comments about the module, a module name,
-- a list of declarations, and a list of the declarations that are
-- explicitly exported. If the export list is Nothing, everything is exported.
--
data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])
  deriving (Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> String
$cshow :: Module -> String
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show)

-- | Return a module's name.
getModuleName :: Module -> ModuleName
getModuleName :: Module -> ModuleName
getModuleName (Module SourceSpan
_ [Comment]
_ ModuleName
name [Declaration]
_ Maybe [DeclarationRef]
_) = ModuleName
name

-- | Return a module's source span.
getModuleSourceSpan :: Module -> SourceSpan
getModuleSourceSpan :: Module -> SourceSpan
getModuleSourceSpan (Module SourceSpan
ss [Comment]
_ ModuleName
_ [Declaration]
_ Maybe [DeclarationRef]
_) = SourceSpan
ss

-- | Return a module's declarations.
getModuleDeclarations :: Module -> [Declaration]
getModuleDeclarations :: Module -> [Declaration]
getModuleDeclarations (Module SourceSpan
_ [Comment]
_ ModuleName
_ [Declaration]
declarations Maybe [DeclarationRef]
_) = [Declaration]
declarations

-- |
-- Add an import declaration for a module if it does not already explicitly import it.
--
-- Will not import an unqualified module if that module has already been imported qualified.
-- (See #2197)
--
addDefaultImport :: Qualified ModuleName -> Module -> Module
addDefaultImport :: Qualified ModuleName -> Module -> Module
addDefaultImport (Qualified QualifiedBy
toImportAs ModuleName
toImport) m :: Module
m@(Module SourceSpan
ss [Comment]
coms ModuleName
mn [Declaration]
decls Maybe [DeclarationRef]
exps) =
  if Declaration -> Bool
isExistingImport forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` [Declaration]
decls Bool -> Bool -> Bool
|| ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
toImport then Module
m
  else SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
Module SourceSpan
ss [Comment]
coms ModuleName
mn ((SourceSpan, [Comment])
-> ModuleName
-> ImportDeclarationType
-> Maybe ModuleName
-> Declaration
ImportDeclaration (SourceSpan
ss, []) ModuleName
toImport ImportDeclarationType
Implicit Maybe ModuleName
toImportAs' forall a. a -> [a] -> [a]
: [Declaration]
decls) Maybe [DeclarationRef]
exps
  where
  toImportAs' :: Maybe ModuleName
toImportAs' = QualifiedBy -> Maybe ModuleName
toMaybeModuleName QualifiedBy
toImportAs

  isExistingImport :: Declaration -> Bool
isExistingImport (ImportDeclaration (SourceSpan, [Comment])
_ ModuleName
mn' ImportDeclarationType
_ Maybe ModuleName
as')
    | ModuleName
mn' forall a. Eq a => a -> a -> Bool
== ModuleName
toImport =
        case Maybe ModuleName
toImportAs' of
          Maybe ModuleName
Nothing -> Bool
True
          Maybe ModuleName
_ -> Maybe ModuleName
as' forall a. Eq a => a -> a -> Bool
== Maybe ModuleName
toImportAs'
  isExistingImport Declaration
_ = Bool
False

-- | Adds import declarations to a module for an implicit Prim import and Prim
-- | qualified as Prim, as necessary.
importPrim :: Module -> Module
importPrim :: Module -> Module
importPrim =
  let
    primModName :: ModuleName
primModName = ModuleName
C.M_Prim
  in
    Qualified ModuleName -> Module -> Module
addDefaultImport (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
primModName) ModuleName
primModName)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified ModuleName -> Module -> Module
addDefaultImport (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos ModuleName
primModName)

data NameSource = UserNamed | CompilerNamed
  deriving (Int -> NameSource -> ShowS
[NameSource] -> ShowS
NameSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameSource] -> ShowS
$cshowList :: [NameSource] -> ShowS
show :: NameSource -> String
$cshow :: NameSource -> String
showsPrec :: Int -> NameSource -> ShowS
$cshowsPrec :: Int -> NameSource -> ShowS
Show, forall x. Rep NameSource x -> NameSource
forall x. NameSource -> Rep NameSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameSource x -> NameSource
$cfrom :: forall x. NameSource -> Rep NameSource x
Generic, NameSource -> ()
forall a. (a -> ()) -> NFData a
rnf :: NameSource -> ()
$crnf :: NameSource -> ()
NFData, [NameSource] -> Encoding
NameSource -> Encoding
forall s. Decoder s [NameSource]
forall s. Decoder s NameSource
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: forall s. Decoder s [NameSource]
$cdecodeList :: forall s. Decoder s [NameSource]
encodeList :: [NameSource] -> Encoding
$cencodeList :: [NameSource] -> Encoding
decode :: forall s. Decoder s NameSource
$cdecode :: forall s. Decoder s NameSource
encode :: NameSource -> Encoding
$cencode :: NameSource -> Encoding
Serialise)

-- |
-- An item in a list of explicit imports or exports
--
data DeclarationRef
  -- |
  -- A type class
  --
  = TypeClassRef SourceSpan (ProperName 'ClassName)
  -- |
  -- A type operator
  --
  | TypeOpRef SourceSpan (OpName 'TypeOpName)
  -- |
  -- A type constructor with data constructors
  --
  | TypeRef SourceSpan (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])
  -- |
  -- A value
  --
  | ValueRef SourceSpan Ident
  -- |
  -- A value-level operator
  --
  | ValueOpRef SourceSpan (OpName 'ValueOpName)
  -- |
  -- A type class instance, created during typeclass desugaring
  --
  | TypeInstanceRef SourceSpan Ident NameSource
  -- |
  -- A module, in its entirety
  --
  | ModuleRef SourceSpan ModuleName
  -- |
  -- A value re-exported from another module. These will be inserted during
  -- elaboration in name desugaring.
  --
  | ReExportRef SourceSpan ExportSource DeclarationRef
  deriving (Int -> DeclarationRef -> ShowS
[DeclarationRef] -> ShowS
DeclarationRef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeclarationRef] -> ShowS
$cshowList :: [DeclarationRef] -> ShowS
show :: DeclarationRef -> String
$cshow :: DeclarationRef -> String
showsPrec :: Int -> DeclarationRef -> ShowS
$cshowsPrec :: Int -> DeclarationRef -> ShowS
Show, forall x. Rep DeclarationRef x -> DeclarationRef
forall x. DeclarationRef -> Rep DeclarationRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeclarationRef x -> DeclarationRef
$cfrom :: forall x. DeclarationRef -> Rep DeclarationRef x
Generic, DeclarationRef -> ()
forall a. (a -> ()) -> NFData a
rnf :: DeclarationRef -> ()
$crnf :: DeclarationRef -> ()
NFData, [DeclarationRef] -> Encoding
DeclarationRef -> Encoding
forall s. Decoder s [DeclarationRef]
forall s. Decoder s DeclarationRef
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: forall s. Decoder s [DeclarationRef]
$cdecodeList :: forall s. Decoder s [DeclarationRef]
encodeList :: [DeclarationRef] -> Encoding
$cencodeList :: [DeclarationRef] -> Encoding
decode :: forall s. Decoder s DeclarationRef
$cdecode :: forall s. Decoder s DeclarationRef
encode :: DeclarationRef -> Encoding
$cencode :: DeclarationRef -> Encoding
Serialise)

instance Eq DeclarationRef where
  (TypeClassRef SourceSpan
_ ProperName 'ClassName
name) == :: DeclarationRef -> DeclarationRef -> Bool
== (TypeClassRef SourceSpan
_ ProperName 'ClassName
name') = ProperName 'ClassName
name forall a. Eq a => a -> a -> Bool
== ProperName 'ClassName
name'
  (TypeOpRef SourceSpan
_ OpName 'TypeOpName
name) == (TypeOpRef SourceSpan
_ OpName 'TypeOpName
name') = OpName 'TypeOpName
name forall a. Eq a => a -> a -> Bool
== OpName 'TypeOpName
name'
  (TypeRef SourceSpan
_ ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
dctors) == (TypeRef SourceSpan
_ ProperName 'TypeName
name' Maybe [ProperName 'ConstructorName]
dctors') = ProperName 'TypeName
name forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
name' Bool -> Bool -> Bool
&& Maybe [ProperName 'ConstructorName]
dctors forall a. Eq a => a -> a -> Bool
== Maybe [ProperName 'ConstructorName]
dctors'
  (ValueRef SourceSpan
_ Ident
name) == (ValueRef SourceSpan
_ Ident
name') = Ident
name forall a. Eq a => a -> a -> Bool
== Ident
name'
  (ValueOpRef SourceSpan
_ OpName 'ValueOpName
name) == (ValueOpRef SourceSpan
_ OpName 'ValueOpName
name') = OpName 'ValueOpName
name forall a. Eq a => a -> a -> Bool
== OpName 'ValueOpName
name'
  (TypeInstanceRef SourceSpan
_ Ident
name NameSource
_) == (TypeInstanceRef SourceSpan
_ Ident
name' NameSource
_) = Ident
name forall a. Eq a => a -> a -> Bool
== Ident
name'
  (ModuleRef SourceSpan
_ ModuleName
name) == (ModuleRef SourceSpan
_ ModuleName
name') = ModuleName
name forall a. Eq a => a -> a -> Bool
== ModuleName
name'
  (ReExportRef SourceSpan
_ ExportSource
mn DeclarationRef
ref) == (ReExportRef SourceSpan
_ ExportSource
mn' DeclarationRef
ref') = ExportSource
mn forall a. Eq a => a -> a -> Bool
== ExportSource
mn' Bool -> Bool -> Bool
&& DeclarationRef
ref forall a. Eq a => a -> a -> Bool
== DeclarationRef
ref'
  DeclarationRef
_ == DeclarationRef
_ = Bool
False

instance Ord DeclarationRef where
  TypeClassRef SourceSpan
_ ProperName 'ClassName
name compare :: DeclarationRef -> DeclarationRef -> Ordering
`compare` TypeClassRef SourceSpan
_ ProperName 'ClassName
name' = forall a. Ord a => a -> a -> Ordering
compare ProperName 'ClassName
name ProperName 'ClassName
name'
  TypeOpRef SourceSpan
_ OpName 'TypeOpName
name `compare` TypeOpRef SourceSpan
_ OpName 'TypeOpName
name' = forall a. Ord a => a -> a -> Ordering
compare OpName 'TypeOpName
name OpName 'TypeOpName
name'
  TypeRef SourceSpan
_ ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
dctors `compare` TypeRef SourceSpan
_ ProperName 'TypeName
name' Maybe [ProperName 'ConstructorName]
dctors' = forall a. Ord a => a -> a -> Ordering
compare ProperName 'TypeName
name ProperName 'TypeName
name' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare Maybe [ProperName 'ConstructorName]
dctors Maybe [ProperName 'ConstructorName]
dctors'
  ValueRef SourceSpan
_ Ident
name `compare` ValueRef SourceSpan
_ Ident
name' = forall a. Ord a => a -> a -> Ordering
compare Ident
name Ident
name'
  ValueOpRef SourceSpan
_ OpName 'ValueOpName
name `compare` ValueOpRef SourceSpan
_ OpName 'ValueOpName
name' = forall a. Ord a => a -> a -> Ordering
compare OpName 'ValueOpName
name OpName 'ValueOpName
name'
  TypeInstanceRef SourceSpan
_ Ident
name NameSource
_ `compare` TypeInstanceRef SourceSpan
_ Ident
name' NameSource
_ = forall a. Ord a => a -> a -> Ordering
compare Ident
name Ident
name'
  ModuleRef SourceSpan
_ ModuleName
name `compare` ModuleRef SourceSpan
_ ModuleName
name' = forall a. Ord a => a -> a -> Ordering
compare ModuleName
name ModuleName
name'
  ReExportRef SourceSpan
_ ExportSource
mn DeclarationRef
ref `compare` ReExportRef SourceSpan
_ ExportSource
mn' DeclarationRef
ref' = forall a. Ord a => a -> a -> Ordering
compare ExportSource
mn ExportSource
mn' forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare DeclarationRef
ref DeclarationRef
ref'
  compare DeclarationRef
ref DeclarationRef
ref' =
    forall a. Ord a => a -> a -> Ordering
compare (DeclarationRef -> Int
orderOf DeclarationRef
ref) (DeclarationRef -> Int
orderOf DeclarationRef
ref')
      where
        orderOf :: DeclarationRef -> Int
        orderOf :: DeclarationRef -> Int
orderOf TypeClassRef{} = Int
0
        orderOf TypeOpRef{} = Int
1
        orderOf TypeRef{} = Int
2
        orderOf ValueRef{} = Int
3
        orderOf ValueOpRef{} = Int
4
        orderOf TypeInstanceRef{} = Int
5
        orderOf ModuleRef{} = Int
6
        orderOf ReExportRef{} = Int
7

data ExportSource =
  ExportSource
  { ExportSource -> Maybe ModuleName
exportSourceImportedFrom :: Maybe ModuleName
  , ExportSource -> ModuleName
exportSourceDefinedIn :: ModuleName
  }
  deriving (ExportSource -> ExportSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportSource -> ExportSource -> Bool
$c/= :: ExportSource -> ExportSource -> Bool
== :: ExportSource -> ExportSource -> Bool
$c== :: ExportSource -> ExportSource -> Bool
Eq, Eq ExportSource
ExportSource -> ExportSource -> Bool
ExportSource -> ExportSource -> Ordering
ExportSource -> ExportSource -> ExportSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExportSource -> ExportSource -> ExportSource
$cmin :: ExportSource -> ExportSource -> ExportSource
max :: ExportSource -> ExportSource -> ExportSource
$cmax :: ExportSource -> ExportSource -> ExportSource
>= :: ExportSource -> ExportSource -> Bool
$c>= :: ExportSource -> ExportSource -> Bool
> :: ExportSource -> ExportSource -> Bool
$c> :: ExportSource -> ExportSource -> Bool
<= :: ExportSource -> ExportSource -> Bool
$c<= :: ExportSource -> ExportSource -> Bool
< :: ExportSource -> ExportSource -> Bool
$c< :: ExportSource -> ExportSource -> Bool
compare :: ExportSource -> ExportSource -> Ordering
$ccompare :: ExportSource -> ExportSource -> Ordering
Ord, Int -> ExportSource -> ShowS
[ExportSource] -> ShowS
ExportSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportSource] -> ShowS
$cshowList :: [ExportSource] -> ShowS
show :: ExportSource -> String
$cshow :: ExportSource -> String
showsPrec :: Int -> ExportSource -> ShowS
$cshowsPrec :: Int -> ExportSource -> ShowS
Show, forall x. Rep ExportSource x -> ExportSource
forall x. ExportSource -> Rep ExportSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportSource x -> ExportSource
$cfrom :: forall x. ExportSource -> Rep ExportSource x
Generic, ExportSource -> ()
forall a. (a -> ()) -> NFData a
rnf :: ExportSource -> ()
$crnf :: ExportSource -> ()
NFData, [ExportSource] -> Encoding
ExportSource -> Encoding
forall s. Decoder s [ExportSource]
forall s. Decoder s ExportSource
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: forall s. Decoder s [ExportSource]
$cdecodeList :: forall s. Decoder s [ExportSource]
encodeList :: [ExportSource] -> Encoding
$cencodeList :: [ExportSource] -> Encoding
decode :: forall s. Decoder s ExportSource
$cdecode :: forall s. Decoder s ExportSource
encode :: ExportSource -> Encoding
$cencode :: ExportSource -> Encoding
Serialise)

declRefSourceSpan :: DeclarationRef -> SourceSpan
declRefSourceSpan :: DeclarationRef -> SourceSpan
declRefSourceSpan (TypeRef SourceSpan
ss ProperName 'TypeName
_ Maybe [ProperName 'ConstructorName]
_) = SourceSpan
ss
declRefSourceSpan (TypeOpRef SourceSpan
ss OpName 'TypeOpName
_) = SourceSpan
ss
declRefSourceSpan (ValueRef SourceSpan
ss Ident
_) = SourceSpan
ss
declRefSourceSpan (ValueOpRef SourceSpan
ss OpName 'ValueOpName
_) = SourceSpan
ss
declRefSourceSpan (TypeClassRef SourceSpan
ss ProperName 'ClassName
_) = SourceSpan
ss
declRefSourceSpan (TypeInstanceRef SourceSpan
ss Ident
_ NameSource
_) = SourceSpan
ss
declRefSourceSpan (ModuleRef SourceSpan
ss ModuleName
_) = SourceSpan
ss
declRefSourceSpan (ReExportRef SourceSpan
ss ExportSource
_ DeclarationRef
_) = SourceSpan
ss

declRefName :: DeclarationRef -> Name
declRefName :: DeclarationRef -> Name
declRefName (TypeRef SourceSpan
_ ProperName 'TypeName
n Maybe [ProperName 'ConstructorName]
_) = ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n
declRefName (TypeOpRef SourceSpan
_ OpName 'TypeOpName
n) = OpName 'TypeOpName -> Name
TyOpName OpName 'TypeOpName
n
declRefName (ValueRef SourceSpan
_ Ident
n) = Ident -> Name
IdentName Ident
n
declRefName (ValueOpRef SourceSpan
_ OpName 'ValueOpName
n) = OpName 'ValueOpName -> Name
ValOpName OpName 'ValueOpName
n
declRefName (TypeClassRef SourceSpan
_ ProperName 'ClassName
n) = ProperName 'ClassName -> Name
TyClassName ProperName 'ClassName
n
declRefName (TypeInstanceRef SourceSpan
_ Ident
n NameSource
_) = Ident -> Name
IdentName Ident
n
declRefName (ModuleRef SourceSpan
_ ModuleName
n) = ModuleName -> Name
ModName ModuleName
n
declRefName (ReExportRef SourceSpan
_ ExportSource
_ DeclarationRef
ref) = DeclarationRef -> Name
declRefName DeclarationRef
ref

getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
getTypeRef :: DeclarationRef
-> Maybe
     (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
getTypeRef (TypeRef SourceSpan
_ ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
dctors) = forall a. a -> Maybe a
Just (ProperName 'TypeName
name, Maybe [ProperName 'ConstructorName]
dctors)
getTypeRef DeclarationRef
_ = forall a. Maybe a
Nothing

getTypeOpRef :: DeclarationRef -> Maybe (OpName 'TypeOpName)
getTypeOpRef :: DeclarationRef -> Maybe (OpName 'TypeOpName)
getTypeOpRef (TypeOpRef SourceSpan
_ OpName 'TypeOpName
op) = forall a. a -> Maybe a
Just OpName 'TypeOpName
op
getTypeOpRef DeclarationRef
_ = forall a. Maybe a
Nothing

getValueRef :: DeclarationRef -> Maybe Ident
getValueRef :: DeclarationRef -> Maybe Ident
getValueRef (ValueRef SourceSpan
_ Ident
name) = forall a. a -> Maybe a
Just Ident
name
getValueRef DeclarationRef
_ = forall a. Maybe a
Nothing

getValueOpRef :: DeclarationRef -> Maybe (OpName 'ValueOpName)
getValueOpRef :: DeclarationRef -> Maybe (OpName 'ValueOpName)
getValueOpRef (ValueOpRef SourceSpan
_ OpName 'ValueOpName
op) = forall a. a -> Maybe a
Just OpName 'ValueOpName
op
getValueOpRef DeclarationRef
_ = forall a. Maybe a
Nothing

getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)
getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)
getTypeClassRef (TypeClassRef SourceSpan
_ ProperName 'ClassName
name) = forall a. a -> Maybe a
Just ProperName 'ClassName
name
getTypeClassRef DeclarationRef
_ = forall a. Maybe a
Nothing

isModuleRef :: DeclarationRef -> Bool
isModuleRef :: DeclarationRef -> Bool
isModuleRef ModuleRef{} = Bool
True
isModuleRef DeclarationRef
_ = Bool
False

-- |
-- The data type which specifies type of import declaration
--
data ImportDeclarationType
  -- |
  -- An import with no explicit list: `import M`.
  --
  = Implicit
  -- |
  -- An import with an explicit list of references to import: `import M (foo)`
  --
  | Explicit [DeclarationRef]
  -- |
  -- An import with a list of references to hide: `import M hiding (foo)`
  --
  | Hiding [DeclarationRef]
  deriving (ImportDeclarationType -> ImportDeclarationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportDeclarationType -> ImportDeclarationType -> Bool
$c/= :: ImportDeclarationType -> ImportDeclarationType -> Bool
== :: ImportDeclarationType -> ImportDeclarationType -> Bool
$c== :: ImportDeclarationType -> ImportDeclarationType -> Bool
Eq, Int -> ImportDeclarationType -> ShowS
[ImportDeclarationType] -> ShowS
ImportDeclarationType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportDeclarationType] -> ShowS
$cshowList :: [ImportDeclarationType] -> ShowS
show :: ImportDeclarationType -> String
$cshow :: ImportDeclarationType -> String
showsPrec :: Int -> ImportDeclarationType -> ShowS
$cshowsPrec :: Int -> ImportDeclarationType -> ShowS
Show, forall x. Rep ImportDeclarationType x -> ImportDeclarationType
forall x. ImportDeclarationType -> Rep ImportDeclarationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportDeclarationType x -> ImportDeclarationType
$cfrom :: forall x. ImportDeclarationType -> Rep ImportDeclarationType x
Generic, [ImportDeclarationType] -> Encoding
ImportDeclarationType -> Encoding
forall s. Decoder s [ImportDeclarationType]
forall s. Decoder s ImportDeclarationType
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: forall s. Decoder s [ImportDeclarationType]
$cdecodeList :: forall s. Decoder s [ImportDeclarationType]
encodeList :: [ImportDeclarationType] -> Encoding
$cencodeList :: [ImportDeclarationType] -> Encoding
decode :: forall s. Decoder s ImportDeclarationType
$cdecode :: forall s. Decoder s ImportDeclarationType
encode :: ImportDeclarationType -> Encoding
$cencode :: ImportDeclarationType -> Encoding
Serialise)

isExplicit :: ImportDeclarationType -> Bool
isExplicit :: ImportDeclarationType -> Bool
isExplicit (Explicit [DeclarationRef]
_) = Bool
True
isExplicit ImportDeclarationType
_ = Bool
False

-- | A role declaration assigns a list of roles to a type constructor's
-- parameters, e.g.:
--
-- @type role T representational phantom@
--
-- In this example, @T@ is the identifier and @[representational, phantom]@ is
-- the list of roles (@T@ presumably having two parameters).
data RoleDeclarationData = RoleDeclarationData
  { RoleDeclarationData -> (SourceSpan, [Comment])
rdeclSourceAnn :: !SourceAnn
  , RoleDeclarationData -> ProperName 'TypeName
rdeclIdent :: !(ProperName 'TypeName)
  , RoleDeclarationData -> [Role]
rdeclRoles :: ![Role]
  } deriving (Int -> RoleDeclarationData -> ShowS
[RoleDeclarationData] -> ShowS
RoleDeclarationData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoleDeclarationData] -> ShowS
$cshowList :: [RoleDeclarationData] -> ShowS
show :: RoleDeclarationData -> String
$cshow :: RoleDeclarationData -> String
showsPrec :: Int -> RoleDeclarationData -> ShowS
$cshowsPrec :: Int -> RoleDeclarationData -> ShowS
Show, RoleDeclarationData -> RoleDeclarationData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoleDeclarationData -> RoleDeclarationData -> Bool
$c/= :: RoleDeclarationData -> RoleDeclarationData -> Bool
== :: RoleDeclarationData -> RoleDeclarationData -> Bool
$c== :: RoleDeclarationData -> RoleDeclarationData -> Bool
Eq)

-- | A type declaration assigns a type to an identifier, eg:
--
-- @identity :: forall a. a -> a@
--
-- In this example @identity@ is the identifier and @forall a. a -> a@ the type.
data TypeDeclarationData = TypeDeclarationData
  { TypeDeclarationData -> (SourceSpan, [Comment])
tydeclSourceAnn :: !SourceAnn
  , TypeDeclarationData -> Ident
tydeclIdent :: !Ident
  , TypeDeclarationData -> SourceType
tydeclType :: !SourceType
  } deriving (Int -> TypeDeclarationData -> ShowS
[TypeDeclarationData] -> ShowS
TypeDeclarationData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeDeclarationData] -> ShowS
$cshowList :: [TypeDeclarationData] -> ShowS
show :: TypeDeclarationData -> String
$cshow :: TypeDeclarationData -> String
showsPrec :: Int -> TypeDeclarationData -> ShowS
$cshowsPrec :: Int -> TypeDeclarationData -> ShowS
Show, TypeDeclarationData -> TypeDeclarationData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeDeclarationData -> TypeDeclarationData -> Bool
$c/= :: TypeDeclarationData -> TypeDeclarationData -> Bool
== :: TypeDeclarationData -> TypeDeclarationData -> Bool
$c== :: TypeDeclarationData -> TypeDeclarationData -> Bool
Eq)

getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData
getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData
getTypeDeclaration (TypeDeclaration TypeDeclarationData
d) = forall a. a -> Maybe a
Just TypeDeclarationData
d
getTypeDeclaration Declaration
_ = forall a. Maybe a
Nothing

unwrapTypeDeclaration :: TypeDeclarationData -> (Ident, SourceType)
unwrapTypeDeclaration :: TypeDeclarationData -> (Ident, SourceType)
unwrapTypeDeclaration TypeDeclarationData
td = (TypeDeclarationData -> Ident
tydeclIdent TypeDeclarationData
td, TypeDeclarationData -> SourceType
tydeclType TypeDeclarationData
td)

-- | A value declaration assigns a name and potential binders, to an expression (or multiple guarded expressions).
--
-- @double x = x + x@
--
-- In this example @double@ is the identifier, @x@ is a binder and @x + x@ is the expression.
data ValueDeclarationData a = ValueDeclarationData
  { forall a. ValueDeclarationData a -> (SourceSpan, [Comment])
valdeclSourceAnn :: !SourceAnn
  , forall a. ValueDeclarationData a -> Ident
valdeclIdent :: !Ident
  -- ^ The declared value's name
  , forall a. ValueDeclarationData a -> NameKind
valdeclName :: !NameKind
  -- ^ Whether or not this value is exported/visible
  , forall a. ValueDeclarationData a -> [Binder]
valdeclBinders :: ![Binder]
  , forall a. ValueDeclarationData a -> a
valdeclExpression :: !a
  } deriving (Int -> ValueDeclarationData a -> ShowS
forall a. Show a => Int -> ValueDeclarationData a -> ShowS
forall a. Show a => [ValueDeclarationData a] -> ShowS
forall a. Show a => ValueDeclarationData a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueDeclarationData a] -> ShowS
$cshowList :: forall a. Show a => [ValueDeclarationData a] -> ShowS
show :: ValueDeclarationData a -> String
$cshow :: forall a. Show a => ValueDeclarationData a -> String
showsPrec :: Int -> ValueDeclarationData a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ValueDeclarationData a -> ShowS
Show, forall a b. a -> ValueDeclarationData b -> ValueDeclarationData a
forall a b.
(a -> b) -> ValueDeclarationData a -> ValueDeclarationData b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ValueDeclarationData b -> ValueDeclarationData a
$c<$ :: forall a b. a -> ValueDeclarationData b -> ValueDeclarationData a
fmap :: forall a b.
(a -> b) -> ValueDeclarationData a -> ValueDeclarationData b
$cfmap :: forall a b.
(a -> b) -> ValueDeclarationData a -> ValueDeclarationData b
Functor, forall a. Eq a => a -> ValueDeclarationData a -> Bool
forall a. Num a => ValueDeclarationData a -> a
forall a. Ord a => ValueDeclarationData a -> a
forall m. Monoid m => ValueDeclarationData m -> m
forall a. ValueDeclarationData a -> Bool
forall a. ValueDeclarationData a -> Int
forall a. ValueDeclarationData a -> [a]
forall a. (a -> a -> a) -> ValueDeclarationData a -> a
forall m a. Monoid m => (a -> m) -> ValueDeclarationData a -> m
forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b
forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => ValueDeclarationData a -> a
$cproduct :: forall a. Num a => ValueDeclarationData a -> a
sum :: forall a. Num a => ValueDeclarationData a -> a
$csum :: forall a. Num a => ValueDeclarationData a -> a
minimum :: forall a. Ord a => ValueDeclarationData a -> a
$cminimum :: forall a. Ord a => ValueDeclarationData a -> a
maximum :: forall a. Ord a => ValueDeclarationData a -> a
$cmaximum :: forall a. Ord a => ValueDeclarationData a -> a
elem :: forall a. Eq a => a -> ValueDeclarationData a -> Bool
$celem :: forall a. Eq a => a -> ValueDeclarationData a -> Bool
length :: forall a. ValueDeclarationData a -> Int
$clength :: forall a. ValueDeclarationData a -> Int
null :: forall a. ValueDeclarationData a -> Bool
$cnull :: forall a. ValueDeclarationData a -> Bool
toList :: forall a. ValueDeclarationData a -> [a]
$ctoList :: forall a. ValueDeclarationData a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ValueDeclarationData a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ValueDeclarationData a -> a
foldr1 :: forall a. (a -> a -> a) -> ValueDeclarationData a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ValueDeclarationData a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ValueDeclarationData a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ValueDeclarationData a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ValueDeclarationData a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ValueDeclarationData a -> m
fold :: forall m. Monoid m => ValueDeclarationData m -> m
$cfold :: forall m. Monoid m => ValueDeclarationData m -> m
Foldable, Functor ValueDeclarationData
Foldable ValueDeclarationData
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ValueDeclarationData (m a) -> m (ValueDeclarationData a)
forall (f :: * -> *) a.
Applicative f =>
ValueDeclarationData (f a) -> f (ValueDeclarationData a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ValueDeclarationData a -> m (ValueDeclarationData b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ValueDeclarationData a -> f (ValueDeclarationData b)
sequence :: forall (m :: * -> *) a.
Monad m =>
ValueDeclarationData (m a) -> m (ValueDeclarationData a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ValueDeclarationData (m a) -> m (ValueDeclarationData a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ValueDeclarationData a -> m (ValueDeclarationData b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ValueDeclarationData a -> m (ValueDeclarationData b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ValueDeclarationData (f a) -> f (ValueDeclarationData a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ValueDeclarationData (f a) -> f (ValueDeclarationData a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ValueDeclarationData a -> f (ValueDeclarationData b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ValueDeclarationData a -> f (ValueDeclarationData b)
Traversable)

getValueDeclaration :: Declaration -> Maybe (ValueDeclarationData [GuardedExpr])
getValueDeclaration :: Declaration -> Maybe (ValueDeclarationData [GuardedExpr])
getValueDeclaration (ValueDeclaration ValueDeclarationData [GuardedExpr]
d) = forall a. a -> Maybe a
Just ValueDeclarationData [GuardedExpr]
d
getValueDeclaration Declaration
_ = forall a. Maybe a
Nothing

pattern ValueDecl :: SourceAnn -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
pattern $bValueDecl :: (SourceSpan, [Comment])
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
$mValueDecl :: forall {r}.
Declaration
-> ((SourceSpan, [Comment])
    -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> r)
-> ((# #) -> r)
-> r
ValueDecl sann ident name binders expr
  = ValueDeclaration (ValueDeclarationData sann ident name binders expr)

data DataConstructorDeclaration = DataConstructorDeclaration
  { DataConstructorDeclaration -> (SourceSpan, [Comment])
dataCtorAnn :: !SourceAnn
  , DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorName :: !(ProperName 'ConstructorName)
  , DataConstructorDeclaration -> [(Ident, SourceType)]
dataCtorFields :: ![(Ident, SourceType)]
  } deriving (Int -> DataConstructorDeclaration -> ShowS
[DataConstructorDeclaration] -> ShowS
DataConstructorDeclaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataConstructorDeclaration] -> ShowS
$cshowList :: [DataConstructorDeclaration] -> ShowS
show :: DataConstructorDeclaration -> String
$cshow :: DataConstructorDeclaration -> String
showsPrec :: Int -> DataConstructorDeclaration -> ShowS
$cshowsPrec :: Int -> DataConstructorDeclaration -> ShowS
Show, DataConstructorDeclaration -> DataConstructorDeclaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataConstructorDeclaration -> DataConstructorDeclaration -> Bool
$c/= :: DataConstructorDeclaration -> DataConstructorDeclaration -> Bool
== :: DataConstructorDeclaration -> DataConstructorDeclaration -> Bool
$c== :: DataConstructorDeclaration -> DataConstructorDeclaration -> Bool
Eq)

mapDataCtorFields :: ([(Ident, SourceType)] -> [(Ident, SourceType)]) -> DataConstructorDeclaration -> DataConstructorDeclaration
mapDataCtorFields :: ([(Ident, SourceType)] -> [(Ident, SourceType)])
-> DataConstructorDeclaration -> DataConstructorDeclaration
mapDataCtorFields [(Ident, SourceType)] -> [(Ident, SourceType)]
f DataConstructorDeclaration{[(Ident, SourceType)]
(SourceSpan, [Comment])
ProperName 'ConstructorName
dataCtorFields :: [(Ident, SourceType)]
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: (SourceSpan, [Comment])
dataCtorFields :: DataConstructorDeclaration -> [(Ident, SourceType)]
dataCtorName :: DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorAnn :: DataConstructorDeclaration -> (SourceSpan, [Comment])
..} = DataConstructorDeclaration { dataCtorFields :: [(Ident, SourceType)]
dataCtorFields = [(Ident, SourceType)] -> [(Ident, SourceType)]
f [(Ident, SourceType)]
dataCtorFields, (SourceSpan, [Comment])
ProperName 'ConstructorName
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: (SourceSpan, [Comment])
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: (SourceSpan, [Comment])
.. }

traverseDataCtorFields :: Monad m => ([(Ident, SourceType)] -> m [(Ident, SourceType)]) -> DataConstructorDeclaration -> m DataConstructorDeclaration
traverseDataCtorFields :: forall (m :: * -> *).
Monad m =>
([(Ident, SourceType)] -> m [(Ident, SourceType)])
-> DataConstructorDeclaration -> m DataConstructorDeclaration
traverseDataCtorFields [(Ident, SourceType)] -> m [(Ident, SourceType)]
f DataConstructorDeclaration{[(Ident, SourceType)]
(SourceSpan, [Comment])
ProperName 'ConstructorName
dataCtorFields :: [(Ident, SourceType)]
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: (SourceSpan, [Comment])
dataCtorFields :: DataConstructorDeclaration -> [(Ident, SourceType)]
dataCtorName :: DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorAnn :: DataConstructorDeclaration -> (SourceSpan, [Comment])
..} = (SourceSpan, [Comment])
-> ProperName 'ConstructorName
-> [(Ident, SourceType)]
-> DataConstructorDeclaration
DataConstructorDeclaration (SourceSpan, [Comment])
dataCtorAnn ProperName 'ConstructorName
dataCtorName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Ident, SourceType)] -> m [(Ident, SourceType)]
f [(Ident, SourceType)]
dataCtorFields

-- |
-- The data type of declarations
--
data Declaration
  -- |
  -- A data type declaration (data or newtype, name, arguments, data constructors)
  --
  = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, Maybe SourceType)] [DataConstructorDeclaration]
  -- |
  -- A minimal mutually recursive set of data type declarations
  --
  | DataBindingGroupDeclaration (NEL.NonEmpty Declaration)
  -- |
  -- A type synonym declaration (name, arguments, type)
  --
  | TypeSynonymDeclaration SourceAnn (ProperName 'TypeName) [(Text, Maybe SourceType)] SourceType
  -- |
  -- A kind signature declaration
  --
  | KindDeclaration SourceAnn KindSignatureFor (ProperName 'TypeName) SourceType
  -- |
  -- A role declaration (name, roles)
  --
  | RoleDeclaration {-# UNPACK #-} !RoleDeclarationData
  -- |
  -- A type declaration for a value (name, ty)
  --
  | TypeDeclaration {-# UNPACK #-} !TypeDeclarationData
  -- |
  -- A value declaration (name, top-level binders, optional guard, value)
  --
  | ValueDeclaration {-# UNPACK #-} !(ValueDeclarationData [GuardedExpr])
  -- |
  -- A declaration paired with pattern matching in let-in expression (binder, optional guard, value)
  | BoundValueDeclaration SourceAnn Binder Expr
  -- |
  -- A minimal mutually recursive set of value declarations
  --
  | BindingGroupDeclaration (NEL.NonEmpty ((SourceAnn, Ident), NameKind, Expr))
  -- |
  -- A foreign import declaration (name, type)
  --
  | ExternDeclaration SourceAnn Ident SourceType
  -- |
  -- A data type foreign import (name, kind)
  --
  | ExternDataDeclaration SourceAnn (ProperName 'TypeName) SourceType
  -- |
  -- A fixity declaration
  --
  | FixityDeclaration SourceAnn (Either ValueFixity TypeFixity)
  -- |
  -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)
  --
  | ImportDeclaration SourceAnn ModuleName ImportDeclarationType (Maybe ModuleName)
  -- |
  -- A type class declaration (name, argument, implies, member declarations)
  --
  | TypeClassDeclaration SourceAnn (ProperName 'ClassName) [(Text, Maybe SourceType)] [SourceConstraint] [FunctionalDependency] [Declaration]
  -- |
  -- A type instance declaration (instance chain, chain index, name,
  -- dependencies, class name, instance types, member declarations)
  --
  -- The first @SourceAnn@ serves as the annotation for the entire
  -- declaration, while the second @SourceAnn@ serves as the
  -- annotation for the type class and its arguments.
  | TypeInstanceDeclaration SourceAnn SourceAnn ChainId Integer (Either Text Ident) [SourceConstraint] (Qualified (ProperName 'ClassName)) [SourceType] TypeInstanceBody
  deriving (Int -> Declaration -> ShowS
[Declaration] -> ShowS
Declaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Declaration] -> ShowS
$cshowList :: [Declaration] -> ShowS
show :: Declaration -> String
$cshow :: Declaration -> String
showsPrec :: Int -> Declaration -> ShowS
$cshowsPrec :: Int -> Declaration -> ShowS
Show)

data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)
  deriving (ValueFixity -> ValueFixity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueFixity -> ValueFixity -> Bool
$c/= :: ValueFixity -> ValueFixity -> Bool
== :: ValueFixity -> ValueFixity -> Bool
$c== :: ValueFixity -> ValueFixity -> Bool
Eq, Eq ValueFixity
ValueFixity -> ValueFixity -> Bool
ValueFixity -> ValueFixity -> Ordering
ValueFixity -> ValueFixity -> ValueFixity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ValueFixity -> ValueFixity -> ValueFixity
$cmin :: ValueFixity -> ValueFixity -> ValueFixity
max :: ValueFixity -> ValueFixity -> ValueFixity
$cmax :: ValueFixity -> ValueFixity -> ValueFixity
>= :: ValueFixity -> ValueFixity -> Bool
$c>= :: ValueFixity -> ValueFixity -> Bool
> :: ValueFixity -> ValueFixity -> Bool
$c> :: ValueFixity -> ValueFixity -> Bool
<= :: ValueFixity -> ValueFixity -> Bool
$c<= :: ValueFixity -> ValueFixity -> Bool
< :: ValueFixity -> ValueFixity -> Bool
$c< :: ValueFixity -> ValueFixity -> Bool
compare :: ValueFixity -> ValueFixity -> Ordering
$ccompare :: ValueFixity -> ValueFixity -> Ordering
Ord, Int -> ValueFixity -> ShowS
[ValueFixity] -> ShowS
ValueFixity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueFixity] -> ShowS
$cshowList :: [ValueFixity] -> ShowS
show :: ValueFixity -> String
$cshow :: ValueFixity -> String
showsPrec :: Int -> ValueFixity -> ShowS
$cshowsPrec :: Int -> ValueFixity -> ShowS
Show)

data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)
  deriving (TypeFixity -> TypeFixity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeFixity -> TypeFixity -> Bool
$c/= :: TypeFixity -> TypeFixity -> Bool
== :: TypeFixity -> TypeFixity -> Bool
$c== :: TypeFixity -> TypeFixity -> Bool
Eq, Eq TypeFixity
TypeFixity -> TypeFixity -> Bool
TypeFixity -> TypeFixity -> Ordering
TypeFixity -> TypeFixity -> TypeFixity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeFixity -> TypeFixity -> TypeFixity
$cmin :: TypeFixity -> TypeFixity -> TypeFixity
max :: TypeFixity -> TypeFixity -> TypeFixity
$cmax :: TypeFixity -> TypeFixity -> TypeFixity
>= :: TypeFixity -> TypeFixity -> Bool
$c>= :: TypeFixity -> TypeFixity -> Bool
> :: TypeFixity -> TypeFixity -> Bool
$c> :: TypeFixity -> TypeFixity -> Bool
<= :: TypeFixity -> TypeFixity -> Bool
$c<= :: TypeFixity -> TypeFixity -> Bool
< :: TypeFixity -> TypeFixity -> Bool
$c< :: TypeFixity -> TypeFixity -> Bool
compare :: TypeFixity -> TypeFixity -> Ordering
$ccompare :: TypeFixity -> TypeFixity -> Ordering
Ord, Int -> TypeFixity -> ShowS
[TypeFixity] -> ShowS
TypeFixity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeFixity] -> ShowS
$cshowList :: [TypeFixity] -> ShowS
show :: TypeFixity -> String
$cshow :: TypeFixity -> String
showsPrec :: Int -> TypeFixity -> ShowS
$cshowsPrec :: Int -> TypeFixity -> ShowS
Show)

pattern ValueFixityDeclaration :: SourceAnn -> Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration
pattern $bValueFixityDeclaration :: (SourceSpan, [Comment])
-> Fixity
-> Qualified (Either Ident (ProperName 'ConstructorName))
-> OpName 'ValueOpName
-> Declaration
$mValueFixityDeclaration :: forall {r}.
Declaration
-> ((SourceSpan, [Comment])
    -> Fixity
    -> Qualified (Either Ident (ProperName 'ConstructorName))
    -> OpName 'ValueOpName
    -> r)
-> ((# #) -> r)
-> r
ValueFixityDeclaration sa fixity name op = FixityDeclaration sa (Left (ValueFixity fixity name op))

pattern TypeFixityDeclaration :: SourceAnn -> Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration
pattern $bTypeFixityDeclaration :: (SourceSpan, [Comment])
-> Fixity
-> Qualified (ProperName 'TypeName)
-> OpName 'TypeOpName
-> Declaration
$mTypeFixityDeclaration :: forall {r}.
Declaration
-> ((SourceSpan, [Comment])
    -> Fixity
    -> Qualified (ProperName 'TypeName)
    -> OpName 'TypeOpName
    -> r)
-> ((# #) -> r)
-> r
TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (TypeFixity fixity name op))

data InstanceDerivationStrategy
  = KnownClassStrategy
  | NewtypeStrategy
  deriving (Int -> InstanceDerivationStrategy -> ShowS
[InstanceDerivationStrategy] -> ShowS
InstanceDerivationStrategy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceDerivationStrategy] -> ShowS
$cshowList :: [InstanceDerivationStrategy] -> ShowS
show :: InstanceDerivationStrategy -> String
$cshow :: InstanceDerivationStrategy -> String
showsPrec :: Int -> InstanceDerivationStrategy -> ShowS
$cshowsPrec :: Int -> InstanceDerivationStrategy -> ShowS
Show)

-- | The members of a type class instance declaration
data TypeInstanceBody
  = DerivedInstance
  -- ^ This is a derived instance
  | NewtypeInstance
  -- ^ This is an instance derived from a newtype
  | ExplicitInstance [Declaration]
  -- ^ This is a regular (explicit) instance
  deriving (Int -> TypeInstanceBody -> ShowS
[TypeInstanceBody] -> ShowS
TypeInstanceBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeInstanceBody] -> ShowS
$cshowList :: [TypeInstanceBody] -> ShowS
show :: TypeInstanceBody -> String
$cshow :: TypeInstanceBody -> String
showsPrec :: Int -> TypeInstanceBody -> ShowS
$cshowsPrec :: Int -> TypeInstanceBody -> ShowS
Show)

mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody
mapTypeInstanceBody :: ([Declaration] -> [Declaration])
-> TypeInstanceBody -> TypeInstanceBody
mapTypeInstanceBody [Declaration] -> [Declaration]
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *).
Applicative f =>
([Declaration] -> f [Declaration])
-> TypeInstanceBody -> f TypeInstanceBody
traverseTypeInstanceBody (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Declaration] -> [Declaration]
f)

-- | A traversal for TypeInstanceBody
traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody
traverseTypeInstanceBody :: forall (f :: * -> *).
Applicative f =>
([Declaration] -> f [Declaration])
-> TypeInstanceBody -> f TypeInstanceBody
traverseTypeInstanceBody [Declaration] -> f [Declaration]
f (ExplicitInstance [Declaration]
ds) = [Declaration] -> TypeInstanceBody
ExplicitInstance forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Declaration] -> f [Declaration]
f [Declaration]
ds
traverseTypeInstanceBody [Declaration] -> f [Declaration]
_ TypeInstanceBody
other = forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeInstanceBody
other

-- | What sort of declaration the kind signature applies to.
data KindSignatureFor
  = DataSig
  | NewtypeSig
  | TypeSynonymSig
  | ClassSig
  deriving (KindSignatureFor -> KindSignatureFor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KindSignatureFor -> KindSignatureFor -> Bool
$c/= :: KindSignatureFor -> KindSignatureFor -> Bool
== :: KindSignatureFor -> KindSignatureFor -> Bool
$c== :: KindSignatureFor -> KindSignatureFor -> Bool
Eq, Eq KindSignatureFor
KindSignatureFor -> KindSignatureFor -> Bool
KindSignatureFor -> KindSignatureFor -> Ordering
KindSignatureFor -> KindSignatureFor -> KindSignatureFor
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KindSignatureFor -> KindSignatureFor -> KindSignatureFor
$cmin :: KindSignatureFor -> KindSignatureFor -> KindSignatureFor
max :: KindSignatureFor -> KindSignatureFor -> KindSignatureFor
$cmax :: KindSignatureFor -> KindSignatureFor -> KindSignatureFor
>= :: KindSignatureFor -> KindSignatureFor -> Bool
$c>= :: KindSignatureFor -> KindSignatureFor -> Bool
> :: KindSignatureFor -> KindSignatureFor -> Bool
$c> :: KindSignatureFor -> KindSignatureFor -> Bool
<= :: KindSignatureFor -> KindSignatureFor -> Bool
$c<= :: KindSignatureFor -> KindSignatureFor -> Bool
< :: KindSignatureFor -> KindSignatureFor -> Bool
$c< :: KindSignatureFor -> KindSignatureFor -> Bool
compare :: KindSignatureFor -> KindSignatureFor -> Ordering
$ccompare :: KindSignatureFor -> KindSignatureFor -> Ordering
Ord, Int -> KindSignatureFor -> ShowS
[KindSignatureFor] -> ShowS
KindSignatureFor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KindSignatureFor] -> ShowS
$cshowList :: [KindSignatureFor] -> ShowS
show :: KindSignatureFor -> String
$cshow :: KindSignatureFor -> String
showsPrec :: Int -> KindSignatureFor -> ShowS
$cshowsPrec :: Int -> KindSignatureFor -> ShowS
Show, forall x. Rep KindSignatureFor x -> KindSignatureFor
forall x. KindSignatureFor -> Rep KindSignatureFor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KindSignatureFor x -> KindSignatureFor
$cfrom :: forall x. KindSignatureFor -> Rep KindSignatureFor x
Generic)

instance NFData KindSignatureFor

declSourceAnn :: Declaration -> SourceAnn
declSourceAnn :: Declaration -> (SourceSpan, [Comment])
declSourceAnn (DataDeclaration (SourceSpan, [Comment])
sa DataDeclType
_ ProperName 'TypeName
_ [(Text, Maybe SourceType)]
_ [DataConstructorDeclaration]
_) = (SourceSpan, [Comment])
sa
declSourceAnn (DataBindingGroupDeclaration NonEmpty Declaration
ds) = Declaration -> (SourceSpan, [Comment])
declSourceAnn (forall a. NonEmpty a -> a
NEL.head NonEmpty Declaration
ds)
declSourceAnn (TypeSynonymDeclaration (SourceSpan, [Comment])
sa ProperName 'TypeName
_ [(Text, Maybe SourceType)]
_ SourceType
_) = (SourceSpan, [Comment])
sa
declSourceAnn (KindDeclaration (SourceSpan, [Comment])
sa KindSignatureFor
_ ProperName 'TypeName
_ SourceType
_) = (SourceSpan, [Comment])
sa
declSourceAnn (RoleDeclaration RoleDeclarationData
rd) = RoleDeclarationData -> (SourceSpan, [Comment])
rdeclSourceAnn RoleDeclarationData
rd
declSourceAnn (TypeDeclaration TypeDeclarationData
td) = TypeDeclarationData -> (SourceSpan, [Comment])
tydeclSourceAnn TypeDeclarationData
td
declSourceAnn (ValueDeclaration ValueDeclarationData [GuardedExpr]
vd) = forall a. ValueDeclarationData a -> (SourceSpan, [Comment])
valdeclSourceAnn ValueDeclarationData [GuardedExpr]
vd
declSourceAnn (BoundValueDeclaration (SourceSpan, [Comment])
sa Binder
_ Expr
_) = (SourceSpan, [Comment])
sa
declSourceAnn (BindingGroupDeclaration NonEmpty (((SourceSpan, [Comment]), Ident), NameKind, Expr)
ds) = let (((SourceSpan, [Comment])
sa, Ident
_), NameKind
_, Expr
_) = forall a. NonEmpty a -> a
NEL.head NonEmpty (((SourceSpan, [Comment]), Ident), NameKind, Expr)
ds in (SourceSpan, [Comment])
sa
declSourceAnn (ExternDeclaration (SourceSpan, [Comment])
sa Ident
_ SourceType
_) = (SourceSpan, [Comment])
sa
declSourceAnn (ExternDataDeclaration (SourceSpan, [Comment])
sa ProperName 'TypeName
_ SourceType
_) = (SourceSpan, [Comment])
sa
declSourceAnn (FixityDeclaration (SourceSpan, [Comment])
sa Either ValueFixity TypeFixity
_) = (SourceSpan, [Comment])
sa
declSourceAnn (ImportDeclaration (SourceSpan, [Comment])
sa ModuleName
_ ImportDeclarationType
_ Maybe ModuleName
_) = (SourceSpan, [Comment])
sa
declSourceAnn (TypeClassDeclaration (SourceSpan, [Comment])
sa ProperName 'ClassName
_ [(Text, Maybe SourceType)]
_ [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
_) = (SourceSpan, [Comment])
sa
declSourceAnn (TypeInstanceDeclaration (SourceSpan, [Comment])
sa (SourceSpan, [Comment])
_ ChainId
_ Integer
_ Either Text Ident
_ [SourceConstraint]
_ Qualified (ProperName 'ClassName)
_ [SourceType]
_ TypeInstanceBody
_) = (SourceSpan, [Comment])
sa

declSourceSpan :: Declaration -> SourceSpan
declSourceSpan :: Declaration -> SourceSpan
declSourceSpan = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> (SourceSpan, [Comment])
declSourceAnn

-- Note: Kind Declarations' names can refer to either a `TyClassName`
-- or a `TypeName`. Use a helper function for handling `KindDeclaration`s
-- specifically in the context in which it is needed.
declName :: Declaration -> Maybe Name
declName :: Declaration -> Maybe Name
declName (DataDeclaration (SourceSpan, [Comment])
_ DataDeclType
_ ProperName 'TypeName
n [(Text, Maybe SourceType)]
_ [DataConstructorDeclaration]
_) = forall a. a -> Maybe a
Just (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n)
declName (TypeSynonymDeclaration (SourceSpan, [Comment])
_ ProperName 'TypeName
n [(Text, Maybe SourceType)]
_ SourceType
_) = forall a. a -> Maybe a
Just (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n)
declName (ValueDeclaration ValueDeclarationData [GuardedExpr]
vd) = forall a. a -> Maybe a
Just (Ident -> Name
IdentName (forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData [GuardedExpr]
vd))
declName (ExternDeclaration (SourceSpan, [Comment])
_ Ident
n SourceType
_) = forall a. a -> Maybe a
Just (Ident -> Name
IdentName Ident
n)
declName (ExternDataDeclaration (SourceSpan, [Comment])
_ ProperName 'TypeName
n SourceType
_) = forall a. a -> Maybe a
Just (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n)
declName (FixityDeclaration (SourceSpan, [Comment])
_ (Left (ValueFixity Fixity
_ Qualified (Either Ident (ProperName 'ConstructorName))
_ OpName 'ValueOpName
n))) = forall a. a -> Maybe a
Just (OpName 'ValueOpName -> Name
ValOpName OpName 'ValueOpName
n)
declName (FixityDeclaration (SourceSpan, [Comment])
_ (Right (TypeFixity Fixity
_ Qualified (ProperName 'TypeName)
_ OpName 'TypeOpName
n))) = forall a. a -> Maybe a
Just (OpName 'TypeOpName -> Name
TyOpName OpName 'TypeOpName
n)
declName (TypeClassDeclaration (SourceSpan, [Comment])
_ ProperName 'ClassName
n [(Text, Maybe SourceType)]
_ [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
_) = forall a. a -> Maybe a
Just (ProperName 'ClassName -> Name
TyClassName ProperName 'ClassName
n)
declName (TypeInstanceDeclaration (SourceSpan, [Comment])
_ (SourceSpan, [Comment])
_ ChainId
_ Integer
_ Either Text Ident
n [SourceConstraint]
_ Qualified (ProperName 'ClassName)
_ [SourceType]
_ TypeInstanceBody
_) = Ident -> Name
IdentName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e a. Alternative m => Either e a -> m a
hush Either Text Ident
n
declName (RoleDeclaration RoleDeclarationData{[Role]
(SourceSpan, [Comment])
ProperName 'TypeName
rdeclRoles :: [Role]
rdeclIdent :: ProperName 'TypeName
rdeclSourceAnn :: (SourceSpan, [Comment])
rdeclRoles :: RoleDeclarationData -> [Role]
rdeclIdent :: RoleDeclarationData -> ProperName 'TypeName
rdeclSourceAnn :: RoleDeclarationData -> (SourceSpan, [Comment])
..}) = forall a. a -> Maybe a
Just (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
rdeclIdent)
declName ImportDeclaration{} = forall a. Maybe a
Nothing
declName BindingGroupDeclaration{} = forall a. Maybe a
Nothing
declName DataBindingGroupDeclaration{} = forall a. Maybe a
Nothing
declName BoundValueDeclaration{} = forall a. Maybe a
Nothing
declName KindDeclaration{} = forall a. Maybe a
Nothing
declName TypeDeclaration{} = forall a. Maybe a
Nothing

-- |
-- Test if a declaration is a value declaration
--
isValueDecl :: Declaration -> Bool
isValueDecl :: Declaration -> Bool
isValueDecl ValueDeclaration{} = Bool
True
isValueDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a data type declaration
--
isDataDecl :: Declaration -> Bool
isDataDecl :: Declaration -> Bool
isDataDecl DataDeclaration{} = Bool
True
isDataDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a type synonym declaration
--
isTypeSynonymDecl :: Declaration -> Bool
isTypeSynonymDecl :: Declaration -> Bool
isTypeSynonymDecl TypeSynonymDeclaration{} = Bool
True
isTypeSynonymDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a module import
--
isImportDecl :: Declaration -> Bool
isImportDecl :: Declaration -> Bool
isImportDecl ImportDeclaration{} = Bool
True
isImportDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a role declaration
--
isRoleDecl :: Declaration -> Bool
isRoleDecl :: Declaration -> Bool
isRoleDecl RoleDeclaration{} = Bool
True
isRoleDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a data type foreign import
--
isExternDataDecl :: Declaration -> Bool
isExternDataDecl :: Declaration -> Bool
isExternDataDecl ExternDataDeclaration{} = Bool
True
isExternDataDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a fixity declaration
--
isFixityDecl :: Declaration -> Bool
isFixityDecl :: Declaration -> Bool
isFixityDecl FixityDeclaration{} = Bool
True
isFixityDecl Declaration
_ = Bool
False

getFixityDecl :: Declaration -> Maybe (Either ValueFixity TypeFixity)
getFixityDecl :: Declaration -> Maybe (Either ValueFixity TypeFixity)
getFixityDecl (FixityDeclaration (SourceSpan, [Comment])
_ Either ValueFixity TypeFixity
fixity) = forall a. a -> Maybe a
Just Either ValueFixity TypeFixity
fixity
getFixityDecl Declaration
_ = forall a. Maybe a
Nothing

-- |
-- Test if a declaration is a foreign import
--
isExternDecl :: Declaration -> Bool
isExternDecl :: Declaration -> Bool
isExternDecl ExternDeclaration{} = Bool
True
isExternDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a type class instance declaration
--
isTypeClassInstanceDecl :: Declaration -> Bool
isTypeClassInstanceDecl :: Declaration -> Bool
isTypeClassInstanceDecl TypeInstanceDeclaration{} = Bool
True
isTypeClassInstanceDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a type class declaration
--
isTypeClassDecl :: Declaration -> Bool
isTypeClassDecl :: Declaration -> Bool
isTypeClassDecl TypeClassDeclaration{} = Bool
True
isTypeClassDecl Declaration
_ = Bool
False

-- |
-- Test if a declaration is a kind signature declaration.
--
isKindDecl :: Declaration -> Bool
isKindDecl :: Declaration -> Bool
isKindDecl KindDeclaration{} = Bool
True
isKindDecl Declaration
_ = Bool
False

-- |
-- Recursively flatten data binding groups in the list of declarations
flattenDecls :: [Declaration] -> [Declaration]
flattenDecls :: [Declaration] -> [Declaration]
flattenDecls = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Declaration -> [Declaration]
flattenOne
    where flattenOne :: Declaration -> [Declaration]
          flattenOne :: Declaration -> [Declaration]
flattenOne (DataBindingGroupDeclaration NonEmpty Declaration
decls) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Declaration -> [Declaration]
flattenOne NonEmpty Declaration
decls
          flattenOne Declaration
d = [Declaration
d]

-- |
-- A guard is just a boolean-valued expression that appears alongside a set of binders
--
data Guard = ConditionGuard Expr
           | PatternGuard Binder Expr
           deriving (Int -> Guard -> ShowS
[Guard] -> ShowS
Guard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Guard] -> ShowS
$cshowList :: [Guard] -> ShowS
show :: Guard -> String
$cshow :: Guard -> String
showsPrec :: Int -> Guard -> ShowS
$cshowsPrec :: Int -> Guard -> ShowS
Show)

-- |
-- The right hand side of a binder in value declarations
-- and case expressions.
data GuardedExpr = GuardedExpr [Guard] Expr
                 deriving (Int -> GuardedExpr -> ShowS
[GuardedExpr] -> ShowS
GuardedExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GuardedExpr] -> ShowS
$cshowList :: [GuardedExpr] -> ShowS
show :: GuardedExpr -> String
$cshow :: GuardedExpr -> String
showsPrec :: Int -> GuardedExpr -> ShowS
$cshowsPrec :: Int -> GuardedExpr -> ShowS
Show)

pattern MkUnguarded :: Expr -> GuardedExpr
pattern $bMkUnguarded :: Expr -> GuardedExpr
$mMkUnguarded :: forall {r}. GuardedExpr -> (Expr -> r) -> ((# #) -> r) -> r
MkUnguarded e = GuardedExpr [] e

-- |
-- Data type for expressions and terms
--
data Expr
  -- |
  -- A literal value
  --
  = Literal SourceSpan (Literal Expr)
  -- |
  -- A prefix -, will be desugared
  --
  | UnaryMinus SourceSpan Expr
  -- |
  -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
  -- will be removed.
  --
  | BinaryNoParens Expr Expr Expr
  -- |
  -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor
  -- will be removed.
  --
  -- Note: although it seems this constructor is not used, it _is_ useful, since it prevents
  -- certain traversals from matching.
  --
  | Parens Expr
  -- |
  -- An record property accessor expression (e.g. `obj.x` or `_.x`).
  -- Anonymous arguments will be removed during desugaring and expanded
  -- into a lambda that reads a property from a record.
  --
  | Accessor PSString Expr
  -- |
  -- Partial record update
  --
  | ObjectUpdate Expr [(PSString, Expr)]
  -- |
  -- Object updates with nested support: `x { foo { bar = e } }`
  -- Replaced during desugaring into a `Let` and nested `ObjectUpdate`s
  --
  | ObjectUpdateNested Expr (PathTree Expr)
  -- |
  -- Function introduction
  --
  | Abs Binder Expr
  -- |
  -- Function application
  --
  | App Expr Expr
  -- |
  -- Hint that an expression is unused.
  -- This is used to ignore type class dictionaries that are necessarily empty.
  -- The inner expression lets us solve subgoals before eliminating the whole expression.
  -- The code gen will render this as `undefined`, regardless of what the inner expression is.
  | Unused Expr
  -- |
  -- Variable
  --
  | Var SourceSpan (Qualified Ident)
  -- |
  -- An operator. This will be desugared into a function during the "operators"
  -- phase of desugaring.
  --
  | Op SourceSpan (Qualified (OpName 'ValueOpName))
  -- |
  -- Conditional (if-then-else expression)
  --
  | IfThenElse Expr Expr Expr
  -- |
  -- A data constructor
  --
  | Constructor SourceSpan (Qualified (ProperName 'ConstructorName))
  -- |
  -- A case expression. During the case expansion phase of desugaring, top-level binders will get
  -- desugared into case expressions, hence the need for guards and multiple binders per branch here.
  --
  | Case [Expr] [CaseAlternative]
  -- |
  -- A value with a type annotation
  --
  | TypedValue Bool Expr SourceType
  -- |
  -- A let binding
  --
  | Let WhereProvenance [Declaration] Expr
  -- |
  -- A do-notation block
  --
  | Do (Maybe ModuleName) [DoNotationElement]
  -- |
  -- An ado-notation block
  --
  | Ado (Maybe ModuleName) [DoNotationElement] Expr
  -- |
  -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these
  -- placeholders will be replaced with actual expressions representing type classes dictionaries which
  -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look
  -- at superclass implementations when searching for a dictionary, the type class name and
  -- instance type, and the type class dictionaries in scope.
  --
  | TypeClassDictionary SourceConstraint
                        (M.Map QualifiedBy (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict))))
                        [ErrorMessageHint]
  -- |
  -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
  --
  | DeferredDictionary (Qualified (ProperName 'ClassName)) [SourceType]
  -- |
  -- A placeholder for a type class instance to be derived during typechecking
  --
  | DerivedInstancePlaceholder (Qualified (ProperName 'ClassName)) InstanceDerivationStrategy
  -- |
  -- A placeholder for an anonymous function argument
  --
  | AnonymousArgument
  -- |
  -- A typed hole that will be turned into a hint/error during typechecking
  --
  | Hole Text
  -- |
  -- A value with source position information
  --
  | PositionedValue SourceSpan [Comment] Expr
  deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show)

-- |
-- Metadata that tells where a let binding originated
--
data WhereProvenance
  -- |
  -- The let binding was originally a where clause
  --
  = FromWhere
  -- |
  -- The let binding was always a let binding
  --
  | FromLet
  deriving (Int -> WhereProvenance -> ShowS
[WhereProvenance] -> ShowS
WhereProvenance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhereProvenance] -> ShowS
$cshowList :: [WhereProvenance] -> ShowS
show :: WhereProvenance -> String
$cshow :: WhereProvenance -> String
showsPrec :: Int -> WhereProvenance -> ShowS
$cshowsPrec :: Int -> WhereProvenance -> ShowS
Show)

-- |
-- An alternative in a case statement
--
data CaseAlternative = CaseAlternative
  { -- |
    -- A collection of binders with which to match the inputs
    --
    CaseAlternative -> [Binder]
caseAlternativeBinders :: [Binder]
    -- |
    -- The result expression or a collect of guarded expressions
    --
  , CaseAlternative -> [GuardedExpr]
caseAlternativeResult :: [GuardedExpr]
  } deriving (Int -> CaseAlternative -> ShowS
[CaseAlternative] -> ShowS
CaseAlternative -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseAlternative] -> ShowS
$cshowList :: [CaseAlternative] -> ShowS
show :: CaseAlternative -> String
$cshow :: CaseAlternative -> String
showsPrec :: Int -> CaseAlternative -> ShowS
$cshowsPrec :: Int -> CaseAlternative -> ShowS
Show)

-- |
-- A statement in a do-notation block
--
data DoNotationElement
  -- |
  -- A monadic value without a binder
  --
  = DoNotationValue Expr
  -- |
  -- A monadic value with a binder
  --
  | DoNotationBind Binder Expr
  -- |
  -- A let statement, i.e. a pure value with a binder
  --
  | DoNotationLet [Declaration]
  -- |
  -- A do notation element with source position information
  --
  | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement
  deriving (Int -> DoNotationElement -> ShowS
[DoNotationElement] -> ShowS
DoNotationElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DoNotationElement] -> ShowS
$cshowList :: [DoNotationElement] -> ShowS
show :: DoNotationElement -> String
$cshow :: DoNotationElement -> String
showsPrec :: Int -> DoNotationElement -> ShowS
$cshowsPrec :: Int -> DoNotationElement -> ShowS
Show)


-- For a record update such as:
--
--  x { foo = 0
--    , bar { baz = 1
--          , qux = 2 } }
--
-- We represent the updates as the `PathTree`:
--
--  [ ("foo", Leaf 3)
--  , ("bar", Branch [ ("baz", Leaf 1)
--                   , ("qux", Leaf 2) ]) ]
--
-- Which we then convert to an expression representing the following:
--
--   let x' = x
--   in x' { foo = 0
--         , bar = x'.bar { baz = 1
--                        , qux = 2 } }
--
-- The `let` here is required to prevent re-evaluating the object expression `x`.
-- However we don't generate this when using an anonymous argument for the object.
--

newtype PathTree t = PathTree (AssocList PSString (PathNode t))
  deriving (Int -> PathTree t -> ShowS
forall t. Show t => Int -> PathTree t -> ShowS
forall t. Show t => [PathTree t] -> ShowS
forall t. Show t => PathTree t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathTree t] -> ShowS
$cshowList :: forall t. Show t => [PathTree t] -> ShowS
show :: PathTree t -> String
$cshow :: forall t. Show t => PathTree t -> String
showsPrec :: Int -> PathTree t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> PathTree t -> ShowS
Show, PathTree t -> PathTree t -> Bool
forall t. Eq t => PathTree t -> PathTree t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathTree t -> PathTree t -> Bool
$c/= :: forall t. Eq t => PathTree t -> PathTree t -> Bool
== :: PathTree t -> PathTree t -> Bool
$c== :: forall t. Eq t => PathTree t -> PathTree t -> Bool
Eq, PathTree t -> PathTree t -> Bool
PathTree t -> PathTree t -> Ordering
PathTree t -> PathTree t -> PathTree t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {t}. Ord t => Eq (PathTree t)
forall t. Ord t => PathTree t -> PathTree t -> Bool
forall t. Ord t => PathTree t -> PathTree t -> Ordering
forall t. Ord t => PathTree t -> PathTree t -> PathTree t
min :: PathTree t -> PathTree t -> PathTree t
$cmin :: forall t. Ord t => PathTree t -> PathTree t -> PathTree t
max :: PathTree t -> PathTree t -> PathTree t
$cmax :: forall t. Ord t => PathTree t -> PathTree t -> PathTree t
>= :: PathTree t -> PathTree t -> Bool
$c>= :: forall t. Ord t => PathTree t -> PathTree t -> Bool
> :: PathTree t -> PathTree t -> Bool
$c> :: forall t. Ord t => PathTree t -> PathTree t -> Bool
<= :: PathTree t -> PathTree t -> Bool
$c<= :: forall t. Ord t => PathTree t -> PathTree t -> Bool
< :: PathTree t -> PathTree t -> Bool
$c< :: forall t. Ord t => PathTree t -> PathTree t -> Bool
compare :: PathTree t -> PathTree t -> Ordering
$ccompare :: forall t. Ord t => PathTree t -> PathTree t -> Ordering
Ord, forall a b. a -> PathTree b -> PathTree a
forall a b. (a -> b) -> PathTree a -> PathTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PathTree b -> PathTree a
$c<$ :: forall a b. a -> PathTree b -> PathTree a
fmap :: forall a b. (a -> b) -> PathTree a -> PathTree b
$cfmap :: forall a b. (a -> b) -> PathTree a -> PathTree b
Functor, forall a. Eq a => a -> PathTree a -> Bool
forall a. Num a => PathTree a -> a
forall a. Ord a => PathTree a -> a
forall m. Monoid m => PathTree m -> m
forall a. PathTree a -> Bool
forall a. PathTree a -> Int
forall a. PathTree a -> [a]
forall a. (a -> a -> a) -> PathTree a -> a
forall m a. Monoid m => (a -> m) -> PathTree a -> m
forall b a. (b -> a -> b) -> b -> PathTree a -> b
forall a b. (a -> b -> b) -> b -> PathTree a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => PathTree a -> a
$cproduct :: forall a. Num a => PathTree a -> a
sum :: forall a. Num a => PathTree a -> a
$csum :: forall a. Num a => PathTree a -> a
minimum :: forall a. Ord a => PathTree a -> a
$cminimum :: forall a. Ord a => PathTree a -> a
maximum :: forall a. Ord a => PathTree a -> a
$cmaximum :: forall a. Ord a => PathTree a -> a
elem :: forall a. Eq a => a -> PathTree a -> Bool
$celem :: forall a. Eq a => a -> PathTree a -> Bool
length :: forall a. PathTree a -> Int
$clength :: forall a. PathTree a -> Int
null :: forall a. PathTree a -> Bool
$cnull :: forall a. PathTree a -> Bool
toList :: forall a. PathTree a -> [a]
$ctoList :: forall a. PathTree a -> [a]
foldl1 :: forall a. (a -> a -> a) -> PathTree a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PathTree a -> a
foldr1 :: forall a. (a -> a -> a) -> PathTree a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PathTree a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> PathTree a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PathTree a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PathTree a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PathTree a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PathTree a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PathTree a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PathTree a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PathTree a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> PathTree a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PathTree a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PathTree a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PathTree a -> m
fold :: forall m. Monoid m => PathTree m -> m
$cfold :: forall m. Monoid m => PathTree m -> m
Foldable, Functor PathTree
Foldable PathTree
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => PathTree (m a) -> m (PathTree a)
forall (f :: * -> *) a.
Applicative f =>
PathTree (f a) -> f (PathTree a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PathTree a -> m (PathTree b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathTree a -> f (PathTree b)
sequence :: forall (m :: * -> *) a. Monad m => PathTree (m a) -> m (PathTree a)
$csequence :: forall (m :: * -> *) a. Monad m => PathTree (m a) -> m (PathTree a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PathTree a -> m (PathTree b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PathTree a -> m (PathTree b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PathTree (f a) -> f (PathTree a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PathTree (f a) -> f (PathTree a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathTree a -> f (PathTree b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathTree a -> f (PathTree b)
Traversable)

data PathNode t = Leaf t | Branch (PathTree t)
  deriving (Int -> PathNode t -> ShowS
forall t. Show t => Int -> PathNode t -> ShowS
forall t. Show t => [PathNode t] -> ShowS
forall t. Show t => PathNode t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathNode t] -> ShowS
$cshowList :: forall t. Show t => [PathNode t] -> ShowS
show :: PathNode t -> String
$cshow :: forall t. Show t => PathNode t -> String
showsPrec :: Int -> PathNode t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> PathNode t -> ShowS
Show, PathNode t -> PathNode t -> Bool
forall t. Eq t => PathNode t -> PathNode t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathNode t -> PathNode t -> Bool
$c/= :: forall t. Eq t => PathNode t -> PathNode t -> Bool
== :: PathNode t -> PathNode t -> Bool
$c== :: forall t. Eq t => PathNode t -> PathNode t -> Bool
Eq, PathNode t -> PathNode t -> Bool
PathNode t -> PathNode t -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {t}. Ord t => Eq (PathNode t)
forall t. Ord t => PathNode t -> PathNode t -> Bool
forall t. Ord t => PathNode t -> PathNode t -> Ordering
forall t. Ord t => PathNode t -> PathNode t -> PathNode t
min :: PathNode t -> PathNode t -> PathNode t
$cmin :: forall t. Ord t => PathNode t -> PathNode t -> PathNode t
max :: PathNode t -> PathNode t -> PathNode t
$cmax :: forall t. Ord t => PathNode t -> PathNode t -> PathNode t
>= :: PathNode t -> PathNode t -> Bool
$c>= :: forall t. Ord t => PathNode t -> PathNode t -> Bool
> :: PathNode t -> PathNode t -> Bool
$c> :: forall t. Ord t => PathNode t -> PathNode t -> Bool
<= :: PathNode t -> PathNode t -> Bool
$c<= :: forall t. Ord t => PathNode t -> PathNode t -> Bool
< :: PathNode t -> PathNode t -> Bool
$c< :: forall t. Ord t => PathNode t -> PathNode t -> Bool
compare :: PathNode t -> PathNode t -> Ordering
$ccompare :: forall t. Ord t => PathNode t -> PathNode t -> Ordering
Ord, forall a b. a -> PathNode b -> PathNode a
forall a b. (a -> b) -> PathNode a -> PathNode b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PathNode b -> PathNode a
$c<$ :: forall a b. a -> PathNode b -> PathNode a
fmap :: forall a b. (a -> b) -> PathNode a -> PathNode b
$cfmap :: forall a b. (a -> b) -> PathNode a -> PathNode b
Functor, forall a. Eq a => a -> PathNode a -> Bool
forall a. Num a => PathNode a -> a
forall a. Ord a => PathNode a -> a
forall m. Monoid m => PathNode m -> m
forall a. PathNode a -> Bool
forall a. PathNode a -> Int
forall a. PathNode a -> [a]
forall a. (a -> a -> a) -> PathNode a -> a
forall m a. Monoid m => (a -> m) -> PathNode a -> m
forall b a. (b -> a -> b) -> b -> PathNode a -> b
forall a b. (a -> b -> b) -> b -> PathNode a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => PathNode a -> a
$cproduct :: forall a. Num a => PathNode a -> a
sum :: forall a. Num a => PathNode a -> a
$csum :: forall a. Num a => PathNode a -> a
minimum :: forall a. Ord a => PathNode a -> a
$cminimum :: forall a. Ord a => PathNode a -> a
maximum :: forall a. Ord a => PathNode a -> a
$cmaximum :: forall a. Ord a => PathNode a -> a
elem :: forall a. Eq a => a -> PathNode a -> Bool
$celem :: forall a. Eq a => a -> PathNode a -> Bool
length :: forall a. PathNode a -> Int
$clength :: forall a. PathNode a -> Int
null :: forall a. PathNode a -> Bool
$cnull :: forall a. PathNode a -> Bool
toList :: forall a. PathNode a -> [a]
$ctoList :: forall a. PathNode a -> [a]
foldl1 :: forall a. (a -> a -> a) -> PathNode a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PathNode a -> a
foldr1 :: forall a. (a -> a -> a) -> PathNode a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PathNode a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> PathNode a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PathNode a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PathNode a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PathNode a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PathNode a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PathNode a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PathNode a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PathNode a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> PathNode a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PathNode a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PathNode a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PathNode a -> m
fold :: forall m. Monoid m => PathNode m -> m
$cfold :: forall m. Monoid m => PathNode m -> m
Foldable, Functor PathNode
Foldable PathNode
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => PathNode (m a) -> m (PathNode a)
forall (f :: * -> *) a.
Applicative f =>
PathNode (f a) -> f (PathNode a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PathNode a -> m (PathNode b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathNode a -> f (PathNode b)
sequence :: forall (m :: * -> *) a. Monad m => PathNode (m a) -> m (PathNode a)
$csequence :: forall (m :: * -> *) a. Monad m => PathNode (m a) -> m (PathNode a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PathNode a -> m (PathNode b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PathNode a -> m (PathNode b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PathNode (f a) -> f (PathNode a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PathNode (f a) -> f (PathNode a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathNode a -> f (PathNode b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathNode a -> f (PathNode b)
Traversable)

newtype AssocList k t = AssocList { forall k t. AssocList k t -> [(k, t)]
runAssocList :: [(k, t)] }
  deriving (Int -> AssocList k t -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k t. (Show k, Show t) => Int -> AssocList k t -> ShowS
forall k t. (Show k, Show t) => [AssocList k t] -> ShowS
forall k t. (Show k, Show t) => AssocList k t -> String
showList :: [AssocList k t] -> ShowS
$cshowList :: forall k t. (Show k, Show t) => [AssocList k t] -> ShowS
show :: AssocList k t -> String
$cshow :: forall k t. (Show k, Show t) => AssocList k t -> String
showsPrec :: Int -> AssocList k t -> ShowS
$cshowsPrec :: forall k t. (Show k, Show t) => Int -> AssocList k t -> ShowS
Show, AssocList k t -> AssocList k t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k t. (Eq k, Eq t) => AssocList k t -> AssocList k t -> Bool
/= :: AssocList k t -> AssocList k t -> Bool
$c/= :: forall k t. (Eq k, Eq t) => AssocList k t -> AssocList k t -> Bool
== :: AssocList k t -> AssocList k t -> Bool
$c== :: forall k t. (Eq k, Eq t) => AssocList k t -> AssocList k t -> Bool
Eq, AssocList k t -> AssocList k t -> Bool
AssocList k t -> AssocList k t -> Ordering
AssocList k t -> AssocList k t -> AssocList k t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {t}. (Ord k, Ord t) => Eq (AssocList k t)
forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> Bool
forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> Ordering
forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> AssocList k t
min :: AssocList k t -> AssocList k t -> AssocList k t
$cmin :: forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> AssocList k t
max :: AssocList k t -> AssocList k t -> AssocList k t
$cmax :: forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> AssocList k t
>= :: AssocList k t -> AssocList k t -> Bool
$c>= :: forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> Bool
> :: AssocList k t -> AssocList k t -> Bool
$c> :: forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> Bool
<= :: AssocList k t -> AssocList k t -> Bool
$c<= :: forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> Bool
< :: AssocList k t -> AssocList k t -> Bool
$c< :: forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> Bool
compare :: AssocList k t -> AssocList k t -> Ordering
$ccompare :: forall k t.
(Ord k, Ord t) =>
AssocList k t -> AssocList k t -> Ordering
Ord, forall a. AssocList k a -> Bool
forall k a. Eq a => a -> AssocList k a -> Bool
forall k a. Num a => AssocList k a -> a
forall k a. Ord a => AssocList k a -> a
forall m a. Monoid m => (a -> m) -> AssocList k a -> m
forall k m. Monoid m => AssocList k m -> m
forall k a. AssocList k a -> Bool
forall k a. AssocList k a -> Int
forall k a. AssocList k a -> [a]
forall a b. (a -> b -> b) -> b -> AssocList k a -> b
forall k a. (a -> a -> a) -> AssocList k a -> a
forall k m a. Monoid m => (a -> m) -> AssocList k a -> m
forall k b a. (b -> a -> b) -> b -> AssocList k a -> b
forall k a b. (a -> b -> b) -> b -> AssocList k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => AssocList k a -> a
$cproduct :: forall k a. Num a => AssocList k a -> a
sum :: forall a. Num a => AssocList k a -> a
$csum :: forall k a. Num a => AssocList k a -> a
minimum :: forall a. Ord a => AssocList k a -> a
$cminimum :: forall k a. Ord a => AssocList k a -> a
maximum :: forall a. Ord a => AssocList k a -> a
$cmaximum :: forall k a. Ord a => AssocList k a -> a
elem :: forall a. Eq a => a -> AssocList k a -> Bool
$celem :: forall k a. Eq a => a -> AssocList k a -> Bool
length :: forall a. AssocList k a -> Int
$clength :: forall k a. AssocList k a -> Int
null :: forall a. AssocList k a -> Bool
$cnull :: forall k a. AssocList k a -> Bool
toList :: forall a. AssocList k a -> [a]
$ctoList :: forall k a. AssocList k a -> [a]
foldl1 :: forall a. (a -> a -> a) -> AssocList k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> AssocList k a -> a
foldr1 :: forall a. (a -> a -> a) -> AssocList k a -> a
$cfoldr1 :: forall k a. (a -> a -> a) -> AssocList k a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> AssocList k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> AssocList k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AssocList k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> AssocList k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AssocList k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> AssocList k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AssocList k a -> b
$cfoldr :: forall k a b. (a -> b -> b) -> b -> AssocList k a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> AssocList k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> AssocList k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AssocList k a -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> AssocList k a -> m
fold :: forall m. Monoid m => AssocList k m -> m
$cfold :: forall k m. Monoid m => AssocList k m -> m
Foldable, forall a b. a -> AssocList k b -> AssocList k a
forall a b. (a -> b) -> AssocList k a -> AssocList k b
forall k a b. a -> AssocList k b -> AssocList k a
forall k a b. (a -> b) -> AssocList k a -> AssocList k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AssocList k b -> AssocList k a
$c<$ :: forall k a b. a -> AssocList k b -> AssocList k a
fmap :: forall a b. (a -> b) -> AssocList k a -> AssocList k b
$cfmap :: forall k a b. (a -> b) -> AssocList k a -> AssocList k b
Functor, forall k. Functor (AssocList k)
forall k. Foldable (AssocList k)
forall k (m :: * -> *) a.
Monad m =>
AssocList k (m a) -> m (AssocList k a)
forall k (f :: * -> *) a.
Applicative f =>
AssocList k (f a) -> f (AssocList k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AssocList k a -> m (AssocList k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AssocList k a -> f (AssocList k b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AssocList k a -> f (AssocList k b)
sequence :: forall (m :: * -> *) a.
Monad m =>
AssocList k (m a) -> m (AssocList k a)
$csequence :: forall k (m :: * -> *) a.
Monad m =>
AssocList k (m a) -> m (AssocList k a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AssocList k a -> m (AssocList k b)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AssocList k a -> m (AssocList k b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
AssocList k (f a) -> f (AssocList k a)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
AssocList k (f a) -> f (AssocList k a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AssocList k a -> f (AssocList k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AssocList k a -> f (AssocList k b)
Traversable)

$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''NameSource)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExportSource)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)

isTrueExpr :: Expr -> Bool
isTrueExpr :: Expr -> Bool
isTrueExpr (Literal SourceSpan
_ (BooleanLiteral Bool
True)) = Bool
True
isTrueExpr (Var SourceSpan
_ (Qualified (ByModuleName (ModuleName Text
"Prelude")) (Ident Text
"otherwise"))) = Bool
True
isTrueExpr (Var SourceSpan
_ (Qualified (ByModuleName (ModuleName Text
"Data.Boolean")) (Ident Text
"otherwise"))) = Bool
True
isTrueExpr (TypedValue Bool
_ Expr
e SourceType
_) = Expr -> Bool
isTrueExpr Expr
e
isTrueExpr (PositionedValue SourceSpan
_ [Comment]
_ Expr
e) = Expr -> Bool
isTrueExpr Expr
e
isTrueExpr Expr
_ = Bool
False

isAnonymousArgument :: Expr -> Bool
isAnonymousArgument :: Expr -> Bool
isAnonymousArgument Expr
AnonymousArgument = Bool
True
isAnonymousArgument (PositionedValue SourceSpan
_ [Comment]
_ Expr
e) = Expr -> Bool
isAnonymousArgument Expr
e
isAnonymousArgument Expr
_ = Bool
False