module Language.PureScript.Sugar.TypeClasses
( desugarTypeClasses
, typeClassMemberName
, superClassDictionaryNames
) where
import Prelude
import Control.Arrow (first, second)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.State (MonadState(..), StateT, evalStateT, modify)
import Control.Monad.Supply.Class (MonadSupply)
import Data.Graph (SCC(..), stronglyConnComp)
import Data.List (find, partition)
import Data.List.NonEmpty (nonEmpty)
import Data.Map qualified as M
import Data.Maybe (catMaybes, mapMaybe, isJust)
import Data.List.NonEmpty qualified as NEL
import Data.Set qualified as S
import Data.Text (Text)
import Data.Traversable (for)
import Language.PureScript.Constants.Prim qualified as C
import Language.PureScript.Crash (internalError)
import Language.PureScript.Environment (DataDeclType(..), NameKind(..), TypeClassData(..), dictTypeName, function, makeTypeClassData, primClasses, primCoerceClasses, primIntClasses, primRowClasses, primRowListClasses, primSymbolClasses, primTypeErrorClasses, tyRecord)
import Language.PureScript.Errors hiding (isExported, nonEmpty)
import Language.PureScript.Externs (ExternsDeclaration(..), ExternsFile(..))
import Language.PureScript.Label (Label(..))
import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, freshIdent, qualify, runIdent)
import Language.PureScript.PSString (mkString)
import Language.PureScript.Sugar.CaseDeclarations (desugarCases)
import Language.PureScript.TypeClassDictionaries (superclassName)
import Language.PureScript.Types
type MemberMap = M.Map (ModuleName, ProperName 'ClassName) TypeClassData
type Desugar = StateT MemberMap
desugarTypeClasses
:: (MonadSupply m, MonadError MultipleErrors m)
=> [ExternsFile]
-> Module
-> m Module
desugarTypeClasses :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[ExternsFile] -> Module -> m Module
desugarTypeClasses [ExternsFile]
externs = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT MemberMap
initialState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
Module -> Desugar m Module
desugarModule
where
initialState :: MemberMap
initialState :: MemberMap
initialState =
forall a. Monoid a => [a] -> a
mconcat
[ forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (forall a. ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
C.M_Prim) Map (Qualified (ProperName 'ClassName)) TypeClassData
primClasses
, forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (forall a. ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
C.M_Prim_Coerce) Map (Qualified (ProperName 'ClassName)) TypeClassData
primCoerceClasses
, forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (forall a. ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
C.M_Prim_Row) Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowClasses
, forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (forall a. ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
C.M_Prim_RowList) Map (Qualified (ProperName 'ClassName)) TypeClassData
primRowListClasses
, forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (forall a. ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
C.M_Prim_Symbol) Map (Qualified (ProperName 'ClassName)) TypeClassData
primSymbolClasses
, forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (forall a. ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
C.M_Prim_Int) Map (Qualified (ProperName 'ClassName)) TypeClassData
primIntClasses
, forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (forall a. ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
C.M_Prim_TypeError) Map (Qualified (ProperName 'ClassName)) TypeClassData
primTypeErrorClasses
, forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([ExternsFile]
externs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ExternsFile{[DeclarationRef]
[ExternsDeclaration]
[ExternsTypeFixity]
[ExternsFixity]
[ExternsImport]
Text
SourceSpan
ModuleName
efSourceSpan :: ExternsFile -> SourceSpan
efDeclarations :: ExternsFile -> [ExternsDeclaration]
efTypeFixities :: ExternsFile -> [ExternsTypeFixity]
efFixities :: ExternsFile -> [ExternsFixity]
efImports :: ExternsFile -> [ExternsImport]
efExports :: ExternsFile -> [DeclarationRef]
efModuleName :: ExternsFile -> ModuleName
efVersion :: ExternsFile -> Text
efSourceSpan :: SourceSpan
efDeclarations :: [ExternsDeclaration]
efTypeFixities :: [ExternsTypeFixity]
efFixities :: [ExternsFixity]
efImports :: [ExternsImport]
efExports :: [DeclarationRef]
efModuleName :: ModuleName
efVersion :: Text
..} -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ModuleName
-> ExternsDeclaration
-> Maybe ((ModuleName, ProperName 'ClassName), TypeClassData)
fromExternsDecl ModuleName
efModuleName) [ExternsDeclaration]
efDeclarations)
]
fromExternsDecl
:: ModuleName
-> ExternsDeclaration
-> Maybe ((ModuleName, ProperName 'ClassName), TypeClassData)
fromExternsDecl :: ModuleName
-> ExternsDeclaration
-> Maybe ((ModuleName, ProperName 'ClassName), TypeClassData)
fromExternsDecl ModuleName
mn (EDClass ProperName 'ClassName
name [(Text, Maybe SourceType)]
args [(Ident, SourceType)]
members [SourceConstraint]
implies [FunctionalDependency]
deps Bool
tcIsEmpty) = forall a. a -> Maybe a
Just ((ModuleName
mn, ProperName 'ClassName
name), TypeClassData
typeClass) where
typeClass :: TypeClassData
typeClass = [(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData [(Text, Maybe SourceType)]
args [(Ident, SourceType)]
members [SourceConstraint]
implies [FunctionalDependency]
deps Bool
tcIsEmpty
fromExternsDecl ModuleName
_ ExternsDeclaration
_ = forall a. Maybe a
Nothing
desugarModule
:: (MonadSupply m, MonadError MultipleErrors m)
=> Module
-> Desugar m Module
desugarModule :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
Module -> Desugar m Module
desugarModule (Module SourceSpan
ss [Comment]
coms ModuleName
name [Declaration]
decls (Just [DeclarationRef]
exps)) = do
let ([Declaration]
classDecls, [Declaration]
restDecls) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Declaration -> Bool
isTypeClassDecl [Declaration]
decls
classVerts :: [(Declaration, Qualified (ProperName 'ClassName),
[Qualified (ProperName 'ClassName)])]
classVerts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Declaration
d -> (Declaration
d, Declaration -> Qualified (ProperName 'ClassName)
classDeclName Declaration
d, Declaration -> [Qualified (ProperName 'ClassName)]
superClassesNames Declaration
d)) [Declaration]
classDecls
([Maybe DeclarationRef]
classNewExpss, [[Declaration]]
classDeclss) <- forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU (forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp [(Declaration, Qualified (ProperName 'ClassName),
[Qualified (ProperName 'ClassName)])]
classVerts) (forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
ModuleName
-> [DeclarationRef]
-> SCC Declaration
-> Desugar m (Maybe DeclarationRef, [Declaration])
desugarClassDecl ModuleName
name [DeclarationRef]
exps)
([Maybe DeclarationRef]
restNewExpss, [[Declaration]]
restDeclss) <- forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
MonadError MultipleErrors m =>
[a] -> (a -> m b) -> m [b]
parU [Declaration]
restDecls (forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
ModuleName
-> [DeclarationRef]
-> Declaration
-> Desugar m (Maybe DeclarationRef, [Declaration])
desugarDecl ModuleName
name [DeclarationRef]
exps)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
Module SourceSpan
ss [Comment]
coms ModuleName
name (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
restDeclss forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration]]
classDeclss) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ([DeclarationRef]
exps forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe DeclarationRef]
restNewExpss forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe DeclarationRef]
classNewExpss)
where
desugarClassDecl :: (MonadSupply m, MonadError MultipleErrors m)
=> ModuleName
-> [DeclarationRef]
-> SCC Declaration
-> Desugar m (Maybe DeclarationRef, [Declaration])
desugarClassDecl :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
ModuleName
-> [DeclarationRef]
-> SCC Declaration
-> Desugar m (Maybe DeclarationRef, [Declaration])
desugarClassDecl ModuleName
name' [DeclarationRef]
exps' (AcyclicSCC Declaration
d) = forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
ModuleName
-> [DeclarationRef]
-> Declaration
-> Desugar m (Maybe DeclarationRef, [Declaration])
desugarDecl ModuleName
name' [DeclarationRef]
exps' Declaration
d
desugarClassDecl ModuleName
_ [DeclarationRef]
_ (CyclicSCC [Declaration]
ds')
| Just NonEmpty Declaration
ds'' <- forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Declaration]
ds' = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' (Declaration -> SourceSpan
declSourceSpan (forall a. NonEmpty a -> a
NEL.head NonEmpty Declaration
ds'')) forall a b. (a -> b) -> a -> b
$ NonEmpty (Qualified (ProperName 'ClassName)) -> SimpleErrorMessage
CycleInTypeClassDeclaration (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map Declaration -> Qualified (ProperName 'ClassName)
classDeclName NonEmpty Declaration
ds'')
| Bool
otherwise = forall a. HasCallStack => String -> a
internalError String
"desugarClassDecl: empty CyclicSCC"
superClassesNames :: Declaration -> [Qualified (ProperName 'ClassName)]
superClassesNames :: Declaration -> [Qualified (ProperName 'ClassName)]
superClassesNames (TypeClassDeclaration SourceAnn
_ ProperName 'ClassName
_ [(Text, Maybe SourceType)]
_ [SourceConstraint]
implies [FunctionalDependency]
_ [Declaration]
_) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourceConstraint -> Qualified (ProperName 'ClassName)
constraintName [SourceConstraint]
implies
superClassesNames Declaration
_ = []
constraintName :: SourceConstraint -> Qualified (ProperName 'ClassName)
constraintName :: SourceConstraint -> Qualified (ProperName 'ClassName)
constraintName (Constraint SourceAnn
_ Qualified (ProperName 'ClassName)
cName [SourceType]
_ [SourceType]
_ Maybe ConstraintData
_) = Qualified (ProperName 'ClassName)
cName
classDeclName :: Declaration -> Qualified (ProperName 'ClassName)
classDeclName :: Declaration -> Qualified (ProperName 'ClassName)
classDeclName (TypeClassDeclaration SourceAnn
_ ProperName 'ClassName
pn [(Text, Maybe SourceType)]
_ [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
_) = forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
name) ProperName 'ClassName
pn
classDeclName Declaration
_ = forall a. HasCallStack => String -> a
internalError String
"Expected TypeClassDeclaration"
desugarModule Module
_ = forall a. HasCallStack => String -> a
internalError String
"Exports should have been elaborated in name desugaring"
desugarDecl
:: (MonadSupply m, MonadError MultipleErrors m)
=> ModuleName
-> [DeclarationRef]
-> Declaration
-> Desugar m (Maybe DeclarationRef, [Declaration])
desugarDecl :: forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
ModuleName
-> [DeclarationRef]
-> Declaration
-> Desugar m (Maybe DeclarationRef, [Declaration])
desugarDecl ModuleName
mn [DeclarationRef]
exps = Declaration
-> StateT MemberMap m (Maybe DeclarationRef, [Declaration])
go
where
go :: Declaration
-> StateT MemberMap m (Maybe DeclarationRef, [Declaration])
go d :: Declaration
d@(TypeClassDeclaration SourceAnn
sa ProperName 'ClassName
name [(Text, Maybe SourceType)]
args [SourceConstraint]
implies [FunctionalDependency]
deps [Declaration]
members) = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (ModuleName
mn, ProperName 'ClassName
name) ([(Text, Maybe SourceType)]
-> [(Ident, SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> Bool
-> TypeClassData
makeTypeClassData [(Text, Maybe SourceType)]
args (forall a b. (a -> b) -> [a] -> [b]
map Declaration -> (Ident, SourceType)
memberToNameAndType [Declaration]
members) [SourceConstraint]
implies [FunctionalDependency]
deps Bool
False))
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, Declaration
d forall a. a -> [a] -> [a]
: SourceAnn
-> ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> [SourceConstraint]
-> [Declaration]
-> Declaration
typeClassDictionaryDeclaration SourceAnn
sa ProperName 'ClassName
name [(Text, Maybe SourceType)]
args [SourceConstraint]
implies [Declaration]
members forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (ModuleName
-> ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> Declaration
-> Declaration
typeClassMemberToDictionaryAccessor ModuleName
mn ProperName 'ClassName
name [(Text, Maybe SourceType)]
args) [Declaration]
members)
go (TypeInstanceDeclaration SourceAnn
sa SourceAnn
na ChainId
chainId Integer
idx Either Text Ident
name [SourceConstraint]
deps Qualified (ProperName 'ClassName)
className [SourceType]
tys TypeInstanceBody
body) = do
Ident
name' <- forall (m :: * -> *).
MonadSupply m =>
Either Text Ident -> Desugar m Ident
desugarInstName Either Text Ident
name
let d :: Declaration
d = SourceAnn
-> SourceAnn
-> ChainId
-> Integer
-> Either Text Ident
-> [SourceConstraint]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> TypeInstanceBody
-> Declaration
TypeInstanceDeclaration SourceAnn
sa SourceAnn
na ChainId
chainId Integer
idx (forall a b. b -> Either a b
Right Ident
name') [SourceConstraint]
deps Qualified (ProperName 'ClassName)
className [SourceType]
tys TypeInstanceBody
body
let explicitOrNot :: Either Expr [Declaration]
explicitOrNot = case TypeInstanceBody
body of
TypeInstanceBody
DerivedInstance -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Qualified (ProperName 'ClassName)
-> InstanceDerivationStrategy -> Expr
DerivedInstancePlaceholder Qualified (ProperName 'ClassName)
className InstanceDerivationStrategy
KnownClassStrategy
TypeInstanceBody
NewtypeInstance -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Qualified (ProperName 'ClassName)
-> InstanceDerivationStrategy -> Expr
DerivedInstancePlaceholder Qualified (ProperName 'ClassName)
className InstanceDerivationStrategy
NewtypeStrategy
ExplicitInstance [Declaration]
members -> forall a b. b -> Either a b
Right [Declaration]
members
Declaration
dictDecl <- case Either Expr [Declaration]
explicitOrNot of
Right [Declaration]
members
| Qualified (ProperName 'ClassName)
className forall a. Eq a => a -> a -> Bool
== Qualified (ProperName 'ClassName)
C.Coercible ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' (forall a b. (a, b) -> a
fst SourceAnn
sa) forall a b. (a -> b) -> a -> b
$ [SourceType] -> SimpleErrorMessage
InvalidCoercibleInstanceDeclaration [SourceType]
tys
| Bool
otherwise -> do
[Declaration]
desugared <- forall (m :: * -> *).
(MonadSupply m, MonadError MultipleErrors m) =>
[Declaration] -> m [Declaration]
desugarCases [Declaration]
members
forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceAnn
-> Ident
-> ModuleName
-> [SourceConstraint]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> [Declaration]
-> Desugar m Declaration
typeInstanceDictionaryDeclaration SourceAnn
sa Ident
name' ModuleName
mn [SourceConstraint]
deps Qualified (ProperName 'ClassName)
className [SourceType]
tys [Declaration]
desugared
Left Expr
dict ->
let
dictTy :: SourceType
dictTy = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SourceType -> SourceType -> SourceType
srcTypeApp (Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName) Qualified (ProperName 'ClassName)
className)) [SourceType]
tys
constrainedTy :: SourceType
constrainedTy = forall a. Type a -> Type a
quantify (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SourceConstraint -> SourceType -> SourceType
srcConstrainedType SourceType
dictTy [SourceConstraint]
deps)
in
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl SourceAnn
sa Ident
name' NameKind
Private [] [Expr -> GuardedExpr
MkUnguarded (Bool -> Expr -> SourceType -> Expr
TypedValue Bool
True Expr
dict SourceType
constrainedTy)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> Maybe DeclarationRef
expRef Ident
name' Qualified (ProperName 'ClassName)
className [SourceType]
tys, [Declaration
d, Declaration
dictDecl])
go Declaration
other = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, [Declaration
other])
desugarInstName :: MonadSupply m => Either Text Ident -> Desugar m Ident
desugarInstName :: forall (m :: * -> *).
MonadSupply m =>
Either Text Ident -> Desugar m Ident
desugarInstName = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *). MonadSupply m => Text -> m Ident
freshIdent forall (f :: * -> *) a. Applicative f => a -> f a
pure
expRef :: Ident -> Qualified (ProperName 'ClassName) -> [SourceType] -> Maybe DeclarationRef
expRef :: Ident
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> Maybe DeclarationRef
expRef Ident
name Qualified (ProperName 'ClassName)
className [SourceType]
tys
| Qualified (ProperName 'ClassName) -> Bool
isExportedClass Qualified (ProperName 'ClassName)
className Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Qualified (ProperName 'TypeName) -> Bool
isExportedType (SourceType -> [Qualified (ProperName 'TypeName)]
getConstructors forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
`concatMap` [SourceType]
tys) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SourceSpan -> Ident -> NameSource -> DeclarationRef
TypeInstanceRef SourceSpan
genSpan Ident
name NameSource
UserNamed
| Bool
otherwise = forall a. Maybe a
Nothing
isExportedClass :: Qualified (ProperName 'ClassName) -> Bool
isExportedClass :: Qualified (ProperName 'ClassName) -> Bool
isExportedClass = forall (a :: ProperNameType).
(ProperName a -> [DeclarationRef] -> Bool)
-> Qualified (ProperName a) -> Bool
isExported (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> ProperName 'ClassName -> DeclarationRef
TypeClassRef SourceSpan
genSpan)
isExportedType :: Qualified (ProperName 'TypeName) -> Bool
isExportedType :: Qualified (ProperName 'TypeName) -> Bool
isExportedType = forall (a :: ProperNameType).
(ProperName a -> [DeclarationRef] -> Bool)
-> Qualified (ProperName a) -> Bool
isExported forall a b. (a -> b) -> a -> b
$ \ProperName 'TypeName
pn -> forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ProperName 'TypeName -> DeclarationRef -> Bool
matchesTypeRef ProperName 'TypeName
pn)
isExported
:: (ProperName a -> [DeclarationRef] -> Bool)
-> Qualified (ProperName a)
-> Bool
isExported :: forall (a :: ProperNameType).
(ProperName a -> [DeclarationRef] -> Bool)
-> Qualified (ProperName a) -> Bool
isExported ProperName a -> [DeclarationRef] -> Bool
test (Qualified (ByModuleName ModuleName
mn') ProperName a
pn) = ModuleName
mn forall a. Eq a => a -> a -> Bool
/= ModuleName
mn' Bool -> Bool -> Bool
|| ProperName a -> [DeclarationRef] -> Bool
test ProperName a
pn [DeclarationRef]
exps
isExported ProperName a -> [DeclarationRef] -> Bool
_ Qualified (ProperName a)
_ = forall a. HasCallStack => String -> a
internalError String
"Names should have been qualified in name desugaring"
matchesTypeRef :: ProperName 'TypeName -> DeclarationRef -> Bool
matchesTypeRef :: ProperName 'TypeName -> DeclarationRef -> Bool
matchesTypeRef ProperName 'TypeName
pn (TypeRef SourceSpan
_ ProperName 'TypeName
pn' Maybe [ProperName 'ConstructorName]
_) = ProperName 'TypeName
pn forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
pn'
matchesTypeRef ProperName 'TypeName
_ DeclarationRef
_ = Bool
False
getConstructors :: SourceType -> [Qualified (ProperName 'TypeName)]
getConstructors :: SourceType -> [Qualified (ProperName 'TypeName)]
getConstructors = forall r a. (r -> r -> r) -> (Type a -> r) -> Type a -> r
everythingOnTypes forall a. [a] -> [a] -> [a]
(++) forall {a}. Type a -> [Qualified (ProperName 'TypeName)]
getConstructor
where
getConstructor :: Type a -> [Qualified (ProperName 'TypeName)]
getConstructor (TypeConstructor a
_ Qualified (ProperName 'TypeName)
tcname) = [Qualified (ProperName 'TypeName)
tcname]
getConstructor Type a
_ = []
genSpan :: SourceSpan
genSpan :: SourceSpan
genSpan = String -> SourceSpan
internalModuleSourceSpan String
"<generated>"
memberToNameAndType :: Declaration -> (Ident, SourceType)
memberToNameAndType :: Declaration -> (Ident, SourceType)
memberToNameAndType (TypeDeclaration TypeDeclarationData
td) = TypeDeclarationData -> (Ident, SourceType)
unwrapTypeDeclaration TypeDeclarationData
td
memberToNameAndType Declaration
_ = forall a. HasCallStack => String -> a
internalError String
"Invalid declaration in type class definition"
typeClassDictionaryDeclaration
:: SourceAnn
-> ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> [SourceConstraint]
-> [Declaration]
-> Declaration
typeClassDictionaryDeclaration :: SourceAnn
-> ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> [SourceConstraint]
-> [Declaration]
-> Declaration
typeClassDictionaryDeclaration SourceAnn
sa ProperName 'ClassName
name [(Text, Maybe SourceType)]
args [SourceConstraint]
implies [Declaration]
members =
let superclassTypes :: [(Text, SourceType)]
superclassTypes = forall a. [Constraint a] -> [Text]
superClassDictionaryNames [SourceConstraint]
implies forall a b. [a] -> [b] -> [(a, b)]
`zip`
[ SourceType -> SourceType -> SourceType
function SourceType
unit (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SourceType -> SourceType -> SourceType
srcTypeApp (Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName) Qualified (ProperName 'ClassName)
superclass)) [SourceType]
tyArgs)
| (Constraint SourceAnn
_ Qualified (ProperName 'ClassName)
superclass [SourceType]
_ [SourceType]
tyArgs Maybe ConstraintData
_) <- [SourceConstraint]
implies
]
members' :: [(Text, SourceType)]
members' = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Ident -> Text
runIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> (Ident, SourceType)
memberToNameAndType) [Declaration]
members
mtys :: [(Text, SourceType)]
mtys = [(Text, SourceType)]
members' forall a. [a] -> [a] -> [a]
++ [(Text, SourceType)]
superclassTypes
toRowListItem :: (Text, SourceType) -> RowListItem SourceAnn
toRowListItem (Text
l, SourceType
t) = Label -> SourceType -> RowListItem SourceAnn
srcRowListItem (PSString -> Label
Label forall a b. (a -> b) -> a -> b
$ Text -> PSString
mkString Text
l) SourceType
t
ctor :: DataConstructorDeclaration
ctor = SourceAnn
-> ProperName 'ConstructorName
-> [(Ident, SourceType)]
-> DataConstructorDeclaration
DataConstructorDeclaration SourceAnn
sa (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall a b. (a -> b) -> a -> b
$ forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName ProperName 'ClassName
name)
[(Text -> Ident
Ident Text
"dict", SourceType -> SourceType -> SourceType
srcTypeApp SourceType
tyRecord forall a b. (a -> b) -> a -> b
$ forall a. ([RowListItem a], Type a) -> Type a
rowFromList (forall a b. (a -> b) -> [a] -> [b]
map (Text, SourceType) -> RowListItem SourceAnn
toRowListItem [(Text, SourceType)]
mtys, SourceType
srcREmpty))]
in SourceAnn
-> DataDeclType
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> [DataConstructorDeclaration]
-> Declaration
DataDeclaration SourceAnn
sa DataDeclType
Newtype (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall a b. (a -> b) -> a -> b
$ forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName ProperName 'ClassName
name) [(Text, Maybe SourceType)]
args [DataConstructorDeclaration
ctor]
typeClassMemberToDictionaryAccessor
:: ModuleName
-> ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> Declaration
-> Declaration
typeClassMemberToDictionaryAccessor :: ModuleName
-> ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> Declaration
-> Declaration
typeClassMemberToDictionaryAccessor ModuleName
mn ProperName 'ClassName
name [(Text, Maybe SourceType)]
args (TypeDeclaration (TypeDeclarationData sa :: SourceAnn
sa@(SourceSpan
ss, [Comment]
_) Ident
ident SourceType
ty)) =
let className :: Qualified (ProperName 'ClassName)
className = forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'ClassName
name
dictIdent :: Ident
dictIdent = Text -> Ident
Ident Text
"dict"
dictObjIdent :: Ident
dictObjIdent = Text -> Ident
Ident Text
"v"
ctor :: Binder
ctor = SourceSpan
-> Qualified (ProperName 'ConstructorName) -> [Binder] -> Binder
ConstructorBinder SourceSpan
ss (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified (ProperName 'ClassName)
className) [SourceSpan -> Ident -> Binder
VarBinder SourceSpan
ss Ident
dictObjIdent]
acsr :: Expr
acsr = PSString -> Expr -> Expr
Accessor (Text -> PSString
mkString forall a b. (a -> b) -> a -> b
$ Ident -> Text
runIdent Ident
ident) (SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
ss (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos Ident
dictObjIdent))
in SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl SourceAnn
sa Ident
ident NameKind
Private []
[Expr -> GuardedExpr
MkUnguarded (
Bool -> Expr -> SourceType -> Expr
TypedValue Bool
False (Binder -> Expr -> Expr
Abs (SourceSpan -> Ident -> Binder
VarBinder SourceSpan
ss Ident
dictIdent) ([Expr] -> [CaseAlternative] -> Expr
Case [SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
ss forall a b. (a -> b) -> a -> b
$ forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos Ident
dictIdent] [[Binder] -> [GuardedExpr] -> CaseAlternative
CaseAlternative [Binder
ctor] [Expr -> GuardedExpr
MkUnguarded Expr
acsr]])) forall a b. (a -> b) -> a -> b
$
forall a. Type a -> Type a
moveQuantifiersToFront (forall a. Type a -> Type a
quantify (SourceConstraint -> SourceType -> SourceType
srcConstrainedType (Qualified (ProperName 'ClassName)
-> [SourceType]
-> [SourceType]
-> Maybe ConstraintData
-> SourceConstraint
srcConstraint Qualified (ProperName 'ClassName)
className [] (forall a b. (a -> b) -> [a] -> [b]
map (Text -> SourceType
srcTypeVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Maybe SourceType)]
args) forall a. Maybe a
Nothing) SourceType
ty))
)]
typeClassMemberToDictionaryAccessor ModuleName
_ ProperName 'ClassName
_ [(Text, Maybe SourceType)]
_ Declaration
_ = forall a. HasCallStack => String -> a
internalError String
"Invalid declaration in type class definition"
unit :: SourceType
unit :: SourceType
unit = SourceType -> SourceType -> SourceType
srcTypeApp SourceType
tyRecord SourceType
srcREmpty
typeInstanceDictionaryDeclaration
:: forall m
. MonadError MultipleErrors m
=> SourceAnn
-> Ident
-> ModuleName
-> [SourceConstraint]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> [Declaration]
-> Desugar m Declaration
typeInstanceDictionaryDeclaration :: forall (m :: * -> *).
MonadError MultipleErrors m =>
SourceAnn
-> Ident
-> ModuleName
-> [SourceConstraint]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> [Declaration]
-> Desugar m Declaration
typeInstanceDictionaryDeclaration sa :: SourceAnn
sa@(SourceSpan
ss, [Comment]
_) Ident
name ModuleName
mn [SourceConstraint]
deps Qualified (ProperName 'ClassName)
className [SourceType]
tys [Declaration]
decls =
forall e (m :: * -> *) a. MonadError e m => (e -> e) -> m a -> m a
rethrow (ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (Qualified (ProperName 'ClassName)
-> [SourceType] -> ErrorMessageHint
ErrorInInstance Qualified (ProperName 'ClassName)
className [SourceType]
tys)) forall a b. (a -> b) -> a -> b
$ do
MemberMap
m <- forall s (m :: * -> *). MonadState s m => m s
get
TypeClassData{Bool
[(Text, Maybe SourceType)]
[(Ident, SourceType)]
[SourceConstraint]
[FunctionalDependency]
Set Int
Set (Set Int)
typeClassIsEmpty :: TypeClassData -> Bool
typeClassCoveringSets :: TypeClassData -> Set (Set Int)
typeClassDeterminedArguments :: TypeClassData -> Set Int
typeClassDependencies :: TypeClassData -> [FunctionalDependency]
typeClassSuperclasses :: TypeClassData -> [SourceConstraint]
typeClassMembers :: TypeClassData -> [(Ident, SourceType)]
typeClassArguments :: TypeClassData -> [(Text, Maybe SourceType)]
typeClassIsEmpty :: Bool
typeClassCoveringSets :: Set (Set Int)
typeClassDeterminedArguments :: Set Int
typeClassDependencies :: [FunctionalDependency]
typeClassSuperclasses :: [SourceConstraint]
typeClassMembers :: [(Ident, SourceType)]
typeClassArguments :: [(Text, Maybe SourceType)]
..} <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualified Name -> SimpleErrorMessage
UnknownName forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProperName 'ClassName -> Name
TyClassName Qualified (ProperName 'ClassName)
className) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. ModuleName -> Qualified a -> (ModuleName, a)
qualify ModuleName
mn Qualified (ProperName 'ClassName)
className) MemberMap
m
let memberTypes :: [(Ident, SourceType)]
memberTypes = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a. [(Text, Type a)] -> Type a -> Type a
replaceAllTypeVars (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Text, Maybe SourceType)]
typeClassArguments) [SourceType]
tys))) [(Ident, SourceType)]
typeClassMembers
let declaredMembers :: Set Ident
declaredMembers = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Declaration -> Maybe Ident
declIdent [Declaration]
decls
case forall a. (a -> Bool) -> [a] -> [a]
filter (\(Ident
ident, SourceType
_) -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Bool
S.member Ident
ident Set Ident
declaredMembers) [(Ident, SourceType)]
memberTypes of
(Ident, SourceType)
hd : [(Ident, SourceType)]
tl -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall a b. (a -> b) -> a -> b
$ NonEmpty (Ident, SourceType) -> SimpleErrorMessage
MissingClassMember ((Ident, SourceType)
hd forall a. a -> [a] -> NonEmpty a
NEL.:| [(Ident, SourceType)]
tl)
[] -> do
[(Text, Expr)]
members <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Declaration -> Text
typeClassMemberName [Declaration]
decls) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([(Ident, SourceType)] -> Declaration -> Desugar m Expr
memberToValue [(Ident, SourceType)]
memberTypes) [Declaration]
decls
[Expr]
superclassesDicts <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [SourceConstraint]
typeClassSuperclasses forall a b. (a -> b) -> a -> b
$ \(Constraint SourceAnn
_ Qualified (ProperName 'ClassName)
superclass [SourceType]
_ [SourceType]
suTyArgs Maybe ConstraintData
_) -> do
let tyArgs :: [SourceType]
tyArgs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [(Text, Type a)] -> Type a -> Type a
replaceAllTypeVars (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Text, Maybe SourceType)]
typeClassArguments) [SourceType]
tys)) [SourceType]
suTyArgs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Binder -> Expr -> Expr
Abs (SourceSpan -> Ident -> Binder
VarBinder SourceSpan
ss Ident
UnusedIdent) (Qualified (ProperName 'ClassName) -> [SourceType] -> Expr
DeferredDictionary Qualified (ProperName 'ClassName)
superclass [SourceType]
tyArgs)
let superclasses :: [(Text, Expr)]
superclasses = forall a. [Constraint a] -> [Text]
superClassDictionaryNames [SourceConstraint]
typeClassSuperclasses forall a b. [a] -> [b] -> [(a, b)]
`zip` [Expr]
superclassesDicts
let props :: Expr
props = SourceSpan -> Literal Expr -> Expr
Literal SourceSpan
ss forall a b. (a -> b) -> a -> b
$ forall a. [(PSString, a)] -> Literal a
ObjectLiteral forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> PSString
mkString) ([(Text, Expr)]
members forall a. [a] -> [a] -> [a]
++ [(Text, Expr)]
superclasses)
dictTy :: SourceType
dictTy = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SourceType -> SourceType -> SourceType
srcTypeApp (Qualified (ProperName 'TypeName) -> SourceType
srcTypeConstructor (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName) Qualified (ProperName 'ClassName)
className)) [SourceType]
tys
constrainedTy :: SourceType
constrainedTy = forall a. Type a -> Type a
quantify (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SourceConstraint -> SourceType -> SourceType
srcConstrainedType SourceType
dictTy [SourceConstraint]
deps)
dict :: Expr
dict = Expr -> Expr -> Expr
App (SourceSpan -> Qualified (ProperName 'ConstructorName) -> Expr
Constructor SourceSpan
ss (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
coerceProperName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> ProperName a
dictTypeName) Qualified (ProperName 'ClassName)
className)) Expr
props
result :: Declaration
result = SourceAnn
-> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
ValueDecl SourceAnn
sa Ident
name NameKind
Private [] [Expr -> GuardedExpr
MkUnguarded (Bool -> Expr -> SourceType -> Expr
TypedValue Bool
True Expr
dict SourceType
constrainedTy)]
forall (m :: * -> *) a. Monad m => a -> m a
return Declaration
result
where
memberToValue :: [(Ident, SourceType)] -> Declaration -> Desugar m Expr
memberToValue :: [(Ident, SourceType)] -> Declaration -> Desugar m Expr
memberToValue [(Ident, SourceType)]
tys' (ValueDecl (SourceSpan
ss', [Comment]
_) Ident
ident NameKind
_ [] [MkUnguarded Expr
val]) = do
SourceType
_ <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss' forall a b. (a -> b) -> a -> b
$ Ident -> Qualified (ProperName 'ClassName) -> SimpleErrorMessage
ExtraneousClassMember Ident
ident Qualified (ProperName 'ClassName)
className) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Ident
ident [(Ident, SourceType)]
tys'
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
val
memberToValue [(Ident, SourceType)]
_ Declaration
_ = forall a. HasCallStack => String -> a
internalError String
"Invalid declaration in type instance definition"
declIdent :: Declaration -> Maybe Ident
declIdent :: Declaration -> Maybe Ident
declIdent (ValueDeclaration ValueDeclarationData [GuardedExpr]
vd) = forall a. a -> Maybe a
Just (forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData [GuardedExpr]
vd)
declIdent (TypeDeclaration TypeDeclarationData
td) = forall a. a -> Maybe a
Just (TypeDeclarationData -> Ident
tydeclIdent TypeDeclarationData
td)
declIdent Declaration
_ = forall a. Maybe a
Nothing
typeClassMemberName :: Declaration -> Text
typeClassMemberName :: Declaration -> Text
typeClassMemberName = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
internalError String
"typeClassMemberName: Invalid declaration in type class definition") Ident -> Text
runIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Maybe Ident
declIdent
superClassDictionaryNames :: [Constraint a] -> [Text]
superClassDictionaryNames :: forall a. [Constraint a] -> [Text]
superClassDictionaryNames [Constraint a]
supers =
[ Qualified (ProperName 'ClassName) -> Integer -> Text
superclassName Qualified (ProperName 'ClassName)
pn Integer
index
| (Integer
index, Constraint a
_ Qualified (ProperName 'ClassName)
pn [Type a]
_ [Type a]
_ Maybe ConstraintData
_) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] [Constraint a]
supers
]