{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Inferno.Module.Cast where
import Control.Monad.Except (MonadError (..))
import Control.Monad.Reader (ask)
import Data.Int (Int64)
import qualified Data.Map as Map
import Data.Proxy (Proxy (..))
import qualified Data.Set as Set
import Data.Text (Text, pack, unpack)
import Data.Typeable (Typeable, typeRep)
import Data.Word (Word16, Word32, Word64)
import Foreign.C.Types (CTime (..))
import GHC.TypeLits (KnownSymbol, symbolVal)
import Inferno.Eval.Error (EvalError (CastError, NotFoundInImplicitEnv))
import Inferno.Module.Builtin (enumBoolHash)
import Inferno.Types.Syntax (ExtIdent (..), Lit (..), TList (..))
import Inferno.Types.Type (BaseType (..), InfernoType (..))
import Inferno.Types.Value (ImplEnvM, ImplicitCast (..), Value (..))
import Inferno.Utils.Prettyprinter (renderPretty)
import Prettyprinter (Pretty)
type Either3 a b c = Either a (Either b c)
type Either4 a b c d = Either a (Either3 b c d)
type Either5 a b c d e = Either a (Either4 b c d e)
type Either6 a b c d e f = Either a (Either5 b c d e f)
type Either7 a b c d e f g = Either a (Either6 b c d e f g)
class ToValue c m a where
toValue :: MonadError EvalError m => a -> m (Value c m)
class FromValue c m a where
fromValue :: MonadError EvalError m => (Value c m) -> m a
class Kind0 a where
toType :: Proxy a -> InfernoType
couldNotCast :: forall c m a. (Pretty c, MonadError EvalError m, Typeable a) => Value c m -> m a
couldNotCast :: forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v =
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
String -> EvalError
CastError forall a b. (a -> b) -> a -> b
$
String
"Could not cast value " forall a. Semigroup a => a -> a -> a
<> (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Text
renderPretty Value c m
v)
forall a. Semigroup a => a -> a -> a
<> String
" to "
forall a. Semigroup a => a -> a -> a
<> (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
instance ToValue c m (m (Value c m)) where
toValue :: MonadError EvalError m => m (Value c m) -> m (Value c m)
toValue = forall a. a -> a
id
instance ToValue c m (Value c m) where
toValue :: MonadError EvalError m => Value c m -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromValue c m (Value c m) where
fromValue :: MonadError EvalError m => Value c m -> m (Value c m)
fromValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance ToValue c m Lit where
toValue :: MonadError EvalError m => Lit -> m (Value c m)
toValue Lit
l = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Lit
l of
LInt Int64
i -> forall custom (m :: * -> *). Int64 -> Value custom m
VInt Int64
i
LDouble Double
x -> forall custom (m :: * -> *). Double -> Value custom m
VDouble Double
x
LText Text
t -> forall custom (m :: * -> *). Text -> Value custom m
VText Text
t
LHex Word64
w -> forall custom (m :: * -> *). Word64 -> Value custom m
VWord64 Word64
w
instance ToValue c m Bool where
toValue :: MonadError EvalError m => Bool -> m (Value c m)
toValue Bool
True = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *).
VCObjectHash -> Ident -> Value custom m
VEnum VCObjectHash
enumBoolHash Ident
"true"
toValue Bool
False = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *).
VCObjectHash -> Ident -> Value custom m
VEnum VCObjectHash
enumBoolHash Ident
"false"
instance Pretty c => FromValue c m Bool where
fromValue :: MonadError EvalError m => Value c m -> m Bool
fromValue (VEnum VCObjectHash
hash Ident
ident) =
if VCObjectHash
hash forall a. Eq a => a -> a -> Bool
== VCObjectHash
enumBoolHash
then
if Ident
ident forall a. Eq a => a -> a -> Bool
== Ident
"true"
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast forall a b. (a -> b) -> a -> b
$ (forall custom (m :: * -> *).
VCObjectHash -> Ident -> Value custom m
VEnum VCObjectHash
hash Ident
ident :: Value c m)
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m Double where
toValue :: MonadError EvalError m => Double -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Double -> Value custom m
VDouble
instance Pretty c => FromValue c m Double where
fromValue :: MonadError EvalError m => Value c m -> m Double
fromValue (VDouble Double
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
x
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m Int64 where
toValue :: MonadError EvalError m => Int64 -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Int64 -> Value custom m
VInt
instance Pretty c => FromValue c m Int64 where
fromValue :: MonadError EvalError m => Value c m -> m Int64
fromValue (VInt Int64
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
x
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m Int where
toValue :: MonadError EvalError m => Int -> m (Value c m)
toValue = forall c (m :: * -> *) a.
(ToValue c m a, MonadError EvalError m) =>
a -> m (Value c m)
toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Int64)
instance Pretty c => FromValue c m Int where
fromValue :: MonadError EvalError m => Value c m -> m Int
fromValue Value c m
v = do
Int64
i <- forall c (m :: * -> *) a.
(FromValue c m a, MonadError EvalError m) =>
Value c m -> m a
fromValue Value c m
v forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\EvalError
_ -> forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v)
if (Int64
i :: Int64) forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int) Bool -> Bool -> Bool
|| Int64
i forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
then forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
instance ToValue c m Integer where
toValue :: MonadError EvalError m => Integer -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Int64 -> Value custom m
VInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
instance Pretty c => FromValue c m Integer where
fromValue :: MonadError EvalError m => Value c m -> m Integer
fromValue (VInt Int64
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m Word16 where
toValue :: MonadError EvalError m => Word16 -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Word16 -> Value custom m
VWord16
instance Pretty c => FromValue c m Word16 where
fromValue :: MonadError EvalError m => Value c m -> m Word16
fromValue (VWord16 Word16
w) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
w
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m Word32 where
toValue :: MonadError EvalError m => Word32 -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Word32 -> Value custom m
VWord32
instance Pretty c => FromValue c m Word32 where
fromValue :: MonadError EvalError m => Value c m -> m Word32
fromValue (VWord32 Word32
w) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
w
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m Word64 where
toValue :: MonadError EvalError m => Word64 -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Word64 -> Value custom m
VWord64
instance Pretty c => FromValue c m Word64 where
fromValue :: MonadError EvalError m => Value c m -> m Word64
fromValue (VWord64 Word64
w) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
w
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m () where
toValue :: MonadError EvalError m => () -> m (Value c m)
toValue ()
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall custom (m :: * -> *). [Value custom m] -> Value custom m
VTuple []
instance Pretty c => FromValue c m () where
fromValue :: MonadError EvalError m => Value c m -> m ()
fromValue (VTuple []) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m CTime where
toValue :: MonadError EvalError m => CTime -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). CTime -> Value custom m
VEpochTime
instance Pretty c => FromValue c m CTime where
fromValue :: MonadError EvalError m => Value c m -> m CTime
fromValue (VEpochTime CTime
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure CTime
t
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance ToValue c m Text where
toValue :: MonadError EvalError m => Text -> m (Value c m)
toValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall custom (m :: * -> *). Text -> Value custom m
VText
instance Pretty c => FromValue c m Text where
fromValue :: MonadError EvalError m => Value c m -> m Text
fromValue (VText Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance Kind0 Bool where
toType :: Proxy Bool -> InfernoType
toType Proxy Bool
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ Text -> Set Ident -> BaseType
TEnum Text
"bool" forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [Ident
"true", Ident
"false"]
instance Kind0 Float where
toType :: Proxy Float -> InfernoType
toType Proxy Float
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TDouble
instance Kind0 Double where
toType :: Proxy Double -> InfernoType
toType Proxy Double
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TDouble
instance Kind0 Int where
toType :: Proxy Int -> InfernoType
toType Proxy Int
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TInt
instance Kind0 Int64 where
toType :: Proxy Int64 -> InfernoType
toType Proxy Int64
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TInt
instance Kind0 Integer where
toType :: Proxy Integer -> InfernoType
toType Proxy Integer
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TInt
instance Kind0 Word16 where
toType :: Proxy Word16 -> InfernoType
toType Proxy Word16
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TWord16
instance Kind0 Word32 where
toType :: Proxy Word32 -> InfernoType
toType Proxy Word32
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TWord32
instance Kind0 Word64 where
toType :: Proxy Word64 -> InfernoType
toType Proxy Word64
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TWord64
instance Kind0 () where
toType :: Proxy () -> InfernoType
toType Proxy ()
_ = TList InfernoType -> InfernoType
TTuple forall a. TList a
TNil
instance Kind0 CTime where
toType :: Proxy CTime -> InfernoType
toType Proxy CTime
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TTime
instance Kind0 Text where
toType :: Proxy Text -> InfernoType
toType Proxy Text
_ = BaseType -> InfernoType
TBase forall a b. (a -> b) -> a -> b
$ BaseType
TText
instance (Kind0 a, Kind0 b) => Kind0 (a -> b) where
toType :: Proxy (a -> b) -> InfernoType
toType Proxy (a -> b)
_ = InfernoType -> InfernoType -> InfernoType
TArr (forall a. Kind0 a => Proxy a -> InfernoType
toType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) (forall a. Kind0 a => Proxy a -> InfernoType
toType (forall {k} (t :: k). Proxy t
Proxy :: Proxy b))
instance (Kind0 a) => Kind0 [a] where
toType :: Proxy [a] -> InfernoType
toType Proxy [a]
_ = InfernoType -> InfernoType
TArray (forall a. Kind0 a => Proxy a -> InfernoType
toType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
instance (FromValue c m a, ToValue c m b) => ToValue c m (a -> b) where
toValue :: MonadError EvalError m => (a -> b) -> m (Value c m)
toValue a -> b
f = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall custom (m :: * -> *).
(Value custom m -> m (Value custom m)) -> Value custom m
VFun forall a b. (a -> b) -> a -> b
$ \Value c m
v -> do
a
x <- forall c (m :: * -> *) a.
(FromValue c m a, MonadError EvalError m) =>
Value c m -> m a
fromValue Value c m
v
forall c (m :: * -> *) a.
(ToValue c m a, MonadError EvalError m) =>
a -> m (Value c m)
toValue forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
instance (Monad m, FromValue c (ImplEnvM m c) a1, FromValue c (ImplEnvM m c) a2, ToValue c (ImplEnvM m c) a3, KnownSymbol lbl) => ToValue c (ImplEnvM m c) (ImplicitCast lbl a1 a2 a3) where
toValue :: MonadError EvalError (ImplEnvM m c) =>
ImplicitCast lbl a1 a2 a3 -> ImplEnvM m c (Value c (ImplEnvM m c))
toValue (ImplicitCast a1 -> a2 -> a3
f) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall custom (m :: * -> *).
(Value custom m -> m (Value custom m)) -> Value custom m
VFun forall a b. (a -> b) -> a -> b
$ \Value c (ImplEnvM m c)
b' -> do
Map ExtIdent (Value c (ImplEnvM m c))
impl <- forall r (m :: * -> *). MonadReader r m => m r
ask
let i :: ExtIdent
i = Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy lbl)
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ExtIdent
i Map ExtIdent (Value c (ImplEnvM m c))
impl of
Just Value c (ImplEnvM m c)
v -> do
a1
x <- forall c (m :: * -> *) a.
(FromValue c m a, MonadError EvalError m) =>
Value c m -> m a
fromValue Value c (ImplEnvM m c)
v
a2
b <- forall c (m :: * -> *) a.
(FromValue c m a, MonadError EvalError m) =>
Value c m -> m a
fromValue Value c (ImplEnvM m c)
b'
forall c (m :: * -> *) a.
(ToValue c m a, MonadError EvalError m) =>
a -> m (Value c m)
toValue forall a b. (a -> b) -> a -> b
$ a1 -> a2 -> a3
f a1
x a2
b
Maybe (Value c (ImplEnvM m c))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ ExtIdent -> EvalError
NotFoundInImplicitEnv ExtIdent
i
instance Kind0 a => Kind0 (IO a) where
toType :: Proxy (IO a) -> InfernoType
toType Proxy (IO a)
_ = forall a. Kind0 a => Proxy a -> InfernoType
toType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
instance ToValue c m a => ToValue c m (Maybe a) where
toValue :: MonadError EvalError m => Maybe a -> m (Value c m)
toValue (Just a
x) = forall custom (m :: * -> *). Value custom m -> Value custom m
VOne forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) a.
(ToValue c m a, MonadError EvalError m) =>
a -> m (Value c m)
toValue a
x
toValue Maybe a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall custom (m :: * -> *). Value custom m
VEmpty
instance (Typeable a, FromValue c m a, Pretty c) => FromValue c m (Maybe a) where
fromValue :: MonadError EvalError m => Value c m -> m (Maybe a)
fromValue Value c m
VEmpty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
fromValue (VOne Value c m
v) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) a.
(FromValue c m a, MonadError EvalError m) =>
Value c m -> m a
fromValue Value c m
v
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance Kind0 a => Kind0 (Maybe a) where
toType :: Proxy (Maybe a) -> InfernoType
toType Proxy (Maybe a)
_ = InfernoType -> InfernoType
TOptional (forall a. Kind0 a => Proxy a -> InfernoType
toType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
instance (ToValue c m a, ToValue c m b) => ToValue c m (Either a b) where
toValue :: MonadError EvalError m => Either a b -> m (Value c m)
toValue (Left a
x) = forall c (m :: * -> *) a.
(ToValue c m a, MonadError EvalError m) =>
a -> m (Value c m)
toValue a
x
toValue (Right b
x) = forall c (m :: * -> *) a.
(ToValue c m a, MonadError EvalError m) =>
a -> m (Value c m)
toValue b
x
instance ToValue c m a => ToValue c m [a] where
toValue :: MonadError EvalError m => [a] -> m (Value c m)
toValue [a]
xs = forall custom (m :: * -> *). [Value custom m] -> Value custom m
VArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall c (m :: * -> *) a.
(ToValue c m a, MonadError EvalError m) =>
a -> m (Value c m)
toValue [a]
xs)
instance (Typeable a, FromValue c m a, Pretty c) => FromValue c m [a] where
fromValue :: MonadError EvalError m => Value c m -> m [a]
fromValue (VArray [Value c m]
vs) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall c (m :: * -> *) a.
(FromValue c m a, MonadError EvalError m) =>
Value c m -> m a
fromValue [Value c m]
vs
fromValue Value c m
v = forall c (m :: * -> *) a.
(Pretty c, MonadError EvalError m, Typeable a) =>
Value c m -> m a
couldNotCast Value c m
v
instance (FromValue c m a, FromValue c m b) => FromValue c m (Either a b) where
fromValue :: MonadError EvalError m => Value c m -> m (Either a b)
fromValue Value c m
v = (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) a.
(FromValue c m a, MonadError EvalError m) =>
Value c m -> m a
fromValue Value c m
v) forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\EvalError
_ -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) a.
(FromValue c m a, MonadError EvalError m) =>
Value c m -> m a
fromValue Value c m
v)
instance Kind0 (Either a b) where
toType :: Proxy (Either a b) -> InfernoType
toType Proxy (Either a b)
_ = forall a. HasCallStack => String -> a
error String
"Definitions with Either must have explicit type signature"