{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Dynamic
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- The Dynamic interface provides basic support for dynamic types.
--
-- Operations for injecting values of arbitrary type into
-- a dynamically typed value, Dynamic, are provided, together
-- with operations for converting dynamic values into a concrete
-- (monomorphic) type.
--
-----------------------------------------------------------------------------

module Data.Dynamic
  (

        -- * The @Dynamic@ type
        Dynamic(..),

        -- * Converting to and from @Dynamic@
        toDyn,
        fromDyn,
        fromDynamic,

        -- * Applying functions of dynamic type
        dynApply,
        dynApp,
        dynTypeRep,

        -- * Convenience re-exports
        Typeable

  ) where


import Data.Type.Equality
import Type.Reflection
import Data.Maybe

import GHC.Base
import GHC.Show
import GHC.Exception

-------------------------------------------------------------
--
--              The type Dynamic
--
-------------------------------------------------------------

{-|
  A value of type 'Dynamic' is an object encapsulated together with its type.

  A 'Dynamic' may only represent a monomorphic value; an attempt to
  create a value of type 'Dynamic' from a polymorphically-typed
  expression will result in an ambiguity error (see 'toDyn').

  'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
  of the object\'s type; useful for debugging.
-}
data Dynamic where
    Dynamic :: forall a. TypeRep a -> a -> Dynamic

-- | @since 2.01
instance Show Dynamic where
   -- the instance just prints the type representation.
   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
">>"

-- here so that it isn't an orphan:
-- | @since 4.0.0.0
instance Exception Dynamic

 -- Use GHC's primitive 'Any' type to hold the dynamically typed value.
 --
 -- In GHC's new eval/apply execution model this type must not look
 -- like a data type.  If it did, GHC would use the constructor convention
 -- when evaluating it, and this will go wrong if the object is really a
 -- function.  Using Any forces GHC to use
 -- a fallback convention for evaluating it that works for all types.

-- | Converts an arbitrary value into an object of type 'Dynamic'.
--
-- The type of the object must be an instance of 'Typeable', which
-- ensures that only monomorphically-typed objects may be converted to
-- 'Dynamic'.  To convert a polymorphic object into 'Dynamic', give it
-- a monomorphic type signature.  For example:
--
-- >    toDyn (id :: Int -> Int)
--
toDyn :: Typeable a => a -> Dynamic
toDyn :: 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

-- | Converts a 'Dynamic' object back into an ordinary Haskell value of
-- the correct type.  See also 'fromDynamic'.
fromDyn :: Typeable a
        => Dynamic      -- ^ the dynamically-typed object
        -> a            -- ^ a default value
        -> a            -- ^ returns: the value of the first argument, if
                        -- it has the correct type, otherwise the value of
                        -- the second argument.
fromDyn :: 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

-- | Converts a 'Dynamic' object back into an ordinary Haskell value of
-- the correct type.  See also 'fromDyn'.
fromDynamic
        :: forall a. Typeable a
        => Dynamic      -- ^ the dynamically-typed object
        -> Maybe a      -- ^ returns: @'Just' a@, if the dynamically-typed
                        -- object has the correct type (and @a@ is its value),
                        -- or 'Nothing' otherwise.
fromDynamic :: 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

-- (f::(a->b)) `dynApply` (x::a) = (f a)::b
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 <- 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 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