{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-} module Control.Moffy.Samples.Handle.Area where import Control.Concurrent.STM import Control.Moffy.Handle import Control.Moffy.Samples.Event.Area import Data.Type.Set import Data.OneOrMore qualified as Oom import Data.OneOrMoreApp qualified as App import Data.Map qualified as M handle :: TVar (M.Map Int (Point, Point)) -> Handle' IO (SetArea :- Singleton GetArea) handle :: TVar (Map Int (Point, Point)) -> Handle' IO (SetArea :- Singleton GetArea) handle TVar (Map Int (Point, Point)) vm = TVar (Map Int (Point, Point)) -> Handle' IO (Singleton SetArea) handleSetArea TVar (Map Int (Point, Point)) vm forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)). (Applicative m, ExpandableHandle es (es :+: es'), ExpandableHandle es' (es :+: es'), MergeableOccurred es es' (es :+: es')) => Handle' m es -> Handle' m es' -> Handle' m (es :+: es') `merge` TVar (Map Int (Point, Point)) -> Handle' IO (Singleton GetArea) handleGetArea TVar (Map Int (Point, Point)) vm handleSetArea :: TVar (M.Map Int (Point, Point)) -> Handle' IO (Singleton SetArea) handleSetArea :: TVar (Map Int (Point, Point)) -> Handle' IO (Singleton SetArea) handleSetArea TVar (Map Int (Point, Point)) vm (Oom.Singleton (SetAreaReq Int i Point ul Point dr)) = do forall a. STM a -> IO a atomically forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. TVar a -> (a -> a) -> STM () modifyTVar TVar (Map Int (Point, Point)) vm forall a b. (a -> b) -> a -> b $ forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert Int i (Point ul, Point dr) forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a)) App.Singleton Occurred SetArea OccSetArea handleGetArea :: TVar (M.Map Int (Point, Point)) -> Handle' IO (Singleton GetArea) handleGetArea :: TVar (Map Int (Point, Point)) -> Handle' IO (Singleton GetArea) handleGetArea TVar (Map Int (Point, Point)) vm (Oom.Singleton (GetAreaReq Int i)) = do (forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a)) App.Singleton forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b c. (a -> b -> c) -> (a, b) -> c uncurry (Int -> Point -> Point -> Occurred GetArea OccGetArea Int i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. STM a -> IO a atomically ((forall k a. Ord k => k -> Map k a -> Maybe a M.lookup Int i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. TVar a -> STM a readTVar TVar (Map Int (Point, Point)) vm)