{-# 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 _ (Dynamic t :: TypeRep a
t _) =
String -> ShowS
showString "<<" 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 0 TypeRep a
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString ">>"
instance Exception Dynamic
toDyn :: Typeable a => a -> Dynamic
toDyn :: a -> Dynamic
toDyn v :: 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 :: Dynamic -> a -> a
fromDyn (Dynamic t :: TypeRep a
t v :: a
v) def :: a
def
| Just 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 :: Dynamic -> Maybe a
fromDynamic (Dynamic t :: TypeRep a
t v :: a
v)
| Just 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 ta :: TypeRep arg
ta tr :: TypeRep res
tr) f :: a
f) (Dynamic ta' :: TypeRep a
ta' x :: a
x)
| Just 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 HRefl <- Typeable * => TypeRep *
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 _ _
= Maybe Dynamic
forall a. Maybe a
Nothing
dynApp :: Dynamic -> Dynamic -> Dynamic
dynApp :: Dynamic -> Dynamic -> Dynamic
dynApp f :: Dynamic
f x :: Dynamic
x = case Dynamic -> Dynamic -> Maybe Dynamic
dynApply Dynamic
f Dynamic
x of
Just r :: Dynamic
r -> Dynamic
r
Nothing -> String -> Dynamic
forall a. String -> a
errorWithoutStackTrace ("Type error in dynamic application.\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
"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]
++
" 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 tr :: TypeRep a
tr _) = TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep a
tr