{-# 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)