{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Box.Plugs
( commitPlug
, emitPlug
, emitPlugM
, boxPlug
, boxForgetPlug
) where
import Box.Committer
import Box.Cont
import Box.Box
import Box.Queue
import Box.Emitter
import GHC.Conc
commitPlug :: (Emitter STM a -> IO ()) -> Cont IO (Committer STM a)
commitPlug eio = Cont $ \cio -> queueC cio eio
emitPlug :: (Committer STM a -> IO r) -> Cont IO (Emitter STM a)
emitPlug cio = Cont $ \eio -> queueE cio eio
emitPlugM :: (Committer IO a -> IO r) -> Cont IO (Emitter IO a)
emitPlugM cio = Cont $ \eio -> queueEM cio eio
boxPlug ::
(Emitter STM a -> IO ())
-> (Committer STM b -> IO ())
-> Cont IO (Box STM a b)
boxPlug eio cio = Box <$> commitPlug eio <*> emitPlug cio
boxForgetPlug :: (Box STM b a -> IO ()) -> Cont IO (Box STM a b)
boxForgetPlug bio = boxPlug (bio . Box mempty) (bio . (`Box` mempty))