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

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

import Prelude.Compat

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

import Data.Aeson.TH
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.List.NonEmpty as NEL
import GHC.Generics (Generic)

import Language.PureScript.AST.Binders
import Language.PureScript.AST.Literals
import Language.PureScript.AST.Operators
import Language.PureScript.AST.SourcePos
import Language.PureScript.Types
import Language.PureScript.PSString (PSString)
import Language.PureScript.Label (Label)
import Language.PureScript.Names
import Language.PureScript.Roles
import Language.PureScript.TypeClassDictionaries
import Language.PureScript.Comments
import Language.PureScript.Environment
import qualified Language.PureScript.Constants.Prim 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
    { 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
    }
  -- ^ Results of applying type directed search to the previously captured
  -- Environment
  deriving Int -> TypeSearch -> ShowS
[TypeSearch] -> ShowS
TypeSearch -> String
(Int -> TypeSearch -> ShowS)
-> (TypeSearch -> String)
-> ([TypeSearch] -> ShowS)
-> Show TypeSearch
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 = Identity TypeSearch -> TypeSearch
forall a. Identity a -> a
runIdentity (Identity TypeSearch -> TypeSearch)
-> (TypeSearch -> Identity TypeSearch) -> TypeSearch -> TypeSearch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceType -> Identity SourceType)
-> TypeSearch -> Identity TypeSearch
forall (m :: * -> *).
Applicative m =>
(SourceType -> m SourceType) -> TypeSearch -> m TypeSearch
onTypeSearchTypesM (SourceType -> Identity SourceType
forall a. a -> Identity a
Identity (SourceType -> Identity SourceType)
-> (SourceType -> SourceType) -> SourceType -> Identity SourceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceType -> SourceType
f)

onTypeSearchTypesM :: (Applicative m) => (SourceType -> m SourceType) -> TypeSearch -> m TypeSearch
onTypeSearchTypesM :: (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 ([(Qualified Text, SourceType)]
 -> Maybe [(Label, SourceType)] -> TypeSearch)
-> m [(Qualified Text, SourceType)]
-> m (Maybe [(Label, SourceType)] -> TypeSearch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Qualified Text, SourceType) -> m (Qualified Text, SourceType))
-> [(Qualified Text, SourceType)]
-> m [(Qualified Text, SourceType)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((SourceType -> m SourceType)
-> (Qualified Text, SourceType) -> m (Qualified Text, SourceType)
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 m (Maybe [(Label, SourceType)] -> TypeSearch)
-> m (Maybe [(Label, SourceType)]) -> m TypeSearch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(Label, SourceType)] -> m [(Label, SourceType)])
-> Maybe [(Label, SourceType)] -> m (Maybe [(Label, SourceType)])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((Label, SourceType) -> m (Label, SourceType))
-> [(Label, SourceType)] -> m [(Label, SourceType)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((SourceType -> m SourceType)
-> (Label, SourceType) -> m (Label, SourceType)
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) = TypeSearch -> m TypeSearch
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
  | 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
  | ErrorSolvingConstraint SourceConstraint
  | MissingConstructorImportForCoercible (Qualified (ProperName 'ConstructorName))
  | PositionedError (NEL.NonEmpty SourceSpan)
  deriving (Int -> ErrorMessageHint -> ShowS
[ErrorMessageHint] -> ShowS
ErrorMessageHint -> String
(Int -> ErrorMessageHint -> ShowS)
-> (ErrorMessageHint -> String)
-> ([ErrorMessageHint] -> ShowS)
-> Show ErrorMessageHint
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
  | OtherHint
  deriving (Int -> HintCategory -> ShowS
[HintCategory] -> ShowS
HintCategory -> String
(Int -> HintCategory -> ShowS)
-> (HintCategory -> String)
-> ([HintCategory] -> ShowS)
-> Show HintCategory
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
(HintCategory -> HintCategory -> Bool)
-> (HintCategory -> HintCategory -> Bool) -> Eq HintCategory
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
(Int -> Module -> ShowS)
-> (Module -> String) -> ([Module] -> ShowS) -> Show Module
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 Maybe ModuleName
toImportAs ModuleName
toImport) m :: Module
m@(Module SourceSpan
ss [Comment]
coms ModuleName
mn [Declaration]
decls Maybe [DeclarationRef]
exps) =
  if Declaration -> Bool
isExistingImport (Declaration -> Bool) -> [Declaration] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` [Declaration]
decls Bool -> Bool -> Bool
|| ModuleName
mn ModuleName -> ModuleName -> Bool
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 (SourceAnn
-> ModuleName
-> ImportDeclarationType
-> Maybe ModuleName
-> Declaration
ImportDeclaration (SourceSpan
ss, []) ModuleName
toImport ImportDeclarationType
Implicit Maybe ModuleName
toImportAs Declaration -> [Declaration] -> [Declaration]
forall a. a -> [a] -> [a]
: [Declaration]
decls) Maybe [DeclarationRef]
exps
  where
  isExistingImport :: Declaration -> Bool
isExistingImport (ImportDeclaration SourceAnn
_ ModuleName
mn' ImportDeclarationType
_ Maybe ModuleName
as')
    | ModuleName
mn' ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
toImport =
        case Maybe ModuleName
toImportAs of
          Maybe ModuleName
Nothing -> Bool
True
          Maybe ModuleName
_ -> Maybe ModuleName
as' Maybe ModuleName -> Maybe ModuleName -> Bool
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.Prim
  in
    Qualified ModuleName -> Module -> Module
addDefaultImport (Maybe ModuleName -> ModuleName -> Qualified ModuleName
forall a. Maybe ModuleName -> a -> Qualified a
Qualified (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
primModName) ModuleName
primModName)
      (Module -> Module) -> (Module -> Module) -> Module -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified ModuleName -> Module -> Module
addDefaultImport (Maybe ModuleName -> ModuleName -> Qualified ModuleName
forall a. Maybe ModuleName -> a -> Qualified a
Qualified Maybe ModuleName
forall a. Maybe a
Nothing ModuleName
primModName)

-- |
-- 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 (name, class name, instance types)
  --
  | TypeInstanceRef SourceSpan Ident
  -- |
  -- 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
(Int -> DeclarationRef -> ShowS)
-> (DeclarationRef -> String)
-> ([DeclarationRef] -> ShowS)
-> Show DeclarationRef
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. DeclarationRef -> Rep DeclarationRef x)
-> (forall x. Rep DeclarationRef x -> DeclarationRef)
-> Generic DeclarationRef
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 -> ()
(DeclarationRef -> ()) -> NFData DeclarationRef
forall a. (a -> ()) -> NFData a
rnf :: DeclarationRef -> ()
$crnf :: DeclarationRef -> ()
NFData, [DeclarationRef] -> Encoding
DeclarationRef -> Encoding
(DeclarationRef -> Encoding)
-> (forall s. Decoder s DeclarationRef)
-> ([DeclarationRef] -> Encoding)
-> (forall s. Decoder s [DeclarationRef])
-> Serialise DeclarationRef
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 :: Decoder s [DeclarationRef]
$cdecodeList :: forall s. Decoder s [DeclarationRef]
encodeList :: [DeclarationRef] -> Encoding
$cencodeList :: [DeclarationRef] -> Encoding
decode :: 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 ProperName 'ClassName -> ProperName 'ClassName -> Bool
forall a. Eq a => a -> a -> Bool
== ProperName 'ClassName
name'
  (TypeOpRef SourceSpan
_ OpName 'TypeOpName
name) == (TypeOpRef SourceSpan
_ OpName 'TypeOpName
name') = OpName 'TypeOpName
name OpName 'TypeOpName -> OpName 'TypeOpName -> Bool
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 ProperName 'TypeName -> ProperName 'TypeName -> Bool
forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
name' Bool -> Bool -> Bool
&& Maybe [ProperName 'ConstructorName]
dctors Maybe [ProperName 'ConstructorName]
-> Maybe [ProperName 'ConstructorName] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [ProperName 'ConstructorName]
dctors'
  (ValueRef SourceSpan
_ Ident
name) == (ValueRef SourceSpan
_ Ident
name') = Ident
name Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
name'
  (ValueOpRef SourceSpan
_ OpName 'ValueOpName
name) == (ValueOpRef SourceSpan
_ OpName 'ValueOpName
name') = OpName 'ValueOpName
name OpName 'ValueOpName -> OpName 'ValueOpName -> Bool
forall a. Eq a => a -> a -> Bool
== OpName 'ValueOpName
name'
  (TypeInstanceRef SourceSpan
_ Ident
name) == (TypeInstanceRef SourceSpan
_ Ident
name') = Ident
name Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
name'
  (ModuleRef SourceSpan
_ ModuleName
name) == (ModuleRef SourceSpan
_ ModuleName
name') = ModuleName
name ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
name'
  (ReExportRef SourceSpan
_ ExportSource
mn DeclarationRef
ref) == (ReExportRef SourceSpan
_ ExportSource
mn' DeclarationRef
ref') = ExportSource
mn ExportSource -> ExportSource -> Bool
forall a. Eq a => a -> a -> Bool
== ExportSource
mn' Bool -> Bool -> Bool
&& DeclarationRef
ref DeclarationRef -> DeclarationRef -> Bool
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' = ProperName 'ClassName -> ProperName 'ClassName -> Ordering
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' = OpName 'TypeOpName -> OpName 'TypeOpName -> Ordering
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' = ProperName 'TypeName -> ProperName 'TypeName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ProperName 'TypeName
name ProperName 'TypeName
name' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Maybe [ProperName 'ConstructorName]
-> Maybe [ProperName 'ConstructorName] -> Ordering
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' = Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
name Ident
name'
  ValueOpRef SourceSpan
_ OpName 'ValueOpName
name `compare` ValueOpRef SourceSpan
_ OpName 'ValueOpName
name' = OpName 'ValueOpName -> OpName 'ValueOpName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OpName 'ValueOpName
name OpName 'ValueOpName
name'
  TypeInstanceRef SourceSpan
_ Ident
name `compare` TypeInstanceRef SourceSpan
_ Ident
name' = Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
name Ident
name'
  ModuleRef SourceSpan
_ ModuleName
name `compare` ModuleRef SourceSpan
_ ModuleName
name' = ModuleName -> ModuleName -> Ordering
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' = ExportSource -> ExportSource -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ExportSource
mn ExportSource
mn' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> DeclarationRef -> DeclarationRef -> Ordering
forall a. Ord a => a -> a -> Ordering
compare DeclarationRef
ref DeclarationRef
ref'
  compare DeclarationRef
ref DeclarationRef
ref' =
    Int -> Int -> Ordering
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
(ExportSource -> ExportSource -> Bool)
-> (ExportSource -> ExportSource -> Bool) -> Eq ExportSource
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
Eq ExportSource
-> (ExportSource -> ExportSource -> Ordering)
-> (ExportSource -> ExportSource -> Bool)
-> (ExportSource -> ExportSource -> Bool)
-> (ExportSource -> ExportSource -> Bool)
-> (ExportSource -> ExportSource -> Bool)
-> (ExportSource -> ExportSource -> ExportSource)
-> (ExportSource -> ExportSource -> ExportSource)
-> Ord 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
$cp1Ord :: Eq ExportSource
Ord, Int -> ExportSource -> ShowS
[ExportSource] -> ShowS
ExportSource -> String
(Int -> ExportSource -> ShowS)
-> (ExportSource -> String)
-> ([ExportSource] -> ShowS)
-> Show ExportSource
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. ExportSource -> Rep ExportSource x)
-> (forall x. Rep ExportSource x -> ExportSource)
-> Generic ExportSource
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 -> ()
(ExportSource -> ()) -> NFData ExportSource
forall a. (a -> ()) -> NFData a
rnf :: ExportSource -> ()
$crnf :: ExportSource -> ()
NFData, [ExportSource] -> Encoding
ExportSource -> Encoding
(ExportSource -> Encoding)
-> (forall s. Decoder s ExportSource)
-> ([ExportSource] -> Encoding)
-> (forall s. Decoder s [ExportSource])
-> Serialise ExportSource
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 :: Decoder s [ExportSource]
$cdecodeList :: forall s. Decoder s [ExportSource]
encodeList :: [ExportSource] -> Encoding
$cencodeList :: [ExportSource] -> Encoding
decode :: 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
_) = 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) = 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) = (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
-> Maybe
     (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
forall a. a -> Maybe a
Just (ProperName 'TypeName
name, Maybe [ProperName 'ConstructorName]
dctors)
getTypeRef DeclarationRef
_ = Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
forall a. Maybe a
Nothing

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

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

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

getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)
getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)
getTypeClassRef (TypeClassRef SourceSpan
_ ProperName 'ClassName
name) = ProperName 'ClassName -> Maybe (ProperName 'ClassName)
forall a. a -> Maybe a
Just ProperName 'ClassName
name
getTypeClassRef DeclarationRef
_ = Maybe (ProperName 'ClassName)
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
(ImportDeclarationType -> ImportDeclarationType -> Bool)
-> (ImportDeclarationType -> ImportDeclarationType -> Bool)
-> Eq ImportDeclarationType
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
(Int -> ImportDeclarationType -> ShowS)
-> (ImportDeclarationType -> String)
-> ([ImportDeclarationType] -> ShowS)
-> Show ImportDeclarationType
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. ImportDeclarationType -> Rep ImportDeclarationType x)
-> (forall x. Rep ImportDeclarationType x -> ImportDeclarationType)
-> Generic ImportDeclarationType
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
(ImportDeclarationType -> Encoding)
-> (forall s. Decoder s ImportDeclarationType)
-> ([ImportDeclarationType] -> Encoding)
-> (forall s. Decoder s [ImportDeclarationType])
-> Serialise ImportDeclarationType
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 :: Decoder s [ImportDeclarationType]
$cdecodeList :: forall s. Decoder s [ImportDeclarationType]
encodeList :: [ImportDeclarationType] -> Encoding
$cencodeList :: [ImportDeclarationType] -> Encoding
decode :: Decoder s ImportDeclarationType
$cdecode :: forall s. Decoder s ImportDeclarationType
encode :: ImportDeclarationType -> Encoding
$cencode :: ImportDeclarationType -> Encoding
Serialise)

isImplicit :: ImportDeclarationType -> Bool
isImplicit :: ImportDeclarationType -> Bool
isImplicit ImportDeclarationType
Implicit = Bool
True
isImplicit ImportDeclarationType
_ = Bool
False

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 -> SourceAnn
rdeclSourceAnn :: !SourceAnn
  , RoleDeclarationData -> ProperName 'TypeName
rdeclIdent :: !(ProperName 'TypeName)
  , RoleDeclarationData -> [Role]
rdeclRoles :: ![Role]
  } deriving (Int -> RoleDeclarationData -> ShowS
[RoleDeclarationData] -> ShowS
RoleDeclarationData -> String
(Int -> RoleDeclarationData -> ShowS)
-> (RoleDeclarationData -> String)
-> ([RoleDeclarationData] -> ShowS)
-> Show RoleDeclarationData
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
(RoleDeclarationData -> RoleDeclarationData -> Bool)
-> (RoleDeclarationData -> RoleDeclarationData -> Bool)
-> Eq RoleDeclarationData
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 -> SourceAnn
tydeclSourceAnn :: !SourceAnn
  , TypeDeclarationData -> Ident
tydeclIdent :: !Ident
  , TypeDeclarationData -> SourceType
tydeclType :: !SourceType
  } deriving (Int -> TypeDeclarationData -> ShowS
[TypeDeclarationData] -> ShowS
TypeDeclarationData -> String
(Int -> TypeDeclarationData -> ShowS)
-> (TypeDeclarationData -> String)
-> ([TypeDeclarationData] -> ShowS)
-> Show TypeDeclarationData
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
(TypeDeclarationData -> TypeDeclarationData -> Bool)
-> (TypeDeclarationData -> TypeDeclarationData -> Bool)
-> Eq TypeDeclarationData
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)

overTypeDeclaration :: (TypeDeclarationData -> TypeDeclarationData) -> Declaration -> Declaration
overTypeDeclaration :: (TypeDeclarationData -> TypeDeclarationData)
-> Declaration -> Declaration
overTypeDeclaration TypeDeclarationData -> TypeDeclarationData
f Declaration
d = Declaration
-> (TypeDeclarationData -> Declaration)
-> Maybe TypeDeclarationData
-> Declaration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Declaration
d (TypeDeclarationData -> Declaration
TypeDeclaration (TypeDeclarationData -> Declaration)
-> (TypeDeclarationData -> TypeDeclarationData)
-> TypeDeclarationData
-> Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDeclarationData -> TypeDeclarationData
f) (Declaration -> Maybe TypeDeclarationData
getTypeDeclaration Declaration
d)

getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData
getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData
getTypeDeclaration (TypeDeclaration TypeDeclarationData
d) = TypeDeclarationData -> Maybe TypeDeclarationData
forall a. a -> Maybe a
Just TypeDeclarationData
d
getTypeDeclaration Declaration
_ = Maybe TypeDeclarationData
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
  { ValueDeclarationData a -> SourceAnn
valdeclSourceAnn :: !SourceAnn
  , ValueDeclarationData a -> Ident
valdeclIdent :: !Ident
  -- ^ The declared value's name
  , ValueDeclarationData a -> NameKind
valdeclName :: !NameKind
  -- ^ Whether or not this value is exported/visible
  , ValueDeclarationData a -> [Binder]
valdeclBinders :: ![Binder]
  , ValueDeclarationData a -> a
valdeclExpression :: !a
  } deriving (Int -> ValueDeclarationData a -> ShowS
[ValueDeclarationData a] -> ShowS
ValueDeclarationData a -> String
(Int -> ValueDeclarationData a -> ShowS)
-> (ValueDeclarationData a -> String)
-> ([ValueDeclarationData a] -> ShowS)
-> Show (ValueDeclarationData a)
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, a -> ValueDeclarationData b -> ValueDeclarationData a
(a -> b) -> ValueDeclarationData a -> ValueDeclarationData b
(forall a b.
 (a -> b) -> ValueDeclarationData a -> ValueDeclarationData b)
-> (forall a b.
    a -> ValueDeclarationData b -> ValueDeclarationData a)
-> Functor ValueDeclarationData
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
<$ :: a -> ValueDeclarationData b -> ValueDeclarationData a
$c<$ :: forall a b. a -> ValueDeclarationData b -> ValueDeclarationData a
fmap :: (a -> b) -> ValueDeclarationData a -> ValueDeclarationData b
$cfmap :: forall a b.
(a -> b) -> ValueDeclarationData a -> ValueDeclarationData b
Functor, ValueDeclarationData a -> Bool
(a -> m) -> ValueDeclarationData a -> m
(a -> b -> b) -> b -> ValueDeclarationData a -> b
(forall m. Monoid m => ValueDeclarationData m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ValueDeclarationData a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ValueDeclarationData a -> m)
-> (forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b)
-> (forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b)
-> (forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b)
-> (forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b)
-> (forall a. (a -> a -> a) -> ValueDeclarationData a -> a)
-> (forall a. (a -> a -> a) -> ValueDeclarationData a -> a)
-> (forall a. ValueDeclarationData a -> [a])
-> (forall a. ValueDeclarationData a -> Bool)
-> (forall a. ValueDeclarationData a -> Int)
-> (forall a. Eq a => a -> ValueDeclarationData a -> Bool)
-> (forall a. Ord a => ValueDeclarationData a -> a)
-> (forall a. Ord a => ValueDeclarationData a -> a)
-> (forall a. Num a => ValueDeclarationData a -> a)
-> (forall a. Num a => ValueDeclarationData a -> a)
-> Foldable ValueDeclarationData
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 :: ValueDeclarationData a -> a
$cproduct :: forall a. Num a => ValueDeclarationData a -> a
sum :: ValueDeclarationData a -> a
$csum :: forall a. Num a => ValueDeclarationData a -> a
minimum :: ValueDeclarationData a -> a
$cminimum :: forall a. Ord a => ValueDeclarationData a -> a
maximum :: ValueDeclarationData a -> a
$cmaximum :: forall a. Ord a => ValueDeclarationData a -> a
elem :: a -> ValueDeclarationData a -> Bool
$celem :: forall a. Eq a => a -> ValueDeclarationData a -> Bool
length :: ValueDeclarationData a -> Int
$clength :: forall a. ValueDeclarationData a -> Int
null :: ValueDeclarationData a -> Bool
$cnull :: forall a. ValueDeclarationData a -> Bool
toList :: ValueDeclarationData a -> [a]
$ctoList :: forall a. ValueDeclarationData a -> [a]
foldl1 :: (a -> a -> a) -> ValueDeclarationData a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ValueDeclarationData a -> a
foldr1 :: (a -> a -> a) -> ValueDeclarationData a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ValueDeclarationData a -> a
foldl' :: (b -> a -> b) -> b -> ValueDeclarationData a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b
foldl :: (b -> a -> b) -> b -> ValueDeclarationData a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ValueDeclarationData a -> b
foldr' :: (a -> b -> b) -> b -> ValueDeclarationData a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b
foldr :: (a -> b -> b) -> b -> ValueDeclarationData a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ValueDeclarationData a -> b
foldMap' :: (a -> m) -> ValueDeclarationData a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ValueDeclarationData a -> m
foldMap :: (a -> m) -> ValueDeclarationData a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ValueDeclarationData a -> m
fold :: ValueDeclarationData m -> m
$cfold :: forall m. Monoid m => ValueDeclarationData m -> m
Foldable, Functor ValueDeclarationData
Foldable ValueDeclarationData
Functor ValueDeclarationData
-> Foldable ValueDeclarationData
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ValueDeclarationData a -> f (ValueDeclarationData b))
-> (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 (m :: * -> *) a.
    Monad m =>
    ValueDeclarationData (m a) -> m (ValueDeclarationData a))
-> Traversable ValueDeclarationData
(a -> f b) -> ValueDeclarationData a -> f (ValueDeclarationData 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 (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 :: ValueDeclarationData (m a) -> m (ValueDeclarationData a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ValueDeclarationData (m a) -> m (ValueDeclarationData a)
mapM :: (a -> m b) -> ValueDeclarationData a -> m (ValueDeclarationData b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ValueDeclarationData a -> m (ValueDeclarationData b)
sequenceA :: ValueDeclarationData (f a) -> f (ValueDeclarationData a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ValueDeclarationData (f a) -> f (ValueDeclarationData a)
traverse :: (a -> f b) -> ValueDeclarationData a -> f (ValueDeclarationData b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ValueDeclarationData a -> f (ValueDeclarationData b)
$cp2Traversable :: Foldable ValueDeclarationData
$cp1Traversable :: Functor ValueDeclarationData
Traversable)

overValueDeclaration :: (ValueDeclarationData [GuardedExpr] -> ValueDeclarationData [GuardedExpr]) -> Declaration -> Declaration
overValueDeclaration :: (ValueDeclarationData [GuardedExpr]
 -> ValueDeclarationData [GuardedExpr])
-> Declaration -> Declaration
overValueDeclaration ValueDeclarationData [GuardedExpr]
-> ValueDeclarationData [GuardedExpr]
f Declaration
d = Declaration
-> (ValueDeclarationData [GuardedExpr] -> Declaration)
-> Maybe (ValueDeclarationData [GuardedExpr])
-> Declaration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Declaration
d (ValueDeclarationData [GuardedExpr] -> Declaration
ValueDeclaration (ValueDeclarationData [GuardedExpr] -> Declaration)
-> (ValueDeclarationData [GuardedExpr]
    -> ValueDeclarationData [GuardedExpr])
-> ValueDeclarationData [GuardedExpr]
-> Declaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueDeclarationData [GuardedExpr]
-> ValueDeclarationData [GuardedExpr]
f) (Declaration -> Maybe (ValueDeclarationData [GuardedExpr])
getValueDeclaration Declaration
d)

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

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

data DataConstructorDeclaration = DataConstructorDeclaration
  { DataConstructorDeclaration -> SourceAnn
dataCtorAnn :: !SourceAnn
  , DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorName :: !(ProperName 'ConstructorName)
  , DataConstructorDeclaration -> [(Ident, SourceType)]
dataCtorFields :: ![(Ident, SourceType)]
  } deriving (Int -> DataConstructorDeclaration -> ShowS
[DataConstructorDeclaration] -> ShowS
DataConstructorDeclaration -> String
(Int -> DataConstructorDeclaration -> ShowS)
-> (DataConstructorDeclaration -> String)
-> ([DataConstructorDeclaration] -> ShowS)
-> Show DataConstructorDeclaration
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
(DataConstructorDeclaration -> DataConstructorDeclaration -> Bool)
-> (DataConstructorDeclaration
    -> DataConstructorDeclaration -> Bool)
-> Eq DataConstructorDeclaration
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)]
SourceAnn
ProperName 'ConstructorName
dataCtorFields :: [(Ident, SourceType)]
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: SourceAnn
dataCtorFields :: DataConstructorDeclaration -> [(Ident, SourceType)]
dataCtorName :: DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorAnn :: DataConstructorDeclaration -> SourceAnn
..} = DataConstructorDeclaration :: SourceAnn
-> ProperName 'ConstructorName
-> [(Ident, SourceType)]
-> DataConstructorDeclaration
DataConstructorDeclaration { dataCtorFields :: [(Ident, SourceType)]
dataCtorFields = [(Ident, SourceType)] -> [(Ident, SourceType)]
f [(Ident, SourceType)]
dataCtorFields, SourceAnn
ProperName 'ConstructorName
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: SourceAnn
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: SourceAnn
.. }

traverseDataCtorFields :: Monad m => ([(Ident, SourceType)] -> m [(Ident, SourceType)]) -> DataConstructorDeclaration -> m DataConstructorDeclaration
traverseDataCtorFields :: ([(Ident, SourceType)] -> m [(Ident, SourceType)])
-> DataConstructorDeclaration -> m DataConstructorDeclaration
traverseDataCtorFields [(Ident, SourceType)] -> m [(Ident, SourceType)]
f DataConstructorDeclaration{[(Ident, SourceType)]
SourceAnn
ProperName 'ConstructorName
dataCtorFields :: [(Ident, SourceType)]
dataCtorName :: ProperName 'ConstructorName
dataCtorAnn :: SourceAnn
dataCtorFields :: DataConstructorDeclaration -> [(Ident, SourceType)]
dataCtorName :: DataConstructorDeclaration -> ProperName 'ConstructorName
dataCtorAnn :: DataConstructorDeclaration -> SourceAnn
..} = SourceAnn
-> ProperName 'ConstructorName
-> [(Ident, SourceType)]
-> DataConstructorDeclaration
DataConstructorDeclaration SourceAnn
dataCtorAnn ProperName 'ConstructorName
dataCtorName ([(Ident, SourceType)] -> DataConstructorDeclaration)
-> m [(Ident, SourceType)] -> m DataConstructorDeclaration
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)
  --
  | TypeInstanceDeclaration SourceAnn [Ident] Integer Ident [SourceConstraint] (Qualified (ProperName 'ClassName)) [SourceType] TypeInstanceBody
  deriving (Int -> Declaration -> ShowS
[Declaration] -> ShowS
Declaration -> String
(Int -> Declaration -> ShowS)
-> (Declaration -> String)
-> ([Declaration] -> ShowS)
-> Show Declaration
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
(ValueFixity -> ValueFixity -> Bool)
-> (ValueFixity -> ValueFixity -> Bool) -> Eq ValueFixity
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
Eq ValueFixity
-> (ValueFixity -> ValueFixity -> Ordering)
-> (ValueFixity -> ValueFixity -> Bool)
-> (ValueFixity -> ValueFixity -> Bool)
-> (ValueFixity -> ValueFixity -> Bool)
-> (ValueFixity -> ValueFixity -> Bool)
-> (ValueFixity -> ValueFixity -> ValueFixity)
-> (ValueFixity -> ValueFixity -> ValueFixity)
-> Ord 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
$cp1Ord :: Eq ValueFixity
Ord, Int -> ValueFixity -> ShowS
[ValueFixity] -> ShowS
ValueFixity -> String
(Int -> ValueFixity -> ShowS)
-> (ValueFixity -> String)
-> ([ValueFixity] -> ShowS)
-> Show ValueFixity
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
(TypeFixity -> TypeFixity -> Bool)
-> (TypeFixity -> TypeFixity -> Bool) -> Eq TypeFixity
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
Eq TypeFixity
-> (TypeFixity -> TypeFixity -> Ordering)
-> (TypeFixity -> TypeFixity -> Bool)
-> (TypeFixity -> TypeFixity -> Bool)
-> (TypeFixity -> TypeFixity -> Bool)
-> (TypeFixity -> TypeFixity -> Bool)
-> (TypeFixity -> TypeFixity -> TypeFixity)
-> (TypeFixity -> TypeFixity -> TypeFixity)
-> Ord 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
$cp1Ord :: Eq TypeFixity
Ord, Int -> TypeFixity -> ShowS
[TypeFixity] -> ShowS
TypeFixity -> String
(Int -> TypeFixity -> ShowS)
-> (TypeFixity -> String)
-> ([TypeFixity] -> ShowS)
-> Show TypeFixity
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 :: SourceAnn
-> Fixity
-> Qualified (Either Ident (ProperName 'ConstructorName))
-> OpName 'ValueOpName
-> Declaration
$mValueFixityDeclaration :: forall r.
Declaration
-> (SourceAnn
    -> Fixity
    -> Qualified (Either Ident (ProperName 'ConstructorName))
    -> OpName 'ValueOpName
    -> r)
-> (Void# -> 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 :: SourceAnn
-> Fixity
-> Qualified (ProperName 'TypeName)
-> OpName 'TypeOpName
-> Declaration
$mTypeFixityDeclaration :: forall r.
Declaration
-> (SourceAnn
    -> Fixity
    -> Qualified (ProperName 'TypeName)
    -> OpName 'TypeOpName
    -> r)
-> (Void# -> r)
-> r
TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (TypeFixity fixity name op))

-- | 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
  | NewtypeInstanceWithDictionary Expr
  -- ^ This is an instance derived from a newtype, desugared to include a
  -- dictionary for the type under the newtype.
  | ExplicitInstance [Declaration]
  -- ^ This is a regular (explicit) instance
  deriving (Int -> TypeInstanceBody -> ShowS
[TypeInstanceBody] -> ShowS
TypeInstanceBody -> String
(Int -> TypeInstanceBody -> ShowS)
-> (TypeInstanceBody -> String)
-> ([TypeInstanceBody] -> ShowS)
-> Show TypeInstanceBody
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 = Identity TypeInstanceBody -> TypeInstanceBody
forall a. Identity a -> a
runIdentity (Identity TypeInstanceBody -> TypeInstanceBody)
-> (TypeInstanceBody -> Identity TypeInstanceBody)
-> TypeInstanceBody
-> TypeInstanceBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Declaration] -> Identity [Declaration])
-> TypeInstanceBody -> Identity TypeInstanceBody
forall (f :: * -> *).
Applicative f =>
([Declaration] -> f [Declaration])
-> TypeInstanceBody -> f TypeInstanceBody
traverseTypeInstanceBody ([Declaration] -> Identity [Declaration]
forall a. a -> Identity a
Identity ([Declaration] -> Identity [Declaration])
-> ([Declaration] -> [Declaration])
-> [Declaration]
-> Identity [Declaration]
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 :: ([Declaration] -> f [Declaration])
-> TypeInstanceBody -> f TypeInstanceBody
traverseTypeInstanceBody [Declaration] -> f [Declaration]
f (ExplicitInstance [Declaration]
ds) = [Declaration] -> TypeInstanceBody
ExplicitInstance ([Declaration] -> TypeInstanceBody)
-> f [Declaration] -> f TypeInstanceBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Declaration] -> f [Declaration]
f [Declaration]
ds
traverseTypeInstanceBody [Declaration] -> f [Declaration]
_ TypeInstanceBody
other = TypeInstanceBody -> f TypeInstanceBody
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
(KindSignatureFor -> KindSignatureFor -> Bool)
-> (KindSignatureFor -> KindSignatureFor -> Bool)
-> Eq KindSignatureFor
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
Eq KindSignatureFor
-> (KindSignatureFor -> KindSignatureFor -> Ordering)
-> (KindSignatureFor -> KindSignatureFor -> Bool)
-> (KindSignatureFor -> KindSignatureFor -> Bool)
-> (KindSignatureFor -> KindSignatureFor -> Bool)
-> (KindSignatureFor -> KindSignatureFor -> Bool)
-> (KindSignatureFor -> KindSignatureFor -> KindSignatureFor)
-> (KindSignatureFor -> KindSignatureFor -> KindSignatureFor)
-> Ord 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
$cp1Ord :: Eq KindSignatureFor
Ord, Int -> KindSignatureFor -> ShowS
[KindSignatureFor] -> ShowS
KindSignatureFor -> String
(Int -> KindSignatureFor -> ShowS)
-> (KindSignatureFor -> String)
-> ([KindSignatureFor] -> ShowS)
-> Show KindSignatureFor
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)

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

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

declName :: Declaration -> Maybe Name
declName :: Declaration -> Maybe Name
declName (DataDeclaration SourceAnn
_ DataDeclType
_ ProperName 'TypeName
n [(Text, Maybe SourceType)]
_ [DataConstructorDeclaration]
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n)
declName (TypeSynonymDeclaration SourceAnn
_ ProperName 'TypeName
n [(Text, Maybe SourceType)]
_ SourceType
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n)
declName (ValueDeclaration ValueDeclarationData [GuardedExpr]
vd) = Name -> Maybe Name
forall a. a -> Maybe a
Just (Ident -> Name
IdentName (ValueDeclarationData [GuardedExpr] -> Ident
forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData [GuardedExpr]
vd))
declName (ExternDeclaration SourceAnn
_ Ident
n SourceType
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just (Ident -> Name
IdentName Ident
n)
declName (ExternDataDeclaration SourceAnn
_ ProperName 'TypeName
n SourceType
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just (ProperName 'TypeName -> Name
TyName ProperName 'TypeName
n)
declName (FixityDeclaration SourceAnn
_ (Left (ValueFixity Fixity
_ Qualified (Either Ident (ProperName 'ConstructorName))
_ OpName 'ValueOpName
n))) = Name -> Maybe Name
forall a. a -> Maybe a
Just (OpName 'ValueOpName -> Name
ValOpName OpName 'ValueOpName
n)
declName (FixityDeclaration SourceAnn
_ (Right (TypeFixity Fixity
_ Qualified (ProperName 'TypeName)
_ OpName 'TypeOpName
n))) = Name -> Maybe Name
forall a. a -> Maybe a
Just (OpName 'TypeOpName -> Name
TyOpName OpName 'TypeOpName
n)
declName (TypeClassDeclaration SourceAnn
_ ProperName 'ClassName
n [(Text, Maybe SourceType)]
_ [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just (ProperName 'ClassName -> Name
TyClassName ProperName 'ClassName
n)
declName (TypeInstanceDeclaration SourceAnn
_ [Ident]
_ Integer
_ Ident
n [SourceConstraint]
_ Qualified (ProperName 'ClassName)
_ [SourceType]
_ TypeInstanceBody
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just (Ident -> Name
IdentName Ident
n)
declName ImportDeclaration{} = Maybe Name
forall a. Maybe a
Nothing
declName BindingGroupDeclaration{} = Maybe Name
forall a. Maybe a
Nothing
declName DataBindingGroupDeclaration{} = Maybe Name
forall a. Maybe a
Nothing
declName BoundValueDeclaration{} = Maybe Name
forall a. Maybe a
Nothing
declName KindDeclaration{} = Maybe Name
forall a. Maybe a
Nothing
declName TypeDeclaration{} = Maybe Name
forall a. Maybe a
Nothing
declName RoleDeclaration{} = Maybe Name
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 SourceAnn
_ Either ValueFixity TypeFixity
fixity) = Either ValueFixity TypeFixity
-> Maybe (Either ValueFixity TypeFixity)
forall a. a -> Maybe a
Just Either ValueFixity TypeFixity
fixity
getFixityDecl Declaration
_ = Maybe (Either ValueFixity TypeFixity)
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 = (Declaration -> [Declaration]) -> [Declaration] -> [Declaration]
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) = (Declaration -> [Declaration])
-> NonEmpty Declaration -> [Declaration]
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
(Int -> Guard -> ShowS)
-> (Guard -> String) -> ([Guard] -> ShowS) -> Show Guard
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
(Int -> GuardedExpr -> ShowS)
-> (GuardedExpr -> String)
-> ([GuardedExpr] -> ShowS)
-> Show GuardedExpr
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) -> (Void# -> 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
  -- |
  -- An application of a typeclass dictionary constructor. The value should be
  -- an ObjectLiteral.
  --
  | TypeClassDictionaryConstructorApp (Qualified (ProperName 'ClassName)) 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 (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict))))
                        [ErrorMessageHint]
  -- |
  -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
  --
  | TypeClassDictionaryAccessor (Qualified (ProperName 'ClassName)) Ident
  -- |
  -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
  --
  | DeferredDictionary (Qualified (ProperName 'ClassName)) [SourceType]
  -- |
  -- 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
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
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
(Int -> WhereProvenance -> ShowS)
-> (WhereProvenance -> String)
-> ([WhereProvenance] -> ShowS)
-> Show WhereProvenance
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
(Int -> CaseAlternative -> ShowS)
-> (CaseAlternative -> String)
-> ([CaseAlternative] -> ShowS)
-> Show CaseAlternative
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
(Int -> DoNotationElement -> ShowS)
-> (DoNotationElement -> String)
-> ([DoNotationElement] -> ShowS)
-> Show DoNotationElement
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
[PathTree t] -> ShowS
PathTree t -> String
(Int -> PathTree t -> ShowS)
-> (PathTree t -> String)
-> ([PathTree t] -> ShowS)
-> Show (PathTree t)
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
(PathTree t -> PathTree t -> Bool)
-> (PathTree t -> PathTree t -> Bool) -> Eq (PathTree t)
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, Eq (PathTree t)
Eq (PathTree t)
-> (PathTree t -> PathTree t -> Ordering)
-> (PathTree t -> PathTree t -> Bool)
-> (PathTree t -> PathTree t -> Bool)
-> (PathTree t -> PathTree t -> Bool)
-> (PathTree t -> PathTree t -> Bool)
-> (PathTree t -> PathTree t -> PathTree t)
-> (PathTree t -> PathTree t -> PathTree t)
-> Ord (PathTree t)
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
$cp1Ord :: forall t. Ord t => Eq (PathTree t)
Ord, a -> PathTree b -> PathTree a
(a -> b) -> PathTree a -> PathTree b
(forall a b. (a -> b) -> PathTree a -> PathTree b)
-> (forall a b. a -> PathTree b -> PathTree a) -> Functor PathTree
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
<$ :: a -> PathTree b -> PathTree a
$c<$ :: forall a b. a -> PathTree b -> PathTree a
fmap :: (a -> b) -> PathTree a -> PathTree b
$cfmap :: forall a b. (a -> b) -> PathTree a -> PathTree b
Functor, PathTree a -> Bool
(a -> m) -> PathTree a -> m
(a -> b -> b) -> b -> PathTree a -> b
(forall m. Monoid m => PathTree m -> m)
-> (forall m a. Monoid m => (a -> m) -> PathTree a -> m)
-> (forall m a. Monoid m => (a -> m) -> PathTree a -> m)
-> (forall a b. (a -> b -> b) -> b -> PathTree a -> b)
-> (forall a b. (a -> b -> b) -> b -> PathTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> PathTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> PathTree a -> b)
-> (forall a. (a -> a -> a) -> PathTree a -> a)
-> (forall a. (a -> a -> a) -> PathTree a -> a)
-> (forall a. PathTree a -> [a])
-> (forall a. PathTree a -> Bool)
-> (forall a. PathTree a -> Int)
-> (forall a. Eq a => a -> PathTree a -> Bool)
-> (forall a. Ord a => PathTree a -> a)
-> (forall a. Ord a => PathTree a -> a)
-> (forall a. Num a => PathTree a -> a)
-> (forall a. Num a => PathTree a -> a)
-> Foldable PathTree
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 :: PathTree a -> a
$cproduct :: forall a. Num a => PathTree a -> a
sum :: PathTree a -> a
$csum :: forall a. Num a => PathTree a -> a
minimum :: PathTree a -> a
$cminimum :: forall a. Ord a => PathTree a -> a
maximum :: PathTree a -> a
$cmaximum :: forall a. Ord a => PathTree a -> a
elem :: a -> PathTree a -> Bool
$celem :: forall a. Eq a => a -> PathTree a -> Bool
length :: PathTree a -> Int
$clength :: forall a. PathTree a -> Int
null :: PathTree a -> Bool
$cnull :: forall a. PathTree a -> Bool
toList :: PathTree a -> [a]
$ctoList :: forall a. PathTree a -> [a]
foldl1 :: (a -> a -> a) -> PathTree a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PathTree a -> a
foldr1 :: (a -> a -> a) -> PathTree a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PathTree a -> a
foldl' :: (b -> a -> b) -> b -> PathTree a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PathTree a -> b
foldl :: (b -> a -> b) -> b -> PathTree a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PathTree a -> b
foldr' :: (a -> b -> b) -> b -> PathTree a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PathTree a -> b
foldr :: (a -> b -> b) -> b -> PathTree a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PathTree a -> b
foldMap' :: (a -> m) -> PathTree a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PathTree a -> m
foldMap :: (a -> m) -> PathTree a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PathTree a -> m
fold :: PathTree m -> m
$cfold :: forall m. Monoid m => PathTree m -> m
Foldable, Functor PathTree
Foldable PathTree
Functor PathTree
-> Foldable PathTree
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PathTree a -> f (PathTree b))
-> (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 (m :: * -> *) a.
    Monad m =>
    PathTree (m a) -> m (PathTree a))
-> Traversable PathTree
(a -> f b) -> PathTree a -> f (PathTree 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 (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 :: PathTree (m a) -> m (PathTree a)
$csequence :: forall (m :: * -> *) a. Monad m => PathTree (m a) -> m (PathTree a)
mapM :: (a -> m b) -> PathTree a -> m (PathTree b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PathTree a -> m (PathTree b)
sequenceA :: PathTree (f a) -> f (PathTree a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PathTree (f a) -> f (PathTree a)
traverse :: (a -> f b) -> PathTree a -> f (PathTree b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathTree a -> f (PathTree b)
$cp2Traversable :: Foldable PathTree
$cp1Traversable :: Functor PathTree
Traversable)

data PathNode t = Leaf t | Branch (PathTree t)
  deriving (Int -> PathNode t -> ShowS
[PathNode t] -> ShowS
PathNode t -> String
(Int -> PathNode t -> ShowS)
-> (PathNode t -> String)
-> ([PathNode t] -> ShowS)
-> Show (PathNode t)
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
(PathNode t -> PathNode t -> Bool)
-> (PathNode t -> PathNode t -> Bool) -> Eq (PathNode t)
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, Eq (PathNode t)
Eq (PathNode t)
-> (PathNode t -> PathNode t -> Ordering)
-> (PathNode t -> PathNode t -> Bool)
-> (PathNode t -> PathNode t -> Bool)
-> (PathNode t -> PathNode t -> Bool)
-> (PathNode t -> PathNode t -> Bool)
-> (PathNode t -> PathNode t -> PathNode t)
-> (PathNode t -> PathNode t -> PathNode t)
-> Ord (PathNode t)
PathNode t -> PathNode t -> Bool
PathNode t -> PathNode t -> Ordering
PathNode t -> PathNode t -> PathNode 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 (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
$cp1Ord :: forall t. Ord t => Eq (PathNode t)
Ord, a -> PathNode b -> PathNode a
(a -> b) -> PathNode a -> PathNode b
(forall a b. (a -> b) -> PathNode a -> PathNode b)
-> (forall a b. a -> PathNode b -> PathNode a) -> Functor PathNode
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
<$ :: a -> PathNode b -> PathNode a
$c<$ :: forall a b. a -> PathNode b -> PathNode a
fmap :: (a -> b) -> PathNode a -> PathNode b
$cfmap :: forall a b. (a -> b) -> PathNode a -> PathNode b
Functor, PathNode a -> Bool
(a -> m) -> PathNode a -> m
(a -> b -> b) -> b -> PathNode a -> b
(forall m. Monoid m => PathNode m -> m)
-> (forall m a. Monoid m => (a -> m) -> PathNode a -> m)
-> (forall m a. Monoid m => (a -> m) -> PathNode a -> m)
-> (forall a b. (a -> b -> b) -> b -> PathNode a -> b)
-> (forall a b. (a -> b -> b) -> b -> PathNode a -> b)
-> (forall b a. (b -> a -> b) -> b -> PathNode a -> b)
-> (forall b a. (b -> a -> b) -> b -> PathNode a -> b)
-> (forall a. (a -> a -> a) -> PathNode a -> a)
-> (forall a. (a -> a -> a) -> PathNode a -> a)
-> (forall a. PathNode a -> [a])
-> (forall a. PathNode a -> Bool)
-> (forall a. PathNode a -> Int)
-> (forall a. Eq a => a -> PathNode a -> Bool)
-> (forall a. Ord a => PathNode a -> a)
-> (forall a. Ord a => PathNode a -> a)
-> (forall a. Num a => PathNode a -> a)
-> (forall a. Num a => PathNode a -> a)
-> Foldable PathNode
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 :: PathNode a -> a
$cproduct :: forall a. Num a => PathNode a -> a
sum :: PathNode a -> a
$csum :: forall a. Num a => PathNode a -> a
minimum :: PathNode a -> a
$cminimum :: forall a. Ord a => PathNode a -> a
maximum :: PathNode a -> a
$cmaximum :: forall a. Ord a => PathNode a -> a
elem :: a -> PathNode a -> Bool
$celem :: forall a. Eq a => a -> PathNode a -> Bool
length :: PathNode a -> Int
$clength :: forall a. PathNode a -> Int
null :: PathNode a -> Bool
$cnull :: forall a. PathNode a -> Bool
toList :: PathNode a -> [a]
$ctoList :: forall a. PathNode a -> [a]
foldl1 :: (a -> a -> a) -> PathNode a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PathNode a -> a
foldr1 :: (a -> a -> a) -> PathNode a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PathNode a -> a
foldl' :: (b -> a -> b) -> b -> PathNode a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PathNode a -> b
foldl :: (b -> a -> b) -> b -> PathNode a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PathNode a -> b
foldr' :: (a -> b -> b) -> b -> PathNode a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PathNode a -> b
foldr :: (a -> b -> b) -> b -> PathNode a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PathNode a -> b
foldMap' :: (a -> m) -> PathNode a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PathNode a -> m
foldMap :: (a -> m) -> PathNode a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PathNode a -> m
fold :: PathNode m -> m
$cfold :: forall m. Monoid m => PathNode m -> m
Foldable, Functor PathNode
Foldable PathNode
Functor PathNode
-> Foldable PathNode
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PathNode a -> f (PathNode b))
-> (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 (m :: * -> *) a.
    Monad m =>
    PathNode (m a) -> m (PathNode a))
-> Traversable PathNode
(a -> f b) -> PathNode a -> f (PathNode 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 (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 :: PathNode (m a) -> m (PathNode a)
$csequence :: forall (m :: * -> *) a. Monad m => PathNode (m a) -> m (PathNode a)
mapM :: (a -> m b) -> PathNode a -> m (PathNode b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PathNode a -> m (PathNode b)
sequenceA :: PathNode (f a) -> f (PathNode a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PathNode (f a) -> f (PathNode a)
traverse :: (a -> f b) -> PathNode a -> f (PathNode b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathNode a -> f (PathNode b)
$cp2Traversable :: Foldable PathNode
$cp1Traversable :: Functor PathNode
Traversable)

newtype AssocList k t = AssocList { AssocList k t -> [(k, t)]
runAssocList :: [(k, t)] }
  deriving (Int -> AssocList k t -> ShowS
[AssocList k t] -> ShowS
AssocList k t -> String
(Int -> AssocList k t -> ShowS)
-> (AssocList k t -> String)
-> ([AssocList k t] -> ShowS)
-> Show (AssocList k t)
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
(AssocList k t -> AssocList k t -> Bool)
-> (AssocList k t -> AssocList k t -> Bool) -> Eq (AssocList k t)
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, Eq (AssocList k t)
Eq (AssocList k t)
-> (AssocList k t -> AssocList k t -> Ordering)
-> (AssocList k t -> AssocList k t -> Bool)
-> (AssocList k t -> AssocList k t -> Bool)
-> (AssocList k t -> AssocList k t -> Bool)
-> (AssocList k t -> AssocList k t -> Bool)
-> (AssocList k t -> AssocList k t -> AssocList k t)
-> (AssocList k t -> AssocList k t -> AssocList k t)
-> Ord (AssocList k t)
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
$cp1Ord :: forall k t. (Ord k, Ord t) => Eq (AssocList k t)
Ord, AssocList k a -> Bool
(a -> m) -> AssocList k a -> m
(a -> b -> b) -> b -> AssocList k a -> b
(forall m. Monoid m => AssocList k m -> m)
-> (forall m a. Monoid m => (a -> m) -> AssocList k a -> m)
-> (forall m a. Monoid m => (a -> m) -> AssocList k a -> m)
-> (forall a b. (a -> b -> b) -> b -> AssocList k a -> b)
-> (forall a b. (a -> b -> b) -> b -> AssocList k a -> b)
-> (forall b a. (b -> a -> b) -> b -> AssocList k a -> b)
-> (forall b a. (b -> a -> b) -> b -> AssocList k a -> b)
-> (forall a. (a -> a -> a) -> AssocList k a -> a)
-> (forall a. (a -> a -> a) -> AssocList k a -> a)
-> (forall a. AssocList k a -> [a])
-> (forall a. AssocList k a -> Bool)
-> (forall a. AssocList k a -> Int)
-> (forall a. Eq a => a -> AssocList k a -> Bool)
-> (forall a. Ord a => AssocList k a -> a)
-> (forall a. Ord a => AssocList k a -> a)
-> (forall a. Num a => AssocList k a -> a)
-> (forall a. Num a => AssocList k a -> a)
-> Foldable (AssocList k)
forall a. Eq a => a -> AssocList k a -> Bool
forall a. Num a => AssocList k a -> a
forall a. Ord a => AssocList k a -> a
forall m. Monoid m => AssocList k m -> m
forall a. AssocList k a -> Bool
forall a. AssocList k a -> Int
forall a. AssocList k a -> [a]
forall a. (a -> a -> a) -> AssocList k a -> a
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 b a. (b -> a -> b) -> b -> AssocList k a -> b
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 :: AssocList k a -> a
$cproduct :: forall k a. Num a => AssocList k a -> a
sum :: AssocList k a -> a
$csum :: forall k a. Num a => AssocList k a -> a
minimum :: AssocList k a -> a
$cminimum :: forall k a. Ord a => AssocList k a -> a
maximum :: AssocList k a -> a
$cmaximum :: forall k a. Ord a => AssocList k a -> a
elem :: a -> AssocList k a -> Bool
$celem :: forall k a. Eq a => a -> AssocList k a -> Bool
length :: AssocList k a -> Int
$clength :: forall k a. AssocList k a -> Int
null :: AssocList k a -> Bool
$cnull :: forall k a. AssocList k a -> Bool
toList :: AssocList k a -> [a]
$ctoList :: forall k a. AssocList k a -> [a]
foldl1 :: (a -> a -> a) -> AssocList k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> AssocList k a -> a
foldr1 :: (a -> a -> a) -> AssocList k a -> a
$cfoldr1 :: forall k a. (a -> a -> a) -> AssocList k a -> a
foldl' :: (b -> a -> b) -> b -> AssocList k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> AssocList k a -> b
foldl :: (b -> a -> b) -> b -> AssocList k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> AssocList k a -> b
foldr' :: (a -> b -> b) -> b -> AssocList k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> AssocList k a -> b
foldr :: (a -> b -> b) -> b -> AssocList k a -> b
$cfoldr :: forall k a b. (a -> b -> b) -> b -> AssocList k a -> b
foldMap' :: (a -> m) -> AssocList k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> AssocList k a -> m
foldMap :: (a -> m) -> AssocList k a -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> AssocList k a -> m
fold :: AssocList k m -> m
$cfold :: forall k m. Monoid m => AssocList k m -> m
Foldable, a -> AssocList k b -> AssocList k a
(a -> b) -> AssocList k a -> AssocList k b
(forall a b. (a -> b) -> AssocList k a -> AssocList k b)
-> (forall a b. a -> AssocList k b -> AssocList k a)
-> Functor (AssocList k)
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
<$ :: a -> AssocList k b -> AssocList k a
$c<$ :: forall k a b. a -> AssocList k b -> AssocList k a
fmap :: (a -> b) -> AssocList k a -> AssocList k b
$cfmap :: forall k a b. (a -> b) -> AssocList k a -> AssocList k b
Functor, Functor (AssocList k)
Foldable (AssocList k)
Functor (AssocList k)
-> Foldable (AssocList k)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> AssocList k a -> f (AssocList k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    AssocList k (f a) -> f (AssocList k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> AssocList k a -> m (AssocList k b))
-> (forall (m :: * -> *) a.
    Monad m =>
    AssocList k (m a) -> m (AssocList k a))
-> Traversable (AssocList k)
(a -> f b) -> AssocList k a -> f (AssocList k b)
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 (m :: * -> *) a.
Monad m =>
AssocList k (m a) -> m (AssocList k a)
forall (f :: * -> *) a.
Applicative f =>
AssocList k (f a) -> f (AssocList k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AssocList k a -> m (AssocList k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AssocList k a -> f (AssocList k b)
sequence :: AssocList k (m a) -> m (AssocList k a)
$csequence :: forall k (m :: * -> *) a.
Monad m =>
AssocList k (m a) -> m (AssocList k a)
mapM :: (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 :: AssocList k (f a) -> f (AssocList k a)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
AssocList k (f a) -> f (AssocList k a)
traverse :: (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)
$cp2Traversable :: forall k. Foldable (AssocList k)
$cp1Traversable :: forall k. Functor (AssocList k)
Traversable)

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

isTrueExpr :: Expr -> Bool
isTrueExpr :: Expr -> Bool
isTrueExpr (Literal SourceSpan
_ (BooleanLiteral Bool
True)) = Bool
True
isTrueExpr (Var SourceSpan
_ (Qualified (Just (ModuleName Text
"Prelude")) (Ident Text
"otherwise"))) = Bool
True
isTrueExpr (Var SourceSpan
_ (Qualified (Just (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