io-classes: Add MonadUnique to support Data.Unique

Author: LSLeary

io-classes/CHANGELOG.md

@@ -1,5 +1,10 @@
 # Revsion history of io-classes
 
+### next release
+
+* Added module `Control.Monad.Class.MonadUnique` generalising `Data.Unique`.
+* mtl: Added module `Control.Monad.Class.MonadUnique.Trans` providing monad transformer instances for `MonadUnique`.
+
 ### 1.8.0.1
 
 * Added support for `ghc-9.2`.

io-classes/io-classes.cabal

@@ -87,6 +87,7 @@ library
                        Control.Monad.Class.MonadTime
                        Control.Monad.Class.MonadTimer
                        Control.Monad.Class.MonadTest
+                       Control.Monad.Class.MonadUnique
   default-language:    GHC2021
   default-extensions:  LambdaCase
   build-depends:       base  >=4.16 && <4.22,
@@ -174,6 +175,7 @@ library mtl
                    ,  Control.Monad.Class.MonadTime.SI.Trans
                    ,  Control.Monad.Class.MonadTimer.Trans
                    ,  Control.Monad.Class.MonadTimer.SI.Trans
+                   ,  Control.Monad.Class.MonadUnique.Trans
     build-depends:    base,
                       array,
                       mtl,

io-classes/mtl/Control/Monad/Class/MonadUnique/Trans.hs

@@ -0,0 +1,40 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Control.Monad.Class.MonadUnique.Trans () where
+
+import Control.Monad.Cont (ContT)
+import Control.Monad.Except (ExceptT)
+import Control.Monad.RWS.Lazy qualified as Lazy
+import Control.Monad.RWS.Strict qualified as Strict
+import Control.Monad.State.Lazy qualified as Lazy
+import Control.Monad.State.Strict qualified as Strict
+import Control.Monad.Writer.Lazy qualified as Lazy
+import Control.Monad.Writer.Strict qualified as Strict
+
+import Control.Monad.Class.MonadUnique
+
+
+instance MonadUnique m => MonadUnique (ContT r m) where
+  type Unique (ContT r m) = UniqueFor (ContT r) m
+
+instance MonadUnique m => MonadUnique (ExceptT e m) where
+  type Unique (ExceptT e m) = UniqueFor (ExceptT e) m
+
+instance (MonadUnique m, Monoid w) => MonadUnique (Lazy.RWST r w s m) where
+  type Unique (Lazy.RWST r w s m) = UniqueFor (Lazy.RWST r w s) m
+
+instance (MonadUnique m, Monoid w) => MonadUnique (Strict.RWST r w s m) where
+  type Unique (Strict.RWST r w s m) = UniqueFor (Strict.RWST r w s) m
+
+instance MonadUnique m => MonadUnique (Lazy.StateT s m) where
+  type Unique (Lazy.StateT s m) = UniqueFor (Lazy.StateT s) m
+
+instance MonadUnique m => MonadUnique (Strict.StateT s m) where
+  type Unique (Strict.StateT s m) = UniqueFor (Strict.StateT s) m
+
+instance (MonadUnique m, Monoid w) => MonadUnique (Lazy.WriterT w m) where
+  type Unique (Lazy.WriterT w m) = UniqueFor (Lazy.WriterT w) m
+
+instance (MonadUnique m, Monoid w) => MonadUnique (Strict.WriterT w m) where
+  type Unique (Strict.WriterT w m) = UniqueFor (Strict.WriterT w) m

io-classes/src/Control/Monad/Class/MonadUnique.hs

@@ -0,0 +1,48 @@
+{-# 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  = lift (MkUniqueFor <$> newUnique)
+  hashUnique = hashUnique . unMkUniqueFor
+
+instance MonadUnique IO where
+  type Unique IO = IO.Unique
+  newUnique  = IO.newUnique
+  hashUnique = IO.hashUnique
+
+
+newtype UniqueFor t m = MkUniqueFor{ 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