module ProjectM36.DataConstructorDef where
import ProjectM36.Base as B
import qualified Data.Set as S

emptyDataConstructor :: DataConstructorName -> DataConstructorDef
emptyDataConstructor :: TypeVarName -> DataConstructorDef
emptyDataConstructor TypeVarName
name' = TypeVarName -> [DataConstructorDefArg] -> DataConstructorDef
DataConstructorDef TypeVarName
name' []

name :: DataConstructorDef -> DataConstructorName
name :: DataConstructorDef -> TypeVarName
name (DataConstructorDef TypeVarName
name' [DataConstructorDefArg]
_) = TypeVarName
name'

fields :: DataConstructorDef -> [DataConstructorDefArg]
fields :: DataConstructorDef -> [DataConstructorDefArg]
fields (DataConstructorDef TypeVarName
_ [DataConstructorDefArg]
args) = [DataConstructorDefArg]
args

typeVars :: DataConstructorDef -> S.Set TypeVarName
typeVars :: DataConstructorDef -> Set TypeVarName
typeVars (DataConstructorDef TypeVarName
_ [DataConstructorDefArg]
tConsArgs) = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DataConstructorDefArg -> Set TypeVarName
typeVarsInDefArg [DataConstructorDefArg]
tConsArgs

typeVarsInDefArg :: DataConstructorDefArg -> S.Set TypeVarName
typeVarsInDefArg :: DataConstructorDefArg -> Set TypeVarName
typeVarsInDefArg (DataConstructorDefTypeConstructorArg TypeConstructor
tCons) = TypeConstructor -> Set TypeVarName
B.typeVars TypeConstructor
tCons
typeVarsInDefArg (DataConstructorDefTypeVarNameArg TypeVarName
pVarName) = forall a. a -> Set a
S.singleton TypeVarName
pVarName