{-# LANGUAGE BlockArguments, LambdaCase #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-} module Control.Moffy.Samples.Run.TChan where import Control.Monad.Trans import Control.Moffy import Control.Moffy.Run (Handle, HandleSt, St) import Control.Concurrent.STM import qualified Control.Moffy.Run as M import Data.Map interpret :: (MonadIO m, Adjustable es es') => Handle m es' -> TChan a -> Sig s es a r -> m r interpret :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) a s r. (MonadIO m, Adjustable es es') => Handle m es' -> TChan a -> Sig s es a r -> m r interpret Handle m es' h TChan a c = forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) a s r. (Monad m, Adjustable es es') => Handle m es' -> (a -> m ()) -> Sig s es a r -> m r M.interpret Handle m es' h (forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. STM a -> IO a atomically forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. TChan a -> a -> STM () writeTChan TChan a c) interpretSt :: (MonadIO m, Adjustable es es') => HandleSt st m es' -> TChan a -> Sig s es a r -> St st m r interpretSt :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st a s r. (MonadIO m, Adjustable es es') => HandleSt st m es' -> TChan a -> Sig s es a r -> St st m r interpretSt HandleSt st m es' h TChan a c = forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st a s r. (Monad m, Adjustable es es') => HandleSt st m es' -> (a -> m ()) -> Sig s es a r -> St st m r M.interpretSt HandleSt st m es' h (forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. STM a -> IO a atomically forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. TChan a -> a -> STM () writeTChan TChan a c) interpretSt' :: (MonadIO m, Adjustable es es', Ord k) => HandleSt st m es' -> TVar (Map k v) -> TChan a -> Sig s es ([(k, Maybe v)], a) r -> St st m r interpretSt' :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) k st v a s r. (MonadIO m, Adjustable es es', Ord k) => HandleSt st m es' -> TVar (Map k v) -> TChan a -> Sig s es ([(k, Maybe v)], a) r -> St st m r interpretSt' HandleSt st m es' h TVar (Map k v) vm TChan a c = forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st a s r. (Monad m, Adjustable es es') => HandleSt st m es' -> (a -> m ()) -> Sig s es a r -> St st m r M.interpretSt HandleSt st m es' h \([(k, Maybe v)] kvs, a x) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a. STM a -> IO a atomically do forall a. TVar a -> (a -> a) -> STM () modifyTVar TVar (Map k v) vm forall a b. (a -> b) -> a -> b $ forall a b c. (a -> b -> c) -> b -> a -> c flip (forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b Prelude.foldr (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall k a. Ord k => k -> Maybe a -> Map k a -> Map k a maybeInsert)) [(k, Maybe v)] kvs forall a. TChan a -> a -> STM () writeTChan TChan a c a x maybeInsert :: Ord k => k -> Maybe a -> Map k a -> Map k a maybeInsert :: forall k a. Ord k => k -> Maybe a -> Map k a -> Map k a maybeInsert k k = \case Maybe a Nothing -> forall k a. Ord k => k -> Map k a -> Map k a delete k k; Just a v -> forall k a. Ord k => k -> a -> Map k a -> Map k a insert k k a v