{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
module Util.Dynamics (
Typeable(..),
TypeRep,
Dyn,
toDyn,
fromDynamic,
fromDynamicWE,
coerce,
coerceIO,
typeMismatch,
dynCast,
dynCastOpt
)
where
import qualified Data.Dynamic
import Data.Typeable
import Util.Computation
import Util.Debug(debug)
fromDynamic :: Typeable a => Dyn -> Maybe a
fromDynamic :: Dyn -> Maybe a
fromDynamic = Dyn -> Maybe a
forall a. Typeable a => Dyn -> Maybe a
Data.Dynamic.fromDynamic
fromDynamicWE :: Typeable a => Dyn -> WithError a
fromDynamicWE :: Dyn -> WithError a
fromDynamicWE Dyn
dyn =
case Dyn -> Maybe a
forall a. Typeable a => Dyn -> Maybe a
fromDynamic Dyn
dyn of
Just a
a -> a -> WithError a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
(aOpt :: Maybe a
aOpt @ Maybe a
Nothing) ->
String -> WithError a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Dynamic type error. Looking for "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Maybe a -> a
forall a. Maybe a -> a
typeHack Maybe a
aOpt))
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but found a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Dyn -> String
forall a. Show a => a -> String
show Dyn
dyn)
where
typeHack :: Maybe a -> a
typeHack :: Maybe a -> a
typeHack Maybe a
_ = a
forall a. HasCallStack => a
undefined
type Dyn = Data.Dynamic.Dynamic
toDyn :: Typeable a => a -> Dyn
toDyn :: a -> Dyn
toDyn = a -> Dyn
forall a. Typeable a => a -> Dyn
Data.Dynamic.toDyn
coerce :: Typeable a => Dyn -> a
coerce :: Dyn -> a
coerce Dyn
d =
case Dyn -> Maybe a
forall a. Typeable a => Dyn -> Maybe a
fromDynamic Dyn
d of
Just a
x -> a
x
coerceIO :: Typeable a => Dyn -> IO a
coerceIO :: Dyn -> IO a
coerceIO Dyn
d =
case Dyn -> Maybe a
forall a. Typeable a => Dyn -> Maybe a
fromDynamic Dyn
d of
Maybe a
Nothing ->
do
String -> IO ()
forall a. Show a => a -> IO ()
debug String
"Dynamics.coerceIO failure"
IOError -> IO a
forall a. IOError -> IO a
ioError IOError
typeMismatch
(Just a
x) -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
typeMismatch :: IOError
typeMismatch :: IOError
typeMismatch =
String -> IOError
userError String
"internal type of dynamics does not match expected type"
dynCast :: (Typeable a,Typeable b) => String -> a -> b
dynCast :: String -> a -> b
dynCast String
mess a
value = case a -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
dynCastOpt a
value of
Maybe b
Nothing -> String -> b
forall a. HasCallStack => String -> a
error (String
"Dynamics.dynCast failure in "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
mess)
Just b
value2 -> b
value2
dynCastOpt :: (Typeable a,Typeable b) => a -> Maybe b
dynCastOpt :: a -> Maybe b
dynCastOpt = a -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast