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
  ]