{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Moffy.Handle.Lock (
	-- * Type
	LockEv, LockState(..), LockId,
	-- * Handle
	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)

---------------------------------------------------------------------------

-- * LOCK STATE
-- * HANDLE

---------------------------------------------------------------------------
-- LOCK STATE
---------------------------------------------------------------------------

class LockState s where
	getNextLockId :: s -> Int; putNextLockId :: s -> Int -> s
	isLocked :: s -> LockId -> Bool
	lockIt :: s -> LockId -> s; unlockIt :: s -> LockId -> s

---------------------------------------------------------------------------
-- HANDLE
---------------------------------------------------------------------------

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)