-- | Dynamic values with support for rank-1 polymorphic types.
--
-- [Examples of fromDynamic]
--
-- These examples correspond to the 'Data.Rank1Typeable.isInstanceOf' examples
-- in "Data.Rank1Typeable".
--
-- > > do f <- fromDynamic (toDynamic (even :: Int -> Bool)) ; return $ (f :: Int -> Int) 0
-- > Left "Cannot unify Int and Bool"
-- >
-- > > do f <- fromDynamic (toDynamic (const 1 :: ANY -> Int)) ; return $ (f :: Int -> Int) 0
-- > Right 1
-- >
-- > > do f <- fromDynamic (toDynamic (unsafeCoerce :: ANY1 -> ANY2)) ; return $ (f :: Int -> Int) 0
-- > Right 0
-- >
-- > > do f <- fromDynamic (toDynamic (id :: ANY -> ANY)) ; return $ (f :: Int -> Bool) 0
-- > Left "Cannot unify Bool and Int"
-- >
-- > > do f <- fromDynamic (toDynamic (undefined :: ANY)) ; return $ (f :: Int -> Int) 0
-- > Right *** Exception: Prelude.undefined
-- >
-- > > do f <- fromDynamic (toDynamic (id :: ANY -> ANY)) ; return $ (f :: Int)
-- > Left "Cannot unify Int and ->"
--
-- [Examples of dynApply]
--
-- These examples correspond to the 'Data.Rank1Typeable.funResultTy' examples
-- in "Data.Rank1Typeable".
--
-- > > do app <- toDynamic (id :: ANY -> ANY) `dynApply` toDynamic True ; f <- fromDynamic app ; return $ (f :: Bool)
-- > Right True
-- >
-- > > do app <- toDynamic (const :: ANY -> ANY1 -> ANY) `dynApply` toDynamic True ; f <- fromDynamic app ; return $ (f :: Int -> Bool) 0
-- > Right True
-- >
-- > > do app <- toDynamic (($ True) :: (Bool -> ANY) -> ANY) `dynApply` toDynamic (id :: ANY -> ANY) ; f <- fromDynamic app ; return (f :: Bool)
-- > Right True
-- >
-- > > app <- toDynamic (const :: ANY -> ANY1 -> ANY) `dynApply` toDynamic (id :: ANY -> ANY) ; f <- fromDynamic app ; return $ (f :: Int -> Bool -> Bool) 0 True
-- > Right True
-- >
-- > > do app <- toDynamic ((\f -> f . f) :: (ANY -> ANY) -> ANY -> ANY) `dynApply` toDynamic (even :: Int -> Bool) ; f <- fromDynamic app ; return (f :: ())
-- > Left "Cannot unify Int and Bool"
--
-- [Using toDynamic]
--
-- When using polymorphic values you need to give an explicit type annotation:
--
-- > > toDynamic id
-- >
-- > <interactive>:46:1:
-- >     Ambiguous type variable `a0' in the constraint:
-- >       (Typeable a0) arising from a use of `toDynamic'
-- >     Probable fix: add a type signature that fixes these type variable(s)
-- >     In the expression: toDynamic id
-- >     In an equation for `it': it = toDynamic id
--
-- versus
--
-- > > toDynamic (id :: ANY -> ANY)
-- > <<ANY -> ANY>>
--
-- Note that these type annotation are checked by ghc like any other:
--
-- > > toDynamic (id :: ANY -> ANY1)
-- >
-- > <interactive>:45:12:
-- >     Couldn't match expected type `V1' with actual type `V0'
-- >     Expected type: ANY -> ANY1
-- >       Actual type: ANY -> ANY
-- >     In the first argument of `toDynamic', namely `(id :: ANY -> ANY1)'
-- >     In the expression: toDynamic (id :: ANY -> ANY1)
module Data.Rank1Dynamic
  ( Dynamic
  , toDynamic
  , fromDynamic
  , TypeError
  , dynTypeRep
  , dynApply
  , unsafeToDynamic
  ) where

import qualified GHC.Exts as GHC (Any)
import Data.Rank1Typeable
  ( Typeable
  , TypeRep
  , typeOf
  , isInstanceOf
  , TypeError
  , funResultTy
  )
import Unsafe.Coerce (unsafeCoerce)

-- | Encapsulate an object and its type
data Dynamic = Dynamic TypeRep GHC.Any

instance Show Dynamic where
  showsPrec :: Int -> Dynamic -> ShowS
showsPrec Int
_ (Dynamic TypeRep
t Any
_) = TypeError -> ShowS
showString TypeError
"<<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> ShowS
forall a. Show a => a -> ShowS
shows TypeRep
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeError -> ShowS
showString TypeError
">>"

-- | Introduce a dynamic value
toDynamic :: Typeable a => a -> Dynamic
toDynamic :: forall a. Typeable a => a -> Dynamic
toDynamic a
x = TypeRep -> Any -> Dynamic
Dynamic (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
x) (a -> Any
forall a b. a -> b
unsafeCoerce a
x)

-- | Construct a dynamic value with a user-supplied type rep
--
-- This function is unsafe because we have no way of verifying that the
-- provided type representation matches the value.
--
-- Since 0.3.2.0.
unsafeToDynamic :: TypeRep -> a -> Dynamic
unsafeToDynamic :: forall a. TypeRep -> a -> Dynamic
unsafeToDynamic TypeRep
typ a
x = TypeRep -> Any -> Dynamic
Dynamic TypeRep
typ (a -> Any
forall a b. a -> b
unsafeCoerce a
x)

-- | Eliminate a dynamic value
fromDynamic :: Typeable a => Dynamic -> Either TypeError a
fromDynamic :: forall a. Typeable a => Dynamic -> Either TypeError a
fromDynamic (Dynamic TypeRep
t Any
v) =
  case Any -> a
forall a b. a -> b
unsafeCoerce Any
v of
    a
r -> case a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
r TypeRep -> TypeRep -> Either TypeError ()
`isInstanceOf` TypeRep
t of
      Left TypeError
err -> TypeError -> Either TypeError a
forall a b. a -> Either a b
Left TypeError
err
      Right () -> a -> Either TypeError a
forall a b. b -> Either a b
Right a
r

-- | Apply one dynamic value to another
dynApply :: Dynamic -> Dynamic -> Either TypeError Dynamic
dynApply :: Dynamic -> Dynamic -> Either TypeError Dynamic
dynApply (Dynamic TypeRep
t1 Any
f) (Dynamic TypeRep
t2 Any
x) = do
  TypeRep
t3 <- TypeRep -> TypeRep -> Either TypeError TypeRep
funResultTy TypeRep
t1 TypeRep
t2
  Dynamic -> Either TypeError Dynamic
forall a. a -> Either TypeError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic -> Either TypeError Dynamic)
-> Dynamic -> Either TypeError Dynamic
forall a b. (a -> b) -> a -> b
$ TypeRep -> Any -> Dynamic
Dynamic TypeRep
t3 (Any -> Any -> Any
forall a b. a -> b
unsafeCoerce Any
f Any
x)

-- | The type representation of a dynamic value
dynTypeRep :: Dynamic -> TypeRep
dynTypeRep :: Dynamic -> TypeRep
dynTypeRep (Dynamic TypeRep
t Any
_) = TypeRep
t