{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# 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
"<<" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 TypeRep a
t 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 = forall a. TypeRep a -> a -> Dynamic
Dynamic 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 forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` forall a. Typeable a => a -> TypeRep a
typeOf a
def = 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 forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
rep = forall a. a -> Maybe a
Just a
v
| Bool
otherwise = forall a. Maybe a
Nothing
where rep :: TypeRep a
rep = 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 forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
ta'
, Just * :~~: TYPE r2
HRefl <- forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Type forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep res
tr
= forall a. a -> Maybe a
Just (forall a. TypeRep a -> a -> Dynamic
Dynamic TypeRep res
tr (a
f a
x))
dynApply Dynamic
_ 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 -> forall a. String -> a
errorWithoutStackTrace (String
"Type error in dynamic application.\n" forall a. [a] -> [a] -> [a]
++
String
"Can't apply function " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Dynamic
f forall a. [a] -> [a] -> [a]
++
String
" to argument " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Dynamic
x)
dynTypeRep :: Dynamic -> SomeTypeRep
dynTypeRep :: Dynamic -> SomeTypeRep
dynTypeRep (Dynamic TypeRep a
tr a
_) = forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep a
tr