{-|
Module: Control.Monad.NodeId
Description: Monad providing a supply of unique identifiers
-}
{-# Language UndecidableInstances #-}
module Control.Monad.NodeId
  ( NodeId
  , MonadNodeId (..)
  , NodeIdT
  , runNodeIdT
  ) where

import Control.Monad.Morph
import Control.Monad.Reader
import Control.Monad.Ref
import Data.IORef

import Reflex
import Reflex.Host.Class

-- | A unique identifier with respect to the 'runNodeIdT' in which it was generated
newtype NodeId = NodeId Integer
  deriving (NodeId -> NodeId -> Bool
(NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool) -> Eq NodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
/= :: NodeId -> NodeId -> Bool
Eq, Eq NodeId
Eq NodeId
-> (NodeId -> NodeId -> Ordering)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId -> NodeId)
-> Ord NodeId
NodeId -> NodeId -> Bool
NodeId -> NodeId -> Ordering
NodeId -> NodeId -> NodeId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NodeId -> NodeId -> Ordering
compare :: NodeId -> NodeId -> Ordering
$c< :: NodeId -> NodeId -> Bool
< :: NodeId -> NodeId -> Bool
$c<= :: NodeId -> NodeId -> Bool
<= :: NodeId -> NodeId -> Bool
$c> :: NodeId -> NodeId -> Bool
> :: NodeId -> NodeId -> Bool
$c>= :: NodeId -> NodeId -> Bool
>= :: NodeId -> NodeId -> Bool
$cmax :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
min :: NodeId -> NodeId -> NodeId
Ord, Int -> NodeId -> ShowS
[NodeId] -> ShowS
NodeId -> String
(Int -> NodeId -> ShowS)
-> (NodeId -> String) -> ([NodeId] -> ShowS) -> Show NodeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeId -> ShowS
showsPrec :: Int -> NodeId -> ShowS
$cshow :: NodeId -> String
show :: NodeId -> String
$cshowList :: [NodeId] -> ShowS
showList :: [NodeId] -> ShowS
Show)

-- | Members of this class can request new identifiers that are unique in the action
-- in which they are obtained (i.e., all calls to 'getNextNodeId' in a given 'runNodeIdT'
-- will produce unique results)
class Monad m => MonadNodeId m where
  getNextNodeId :: m NodeId
  default getNextNodeId :: (MonadTrans t, MonadNodeId n, m ~ t n) => m NodeId
  getNextNodeId = n NodeId -> t n NodeId
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n NodeId
forall (m :: * -> *). MonadNodeId m => m NodeId
getNextNodeId

-- | A monad transformer that internally keeps track of the next 'NodeId'
newtype NodeIdT m a = NodeIdT { forall (m :: * -> *) a. NodeIdT m a -> ReaderT (IORef NodeId) m a
unNodeIdT :: ReaderT (IORef NodeId) m a }
  deriving
    ( (forall a b. (a -> b) -> NodeIdT m a -> NodeIdT m b)
-> (forall a b. a -> NodeIdT m b -> NodeIdT m a)
-> Functor (NodeIdT m)
forall a b. a -> NodeIdT m b -> NodeIdT m a
forall a b. (a -> b) -> NodeIdT m a -> NodeIdT m b
forall (m :: * -> *) a b.
Functor m =>
a -> NodeIdT m b -> NodeIdT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NodeIdT m a -> NodeIdT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NodeIdT m a -> NodeIdT m b
fmap :: forall a b. (a -> b) -> NodeIdT m a -> NodeIdT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> NodeIdT m b -> NodeIdT m a
<$ :: forall a b. a -> NodeIdT m b -> NodeIdT m a
Functor
    , Functor (NodeIdT m)
Functor (NodeIdT m)
-> (forall a. a -> NodeIdT m a)
-> (forall a b. NodeIdT m (a -> b) -> NodeIdT m a -> NodeIdT m b)
-> (forall a b c.
    (a -> b -> c) -> NodeIdT m a -> NodeIdT m b -> NodeIdT m c)
-> (forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m b)
-> (forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m a)
-> Applicative (NodeIdT m)
forall a. a -> NodeIdT m a
forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m a
forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m b
forall a b. NodeIdT m (a -> b) -> NodeIdT m a -> NodeIdT m b
forall a b c.
(a -> b -> c) -> NodeIdT m a -> NodeIdT m b -> NodeIdT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (NodeIdT m)
forall (m :: * -> *) a. Applicative m => a -> NodeIdT m a
forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m a
forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m b
forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m (a -> b) -> NodeIdT m a -> NodeIdT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NodeIdT m a -> NodeIdT m b -> NodeIdT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> NodeIdT m a
pure :: forall a. a -> NodeIdT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m (a -> b) -> NodeIdT m a -> NodeIdT m b
<*> :: forall a b. NodeIdT m (a -> b) -> NodeIdT m a -> NodeIdT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NodeIdT m a -> NodeIdT m b -> NodeIdT m c
liftA2 :: forall a b c.
(a -> b -> c) -> NodeIdT m a -> NodeIdT m b -> NodeIdT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m b
*> :: forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m a
<* :: forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m a
Applicative
    , (forall (m :: * -> *) (n :: * -> *) b.
 Monad m =>
 (forall a. m a -> n a) -> NodeIdT m b -> NodeIdT n b)
-> MFunctor NodeIdT
forall {k} (t :: (* -> *) -> k -> *).
(forall (m :: * -> *) (n :: * -> *) (b :: k).
 Monad m =>
 (forall a. m a -> n a) -> t m b -> t n b)
-> MFunctor t
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> NodeIdT m b -> NodeIdT n b
$choist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> NodeIdT m b -> NodeIdT n b
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> NodeIdT m b -> NodeIdT n b
MFunctor
    , Applicative (NodeIdT m)
Applicative (NodeIdT m)
-> (forall a b. NodeIdT m a -> (a -> NodeIdT m b) -> NodeIdT m b)
-> (forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m b)
-> (forall a. a -> NodeIdT m a)
-> Monad (NodeIdT m)
forall a. a -> NodeIdT m a
forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m b
forall a b. NodeIdT m a -> (a -> NodeIdT m b) -> NodeIdT m b
forall {m :: * -> *}. Monad m => Applicative (NodeIdT m)
forall (m :: * -> *) a. Monad m => a -> NodeIdT m a
forall (m :: * -> *) a b.
Monad m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m b
forall (m :: * -> *) a b.
Monad m =>
NodeIdT m a -> (a -> NodeIdT m b) -> NodeIdT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
NodeIdT m a -> (a -> NodeIdT m b) -> NodeIdT m b
>>= :: forall a b. NodeIdT m a -> (a -> NodeIdT m b) -> NodeIdT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m b
>> :: forall a b. NodeIdT m a -> NodeIdT m b -> NodeIdT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> NodeIdT m a
return :: forall a. a -> NodeIdT m a
Monad
    , Monad (NodeIdT m)
Monad (NodeIdT m)
-> (forall a. (a -> NodeIdT m a) -> NodeIdT m a)
-> MonadFix (NodeIdT m)
forall a. (a -> NodeIdT m a) -> NodeIdT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (NodeIdT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> NodeIdT m a) -> NodeIdT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> NodeIdT m a) -> NodeIdT m a
mfix :: forall a. (a -> NodeIdT m a) -> NodeIdT m a
MonadFix
    , MonadHold t
    , Monad (NodeIdT m)
Monad (NodeIdT m)
-> (forall a. IO a -> NodeIdT m a) -> MonadIO (NodeIdT m)
forall a. IO a -> NodeIdT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (NodeIdT m)
forall (m :: * -> *) a. MonadIO m => IO a -> NodeIdT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> NodeIdT m a
liftIO :: forall a. IO a -> NodeIdT m a
MonadIO
    , Monad (NodeIdT m)
Monad (NodeIdT m)
-> (forall a. a -> NodeIdT m (Ref (NodeIdT m) a))
-> (forall a. Ref (NodeIdT m) a -> NodeIdT m a)
-> (forall a. Ref (NodeIdT m) a -> a -> NodeIdT m ())
-> (forall a. Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ())
-> (forall a. Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ())
-> MonadRef (NodeIdT m)
forall a. a -> NodeIdT m (Ref (NodeIdT m) a)
forall a. Ref (NodeIdT m) a -> NodeIdT m a
forall a. Ref (NodeIdT m) a -> a -> NodeIdT m ()
forall a. Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
forall (m :: * -> *).
Monad m
-> (forall a. a -> m (Ref m a))
-> (forall a. Ref m a -> m a)
-> (forall a. Ref m a -> a -> m ())
-> (forall a. Ref m a -> (a -> a) -> m ())
-> (forall a. Ref m a -> (a -> a) -> m ())
-> MonadRef m
forall {m :: * -> *}. MonadRef m => Monad (NodeIdT m)
forall (m :: * -> *) a.
MonadRef m =>
a -> NodeIdT m (Ref (NodeIdT m) a)
forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> NodeIdT m a
forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> a -> NodeIdT m ()
forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
$cnewRef :: forall (m :: * -> *) a.
MonadRef m =>
a -> NodeIdT m (Ref (NodeIdT m) a)
newRef :: forall a. a -> NodeIdT m (Ref (NodeIdT m) a)
$creadRef :: forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> NodeIdT m a
readRef :: forall a. Ref (NodeIdT m) a -> NodeIdT m a
$cwriteRef :: forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> a -> NodeIdT m ()
writeRef :: forall a. Ref (NodeIdT m) a -> a -> NodeIdT m ()
$cmodifyRef :: forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
modifyRef :: forall a. Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
$cmodifyRef' :: forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
modifyRef' :: forall a. Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
MonadRef
    , MonadReflexCreateTrigger t
    , MonadSample t
    , (forall (m :: * -> *) a. Monad m => m a -> NodeIdT m a)
-> MonadTrans NodeIdT
forall (m :: * -> *) a. Monad m => m a -> NodeIdT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> NodeIdT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> NodeIdT m a
MonadTrans
    , NotReady t
    , PerformEvent t
    , PostBuild t
    , TriggerEvent t
    )

instance MonadNodeId m => MonadNodeId (ReaderT x m)
instance MonadNodeId m => MonadNodeId (BehaviorWriterT t x m)
instance MonadNodeId m => MonadNodeId (DynamicWriterT t x m)
instance MonadNodeId m => MonadNodeId (EventWriterT t x m)
instance MonadNodeId m => MonadNodeId (TriggerEventT t m)
instance MonadNodeId m => MonadNodeId (PostBuildT t m)

instance Adjustable t m => Adjustable t (NodeIdT m) where
  runWithReplace :: forall a b.
NodeIdT m a -> Event t (NodeIdT m b) -> NodeIdT m (a, Event t b)
runWithReplace (NodeIdT ReaderT (IORef NodeId) m a
a) Event t (NodeIdT m b)
e = ReaderT (IORef NodeId) m (a, Event t b) -> NodeIdT m (a, Event t b)
forall (m :: * -> *) a. ReaderT (IORef NodeId) m a -> NodeIdT m a
NodeIdT (ReaderT (IORef NodeId) m (a, Event t b)
 -> NodeIdT m (a, Event t b))
-> ReaderT (IORef NodeId) m (a, Event t b)
-> NodeIdT m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ ReaderT (IORef NodeId) m a
-> Event t (ReaderT (IORef NodeId) m b)
-> ReaderT (IORef NodeId) m (a, Event t b)
forall a b.
ReaderT (IORef NodeId) m a
-> Event t (ReaderT (IORef NodeId) m b)
-> ReaderT (IORef NodeId) m (a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace ReaderT (IORef NodeId) m a
a (Event t (ReaderT (IORef NodeId) m b)
 -> ReaderT (IORef NodeId) m (a, Event t b))
-> Event t (ReaderT (IORef NodeId) m b)
-> ReaderT (IORef NodeId) m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ (NodeIdT m b -> ReaderT (IORef NodeId) m b)
-> Event t (NodeIdT m b) -> Event t (ReaderT (IORef NodeId) m b)
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeIdT m b -> ReaderT (IORef NodeId) m b
forall (m :: * -> *) a. NodeIdT m a -> ReaderT (IORef NodeId) m a
unNodeIdT Event t (NodeIdT m b)
e
  traverseIntMapWithKeyWithAdjust :: forall v v'.
(Int -> v -> NodeIdT m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> NodeIdT m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Int -> v -> NodeIdT m v'
f IntMap v
m Event t (PatchIntMap v)
e = ReaderT (IORef NodeId) m (IntMap v', Event t (PatchIntMap v'))
-> NodeIdT m (IntMap v', Event t (PatchIntMap v'))
forall (m :: * -> *) a. ReaderT (IORef NodeId) m a -> NodeIdT m a
NodeIdT (ReaderT (IORef NodeId) m (IntMap v', Event t (PatchIntMap v'))
 -> NodeIdT m (IntMap v', Event t (PatchIntMap v')))
-> ReaderT (IORef NodeId) m (IntMap v', Event t (PatchIntMap v'))
-> NodeIdT m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$ (Int -> v -> ReaderT (IORef NodeId) m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> ReaderT (IORef NodeId) m (IntMap v', Event t (PatchIntMap v'))
forall v v'.
(Int -> v -> ReaderT (IORef NodeId) m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> ReaderT (IORef NodeId) m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Int
k v
v -> NodeIdT m v' -> ReaderT (IORef NodeId) m v'
forall (m :: * -> *) a. NodeIdT m a -> ReaderT (IORef NodeId) m a
unNodeIdT (NodeIdT m v' -> ReaderT (IORef NodeId) m v')
-> NodeIdT m v' -> ReaderT (IORef NodeId) m v'
forall a b. (a -> b) -> a -> b
$ Int -> v -> NodeIdT m v'
f Int
k v
v) IntMap v
m Event t (PatchIntMap v)
e
  traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> NodeIdT m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> NodeIdT m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> NodeIdT m (v' a)
f DMap k v
m Event t (PatchDMap k v)
e = ReaderT (IORef NodeId) m (DMap k v', Event t (PatchDMap k v'))
-> NodeIdT m (DMap k v', Event t (PatchDMap k v'))
forall (m :: * -> *) a. ReaderT (IORef NodeId) m a -> NodeIdT m a
NodeIdT (ReaderT (IORef NodeId) m (DMap k v', Event t (PatchDMap k v'))
 -> NodeIdT m (DMap k v', Event t (PatchDMap k v')))
-> ReaderT (IORef NodeId) m (DMap k v', Event t (PatchDMap k v'))
-> NodeIdT m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> v a -> ReaderT (IORef NodeId) m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> ReaderT (IORef NodeId) m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> ReaderT (IORef NodeId) m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> ReaderT (IORef NodeId) m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
k v a
v -> NodeIdT m (v' a) -> ReaderT (IORef NodeId) m (v' a)
forall (m :: * -> *) a. NodeIdT m a -> ReaderT (IORef NodeId) m a
unNodeIdT (NodeIdT m (v' a) -> ReaderT (IORef NodeId) m (v' a))
-> NodeIdT m (v' a) -> ReaderT (IORef NodeId) m (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> NodeIdT m (v' a)
forall a. k a -> v a -> NodeIdT m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMap k v)
e
  traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> NodeIdT m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> NodeIdT m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> NodeIdT m (v' a)
f DMap k v
m Event t (PatchDMapWithMove k v)
e = ReaderT
  (IORef NodeId) m (DMap k v', Event t (PatchDMapWithMove k v'))
-> NodeIdT m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (m :: * -> *) a. ReaderT (IORef NodeId) m a -> NodeIdT m a
NodeIdT (ReaderT
   (IORef NodeId) m (DMap k v', Event t (PatchDMapWithMove k v'))
 -> NodeIdT m (DMap k v', Event t (PatchDMapWithMove k v')))
-> ReaderT
     (IORef NodeId) m (DMap k v', Event t (PatchDMapWithMove k v'))
-> NodeIdT m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> v a -> ReaderT (IORef NodeId) m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> ReaderT
     (IORef NodeId) m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> ReaderT (IORef NodeId) m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> ReaderT
     (IORef NodeId) m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
k v a
v -> NodeIdT m (v' a) -> ReaderT (IORef NodeId) m (v' a)
forall (m :: * -> *) a. NodeIdT m a -> ReaderT (IORef NodeId) m a
unNodeIdT (NodeIdT m (v' a) -> ReaderT (IORef NodeId) m (v' a))
-> NodeIdT m (v' a) -> ReaderT (IORef NodeId) m (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> NodeIdT m (v' a)
forall a. k a -> v a -> NodeIdT m (v' a)
f k a
k v a
v) DMap k v
m Event t (PatchDMapWithMove k v)
e

-- | Runs a 'NodeIdT' action
runNodeIdT :: MonadIO m => NodeIdT m a -> m a
runNodeIdT :: forall (m :: * -> *) a. MonadIO m => NodeIdT m a -> m a
runNodeIdT NodeIdT m a
a = do
  IORef NodeId
ref <- IO (IORef NodeId) -> m (IORef NodeId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef NodeId) -> m (IORef NodeId))
-> IO (IORef NodeId) -> m (IORef NodeId)
forall a b. (a -> b) -> a -> b
$ NodeId -> IO (IORef NodeId)
forall a. a -> IO (IORef a)
newIORef (NodeId -> IO (IORef NodeId)) -> NodeId -> IO (IORef NodeId)
forall a b. (a -> b) -> a -> b
$ Integer -> NodeId
NodeId Integer
0
  ReaderT (IORef NodeId) m a -> IORef NodeId -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (NodeIdT m a -> ReaderT (IORef NodeId) m a
forall (m :: * -> *) a. NodeIdT m a -> ReaderT (IORef NodeId) m a
unNodeIdT NodeIdT m a
a) IORef NodeId
ref

instance MonadIO m => MonadNodeId (NodeIdT m) where
  getNextNodeId :: NodeIdT m NodeId
getNextNodeId = ReaderT (IORef NodeId) m NodeId -> NodeIdT m NodeId
forall (m :: * -> *) a. ReaderT (IORef NodeId) m a -> NodeIdT m a
NodeIdT (ReaderT (IORef NodeId) m NodeId -> NodeIdT m NodeId)
-> ReaderT (IORef NodeId) m NodeId -> NodeIdT m NodeId
forall a b. (a -> b) -> a -> b
$ do
    IORef NodeId
ref <- ReaderT (IORef NodeId) m (IORef NodeId)
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO NodeId -> ReaderT (IORef NodeId) m NodeId
forall a. IO a -> ReaderT (IORef NodeId) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NodeId -> ReaderT (IORef NodeId) m NodeId)
-> IO NodeId -> ReaderT (IORef NodeId) m NodeId
forall a b. (a -> b) -> a -> b
$ IORef NodeId -> IO NodeId
newNodeId IORef NodeId
ref

newNodeId :: IORef NodeId -> IO NodeId
newNodeId :: IORef NodeId -> IO NodeId
newNodeId IORef NodeId
ref = IORef NodeId -> (NodeId -> (NodeId, NodeId)) -> IO NodeId
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef NodeId
ref ((NodeId -> (NodeId, NodeId)) -> IO NodeId)
-> (NodeId -> (NodeId, NodeId)) -> IO NodeId
forall a b. (a -> b) -> a -> b
$ \(NodeId Integer
n) -> (Integer -> NodeId
NodeId (Integer -> NodeId) -> Integer -> NodeId
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Enum a => a -> a
succ Integer
n, Integer -> NodeId
NodeId Integer
n)