{-|
Module: Control.Monad.NodeId
Description: Monad providing a supply of unique identifiers
-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.NodeId
  ( NodeId
  , MonadNodeId (..)
  , NodeIdT
  , runNodeIdT
  ) where

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
/= :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c== :: 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
min :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmax :: NodeId -> NodeId -> NodeId
>= :: NodeId -> NodeId -> Bool
$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
compare :: NodeId -> NodeId -> Ordering
$ccompare :: NodeId -> NodeId -> Ordering
$cp1Ord :: Eq 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
showList :: [NodeId] -> ShowS
$cshowList :: [NodeId] -> ShowS
show :: NodeId -> String
$cshow :: NodeId -> String
showsPrec :: Int -> NodeId -> ShowS
$cshowsPrec :: Int -> 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 (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 { NodeIdT m a -> ReaderT (IORef NodeId) m a
unNodeIdT :: ReaderT (IORef NodeId) m a }
  deriving
    ( a -> NodeIdT m b -> NodeIdT m a
(a -> b) -> NodeIdT m a -> NodeIdT m b
(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
<$ :: a -> NodeIdT m b -> NodeIdT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> NodeIdT m b -> NodeIdT m a
fmap :: (a -> b) -> NodeIdT m a -> NodeIdT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NodeIdT m a -> NodeIdT m b
Functor
    , Functor (NodeIdT m)
a -> NodeIdT m a
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)
NodeIdT m a -> NodeIdT m b -> NodeIdT m b
NodeIdT m a -> NodeIdT m b -> NodeIdT m a
NodeIdT m (a -> b) -> NodeIdT m a -> NodeIdT m b
(a -> b -> c) -> NodeIdT m a -> NodeIdT m b -> NodeIdT m c
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
<* :: NodeIdT m a -> NodeIdT m b -> NodeIdT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m a
*> :: NodeIdT m a -> NodeIdT m b -> NodeIdT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m b
liftA2 :: (a -> b -> c) -> NodeIdT m a -> NodeIdT m b -> NodeIdT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NodeIdT m a -> NodeIdT m b -> NodeIdT m c
<*> :: NodeIdT m (a -> b) -> NodeIdT m a -> NodeIdT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
NodeIdT m (a -> b) -> NodeIdT m a -> NodeIdT m b
pure :: a -> NodeIdT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> NodeIdT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (NodeIdT m)
Applicative
    , Applicative (NodeIdT m)
a -> NodeIdT m a
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)
NodeIdT m a -> (a -> NodeIdT m b) -> NodeIdT m b
NodeIdT m a -> NodeIdT m b -> NodeIdT m b
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
return :: a -> NodeIdT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> NodeIdT m a
>> :: NodeIdT m a -> NodeIdT m b -> NodeIdT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
NodeIdT m a -> NodeIdT m b -> NodeIdT m b
>>= :: NodeIdT m a -> (a -> NodeIdT m b) -> NodeIdT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
NodeIdT m a -> (a -> NodeIdT m b) -> NodeIdT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (NodeIdT m)
Monad
    , Monad (NodeIdT m)
Monad (NodeIdT m) =>
(forall a. (a -> NodeIdT m a) -> NodeIdT m a)
-> MonadFix (NodeIdT m)
(a -> NodeIdT m a) -> NodeIdT m a
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
mfix :: (a -> NodeIdT m a) -> NodeIdT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> NodeIdT m a) -> NodeIdT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (NodeIdT m)
MonadFix
    , MonadHold t
    , Monad (NodeIdT m)
Monad (NodeIdT m) =>
(forall a. IO a -> NodeIdT m a) -> MonadIO (NodeIdT m)
IO a -> NodeIdT m a
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
liftIO :: IO a -> NodeIdT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> NodeIdT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (NodeIdT m)
MonadIO
    , MonadReflexCreateTrigger t
    , MonadSample t
    , m a -> NodeIdT m a
(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
lift :: m a -> NodeIdT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> NodeIdT m a
MonadTrans
    , NotReady t
    , PerformEvent t
    , PostBuild t
    , TriggerEvent t
    , Monad (NodeIdT m)
a -> NodeIdT m (Ref (NodeIdT m) a)
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)
Ref (NodeIdT m) a -> NodeIdT m a
Ref (NodeIdT m) a -> a -> NodeIdT m ()
Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
Ref (NodeIdT m) a -> (a -> a) -> 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 ()
modifyRef' :: Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
$cmodifyRef' :: forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
modifyRef :: Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
$cmodifyRef :: forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> (a -> a) -> NodeIdT m ()
writeRef :: Ref (NodeIdT m) a -> a -> NodeIdT m ()
$cwriteRef :: forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> a -> NodeIdT m ()
readRef :: Ref (NodeIdT m) a -> NodeIdT m a
$creadRef :: forall (m :: * -> *) a.
MonadRef m =>
Ref (NodeIdT m) a -> NodeIdT m a
newRef :: a -> NodeIdT m (Ref (NodeIdT m) a)
$cnewRef :: forall (m :: * -> *) a.
MonadRef m =>
a -> NodeIdT m (Ref (NodeIdT m) a)
$cp1MonadRef :: forall (m :: * -> *). MonadRef m => Monad (NodeIdT m)
MonadRef
    )

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 :: NodeIdT m a -> Event t (NodeIdT m b) -> NodeIdT m (a, Event t b)
runWithReplace (NodeIdT a :: ReaderT (IORef NodeId) m a
a) e :: 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 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 (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 :: (Int -> v -> NodeIdT m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> NodeIdT m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust f :: Int -> v -> NodeIdT m v'
f m :: IntMap v
m e :: 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 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 (\k :: Int
k v :: 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 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 f :: forall a. k a -> v a -> NodeIdT m (v' a)
f m :: DMap k v
m e :: 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'))
traverseDMapWithKeyWithAdjust (\k :: k a
k v :: 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 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 f :: forall a. k a -> v a -> NodeIdT m (v' a)
f m :: DMap k v
m e :: 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'))
traverseDMapWithKeyWithAdjustWithMove (\k :: k a
k v :: 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 :: NodeIdT m a -> m a
runNodeIdT a :: NodeIdT m a
a = do
  IORef NodeId
ref <- IO (IORef NodeId) -> m (IORef NodeId)
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 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 (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 ref :: 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 n :: 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)