{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Control.Moffy.Handle.Lock (
LockEv, LockState(..), LockId,
handleLock ) where
import Control.Moffy.Event.Lock.Internal (
LockEv, LockId(..), NewLockId(..), pattern OccNewLockId,
GetLock(..), pattern OccGetLock, Unlock(..), pattern OccUnlock )
import Control.Moffy.Handle (HandleSt', mergeSt)
import Data.Type.Set (Singleton)
import Data.OneOrMore as Oom (pattern Singleton)
import Data.Bool (bool)
import Data.OneOrMoreApp as Ooma (pattern Singleton)
class LockState s where
getNextLockId :: s -> Int; putNextLockId :: s -> Int -> s
isLocked :: s -> LockId -> Bool
lockIt :: s -> LockId -> s; unlockIt :: s -> LockId -> s
handleLock :: (LockState s, Monad m) => HandleSt' s m LockEv
handleLock :: forall s (m :: * -> *).
(LockState s, Monad m) =>
HandleSt' s m LockEv
handleLock = forall s (m :: * -> *).
(LockState s, Applicative m) =>
HandleSt' s m (Singleton NewLockId)
handleNewLockId forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
ExpandableHandle es' (es :+: es'),
MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt` forall s (m :: * -> *).
(LockState s, Applicative m) =>
HandleSt' s m (Singleton GetLock)
handleGetLock forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
ExpandableHandle es' (es :+: es'),
MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt` forall s (m :: * -> *).
(LockState s, Applicative m) =>
HandleSt' s m (Unlock ':~ 'Nil)
handleUnlock
handleNewLockId ::
(LockState s, Applicative m) => HandleSt' s m (Singleton NewLockId)
handleNewLockId :: forall s (m :: * -> *).
(LockState s, Applicative m) =>
HandleSt' s m (Singleton NewLockId)
handleNewLockId (Oom.Singleton (NewLockIdReq ThreadId
t)) s
s = forall (f :: * -> *) a. Applicative f => a -> f a
pure (
forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton forall a b. (a -> b) -> a -> b
$ LockId -> ThreadId -> Occurred NewLockId
OccNewLockId (Int -> LockId
LockId Int
i) ThreadId
t,
s
s forall s. LockState s => s -> Int -> s
`putNextLockId` (Int
i forall a. Num a => a -> a -> a
+ Int
1) )
where i :: Int
i = forall s. LockState s => s -> Int
getNextLockId s
s
handleGetLock ::
(LockState s, Applicative m) => HandleSt' s m (Singleton GetLock)
handleGetLock :: forall s (m :: * -> *).
(LockState s, Applicative m) =>
HandleSt' s m (Singleton GetLock)
handleGetLock (Oom.Singleton (GetLockReq LockId
i ThreadId
t Int
_)) s
s = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Bool -> a
bool
(forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton forall a b. (a -> b) -> a -> b
$ LockId -> ThreadId -> Occurred GetLock
OccGetLock LockId
i ThreadId
t, s
s forall s. LockState s => s -> LockId -> s
`lockIt` LockId
i) (forall a. Maybe a
Nothing, s
s)
(s
s forall s. LockState s => s -> LockId -> Bool
`isLocked` LockId
i)
handleUnlock :: (LockState s, Applicative m) => HandleSt' s m (Singleton Unlock)
handleUnlock :: forall s (m :: * -> *).
(LockState s, Applicative m) =>
HandleSt' s m (Unlock ':~ 'Nil)
handleUnlock (Oom.Singleton (UnlockReq LockId
i)) s
s =
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton Occurred Unlock
OccUnlock, s
s forall s. LockState s => s -> LockId -> s
`unlockIt` LockId
i)