-- | Newtype wrappers
--
-- For some types, we infer a "wrapped type" instead. It is important that
-- these wrappers are all /newtypes/ and not /datatypes, because when we have
-- a value @x :: a@ and a corresponding classifier @Classifier a@, we should be
-- able to @unsafeCoerce x@ to whatever type the classifier tells us. If we
-- don't use newtypes but datatypes here, then that would not be possible.
--
-- We use these newtypes primarily so that we can give some custom type class
-- instances. In particular, this means that for example our inferred functions
-- have a show instance, even if they are simply shown as @<Fun>@; this is
-- nonetheless stil useful, as it means that we can show /everything/, which is
-- kind of the point.
module Debug.RecoverRTTI.Wrappers (
    -- * Functions
    SomeFun(..)
    -- * Reference cells
  , SomeSTRef(..)
  , SomeMVar(..)
  , SomeTVar(..)
  ) where

import Control.Concurrent.MVar (MVar)
import Control.Concurrent.STM (TVar)
import Data.STRef (STRef)
import GHC.Exts

{-------------------------------------------------------------------------------
  Functions
-------------------------------------------------------------------------------}

-- | Functions
--
-- We do not try to infer the domain or codomain of the function.
newtype SomeFun = SomeFun (Any -> Any)

{-------------------------------------------------------------------------------
  Reference cells

  We do not try to look inside these variables to figure out the type of their
  elements; the show instance merely shows an address.
-------------------------------------------------------------------------------}

newtype SomeSTRef = SomeSTRef (STRef Any Any)
  deriving (SomeSTRef -> SomeSTRef -> Bool
(SomeSTRef -> SomeSTRef -> Bool)
-> (SomeSTRef -> SomeSTRef -> Bool) -> Eq SomeSTRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeSTRef -> SomeSTRef -> Bool
$c/= :: SomeSTRef -> SomeSTRef -> Bool
== :: SomeSTRef -> SomeSTRef -> Bool
$c== :: SomeSTRef -> SomeSTRef -> Bool
Eq)

newtype SomeMVar = SomeMVar (MVar Any)
  deriving (SomeMVar -> SomeMVar -> Bool
(SomeMVar -> SomeMVar -> Bool)
-> (SomeMVar -> SomeMVar -> Bool) -> Eq SomeMVar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeMVar -> SomeMVar -> Bool
$c/= :: SomeMVar -> SomeMVar -> Bool
== :: SomeMVar -> SomeMVar -> Bool
$c== :: SomeMVar -> SomeMVar -> Bool
Eq)

newtype SomeTVar = SomeTVar (TVar Any)
  deriving (SomeTVar -> SomeTVar -> Bool
(SomeTVar -> SomeTVar -> Bool)
-> (SomeTVar -> SomeTVar -> Bool) -> Eq SomeTVar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SomeTVar -> SomeTVar -> Bool
$c/= :: SomeTVar -> SomeTVar -> Bool
== :: SomeTVar -> SomeTVar -> Bool
$c== :: SomeTVar -> SomeTVar -> Bool
Eq)

{-------------------------------------------------------------------------------
  Show instances

  Unfortunately reference cells are moved by GC, so we can't do much here;
  showing the address of the variable isn't particularly helpful.
-------------------------------------------------------------------------------}

instance Show SomeSTRef where
  show :: SomeSTRef -> String
show SomeSTRef
_ = String
"<STRef/IORef>" -- they look the same on the heap

instance Show SomeMVar where
  show :: SomeMVar -> String
show SomeMVar
_ = String
"<MVar>"

instance Show SomeTVar where
  show :: SomeTVar -> String
show SomeTVar
_ = String
"<TVar>"

instance Show SomeFun where
  show :: SomeFun -> String
show SomeFun
_ = String
"<Fun>"