{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Concurrent
-- Copyright   :  (C) 2016-2018 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.Concurrent (
    Notify (..)
  , newNotify
  , newEmptyNotify
  ) where

import Control.Concurrent

-- | Concurrent API for SkipChan implementation
data Notify = Notify {
    Notify -> IO ()
wait :: IO ()
  , Notify -> IO ()
notify :: IO ()
  }

-- | Create a new 'Notify'
newNotify :: IO Notify
newNotify :: IO Notify
newNotify = do
  MVar ()
mvar <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
  Notify -> IO Notify
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Notify -> IO Notify) -> Notify -> IO Notify
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> Notify
Notify
   (MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
mvar)
   (() () -> IO Bool -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar ()
mvar (() -> IO Bool) -> () -> IO Bool
forall a b. (a -> b) -> a -> b
$! ())

-- | Create a new 'Notify'
newEmptyNotify :: IO Notify
newEmptyNotify :: IO Notify
newEmptyNotify = do
  MVar ()
mvar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  Notify -> IO Notify
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Notify -> IO Notify) -> Notify -> IO Notify
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> Notify
Notify
   (MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
mvar)
   (() () -> IO Bool -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar ()
mvar (() -> IO Bool) -> () -> IO Bool
forall a b. (a -> b) -> a -> b
$! ())