Simple.hs

-- | Simple compatability newtype wrappers to standard queues used in the Haskell wild.
{-# LANGUAGE TypeFamilies #-}
module Control.Concurrent.EQueue.Simple (
    JustOneEventually(..)
  , ChanEQueue(..)
  , TChanEQueue(..)
  , TQueueEQueue(..)
  , IOEQueue(..)
  ) where

import Control.Concurrent.Chan
import Control.Concurrent.EQueue.Class
import Control.Concurrent.STM
import Control.Monad.Trans

-- | A policy for waiting until a single event can be gotten and returning just one.
--   Since these standard queing options are fairly simple the don't allows more
--   detailed policies abiding by EQueue's laws.
data JustOneEventually = JustOneEventually

-- | A wrapper for EQueueing events into a Chan.
newtype ChanEQueue a = CEQ (Chan a)

{- | Can not unregister events -}
instance EQueue ChanEQueue where
  registerSemi (CEQ c) f = return (writeChan c . f, return ())
  registerQueued (CEQ c) = return (writeChan c, return ())

instance EQueueW ChanEQueue where
  type WaitPolicy ChanEQueue = JustOneEventually
  waitEQ (CEQ c) JustOneEventually = fmap pure . liftIO . readChan $ c

-- | A wrapper for EQueueing events into a TChan.
newtype TChanEQueue a = TCEQ (TChan a)

{- | Can not unregister events -}
instance EQueue TChanEQueue where
  registerSemi (TCEQ c) f = return (atomically . writeTChan c . f, return ())
  registerQueued (TCEQ c) = return (atomically . writeTChan c, return ())

instance EQueueW TChanEQueue where
  type WaitPolicy TChanEQueue = JustOneEventually
  waitEQ (TCEQ c) JustOneEventually = fmap pure . liftIO . atomically . readTChan $ c

-- | A wrapper for EQueueing events into a TQueue.
newtype TQueueEQueue a = TQEQ (TQueue a)

{- | Can not unregister events -}
instance EQueue TQueueEQueue where
  registerSemi (TQEQ c) f = return (atomically . writeTQueue c . f, return ())
  registerQueued (TQEQ c) = return (atomically . writeTQueue c, return ())

instance EQueueW TQueueEQueue where
  type WaitPolicy TQueueEQueue = JustOneEventually
  waitEQ (TQEQ c) JustOneEventually = fmap pure . liftIO . atomically . readTQueue $ c

-- | A wrapper for EQueueing events that we have an IO action to submit.
newtype IOEQueue a = IOEQ (a -> IO ())

instance EQueue IOEQueue where
  registerSemi (IOEQ act) f = return (act . f, return ())
  registerQueued (IOEQ act) = return (act, return ())