{-# LANGUAGE DefaultSignatures      #-}
{-# LANGUAGE TypeFamilyDependencies #-}

-- | A generalisation of the
-- <https://hackage.haskell.org/package/base/docs/Data-Unique.html Data.Unique>
-- API to both 'IO' and <https://hackage.haskell.org/package/io-sim IOSim>.
--
module Control.Monad.Class.MonadUnique
  ( MonadUnique (..)
  , UniqueFor (..)
  ) where

-- base
import Data.Kind (Type)
import Data.Unique qualified as IO

-- transformers
import Control.Monad.Reader (MonadTrans (..), ReaderT (..), lift)


class (Monad m, Eq (Unique m), Ord (Unique m)) => MonadUnique m where
  type Unique m = (unique :: Type) | unique -> m
  newUnique  :: m (Unique m)
  hashUnique :: Unique m -> Int

  default
    newUnique
      :: (m ~ t n, Unique m ~ UniqueFor t n, MonadTrans t, MonadUnique n)
      => m (Unique m)
  default
    hashUnique
      :: (m ~ t n, Unique m ~ UniqueFor t n, MonadUnique n)
      => Unique m -> Int
  newUnique  = n (UniqueFor t n) -> t n (UniqueFor t n)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Unique n -> UniqueFor t n
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
Unique m -> UniqueFor t m
MkUniqueFor (Unique n -> UniqueFor t n) -> n (Unique n) -> n (UniqueFor t n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> n (Unique n)
forall (m :: * -> *). MonadUnique m => m (Unique m)
newUnique)
  hashUnique = Unique n -> Int
forall (m :: * -> *). MonadUnique m => Unique m -> Int
hashUnique (Unique n -> Int)
-> (UniqueFor t n -> Unique n) -> UniqueFor t n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueFor t n -> Unique n
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
UniqueFor t m -> Unique m
unMkUniqueFor

instance MonadUnique IO where
  type Unique IO = IO.Unique
  newUnique :: IO (Unique IO)
newUnique  = IO Unique
IO (Unique IO)
IO.newUnique
  hashUnique :: Unique IO -> Int
hashUnique = Unique -> Int
Unique IO -> Int
IO.hashUnique


newtype UniqueFor t m = MkUniqueFor{ forall (t :: (* -> *) -> * -> *) (m :: * -> *).
UniqueFor t m -> Unique m
unMkUniqueFor :: Unique m }
deriving instance MonadUnique m => Eq  (UniqueFor r m)
deriving instance MonadUnique m => Ord (UniqueFor r m)

instance MonadUnique m => MonadUnique (ReaderT r m) where
  type Unique (ReaderT r m) = UniqueFor (ReaderT r) m