{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Data.Dynamic
(
Dynamic(..),
toDyn,
fromDyn,
fromDynamic,
dynApply,
dynApp,
dynTypeRep,
Typeable
) where
import Data.Type.Equality
import Type.Reflection
import Data.Maybe
import GHC.Base
import GHC.Show
import GHC.Exception
data Dynamic where
Dynamic :: forall a. TypeRep a -> a -> Dynamic
instance Show Dynamic where
showsPrec :: Int -> Dynamic -> ShowS
showsPrec Int
_ (Dynamic TypeRep a
t a
_) =
String -> ShowS
showString String
"<<" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> TypeRep a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 TypeRep a
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
">>"
instance Exception Dynamic
toDyn :: Typeable a => a -> Dynamic
toDyn :: forall a. Typeable a => a -> Dynamic
toDyn a
v = TypeRep a -> a -> Dynamic
forall a. TypeRep a -> a -> Dynamic
Dynamic TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep a
v
fromDyn :: Typeable a
=> Dynamic
-> a
-> a
fromDyn :: forall a. Typeable a => Dynamic -> a -> a
fromDyn (Dynamic TypeRep a
t a
v) a
def
| Just a :~~: a
HRefl <- TypeRep a
t TypeRep a -> TypeRep a -> Maybe (a :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
def = a
a
v
| Bool
otherwise = a
def
fromDynamic
:: forall a. Typeable a
=> Dynamic
-> Maybe a
fromDynamic :: forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (Dynamic TypeRep a
t a
v)
| Just a :~~: a
HRefl <- TypeRep a
t TypeRep a -> TypeRep a -> Maybe (a :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
rep = a -> Maybe a
forall a. a -> Maybe a
Just a
v
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
where rep :: TypeRep a
rep = TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep a
dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
dynApply (Dynamic (Fun TypeRep arg
ta TypeRep res
tr) a
f) (Dynamic TypeRep a
ta' a
x)
| Just arg :~~: a
HRefl <- TypeRep arg
ta TypeRep arg -> TypeRep a -> Maybe (arg :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
ta'
, Just * :~~: TYPE r2
HRefl <- forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Type TypeRep (*) -> TypeRep (TYPE r2) -> Maybe (* :~~: TYPE r2)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep res -> TypeRep (TYPE r2)
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep res
tr
= Dynamic -> Maybe Dynamic
forall a. a -> Maybe a
Just (TypeRep res -> res -> Dynamic
forall a. TypeRep a -> a -> Dynamic
Dynamic TypeRep res
TypeRep res
tr (a
a -> res
f a
x))
dynApply Dynamic
_ Dynamic
_
= Maybe Dynamic
forall a. Maybe a
Nothing
dynApp :: Dynamic -> Dynamic -> Dynamic
dynApp :: Dynamic -> Dynamic -> Dynamic
dynApp Dynamic
f Dynamic
x = case Dynamic -> Dynamic -> Maybe Dynamic
dynApply Dynamic
f Dynamic
x of
Just Dynamic
r -> Dynamic
r
Maybe Dynamic
Nothing -> String -> Dynamic
forall a. String -> a
errorWithoutStackTrace (String
"Type error in dynamic application.\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"Can't apply function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dynamic -> String
forall a. Show a => a -> String
show Dynamic
f String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" to argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dynamic -> String
forall a. Show a => a -> String
show Dynamic
x)
dynTypeRep :: Dynamic -> SomeTypeRep
dynTypeRep :: Dynamic -> SomeTypeRep
dynTypeRep (Dynamic TypeRep a
tr a
_) = TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep a
tr