module ProjectM36.DataTypes.Either where import ProjectM36.Base import ProjectM36.AtomFunction import ProjectM36.AtomFunctionError import qualified Data.HashSet as HS import qualified Data.Map as M eitherAtomType :: AtomType -> AtomType -> AtomType eitherAtomType :: AtomType -> AtomType -> AtomType eitherAtomType AtomType tA AtomType tB = TypeConstructorName -> TypeVarMap -> AtomType ConstructedAtomType TypeConstructorName "Either" (forall k a. Ord k => [(k, a)] -> Map k a M.fromList [(TypeConstructorName "a", AtomType tA), (TypeConstructorName "b", AtomType tB)]) eitherTypeConstructorMapping :: TypeConstructorMapping eitherTypeConstructorMapping :: TypeConstructorMapping eitherTypeConstructorMapping = [(TypeConstructorName -> [TypeConstructorName] -> TypeConstructorDef ADTypeConstructorDef TypeConstructorName "Either" [TypeConstructorName "a", TypeConstructorName "b"], [TypeConstructorName -> [DataConstructorDefArg] -> DataConstructorDef DataConstructorDef TypeConstructorName "Left" [TypeConstructorName -> DataConstructorDefArg DataConstructorDefTypeVarNameArg TypeConstructorName "a"], TypeConstructorName -> [DataConstructorDefArg] -> DataConstructorDef DataConstructorDef TypeConstructorName "Right" [TypeConstructorName -> DataConstructorDefArg DataConstructorDefTypeVarNameArg TypeConstructorName "b"]])] eitherAtomFunctions :: AtomFunctions eitherAtomFunctions :: AtomFunctions eitherAtomFunctions = forall a. (Eq a, Hashable a) => [a] -> HashSet a HS.fromList [ TypeConstructorName -> [AtomType] -> AtomFunctionBodyType -> AtomFunction compiledAtomFunction TypeConstructorName "isLeft" [AtomType -> AtomType -> AtomType eitherAtomType (TypeConstructorName -> AtomType TypeVariableType TypeConstructorName "a") (TypeConstructorName -> AtomType TypeVariableType TypeConstructorName "b"), AtomType BoolAtomType] forall a b. (a -> b) -> a -> b $ \case (ConstructedAtom TypeConstructorName dConsName AtomType _ [Atom] _:[Atom] _) -> forall (f :: * -> *) a. Applicative f => a -> f a pure (Bool -> Atom BoolAtom (TypeConstructorName dConsName forall a. Eq a => a -> a -> Bool == TypeConstructorName "Left")) [Atom] _ -> forall a b. a -> Either a b Left AtomFunctionError AtomFunctionTypeMismatchError ]