ProBus.purs

module Control.Monad.Aff.ProBus where

import Prelude

import Control.Monad.Aff (Error, forkAff)
import Control.Monad.Aff.Bus (BusR, BusR', BusRW, BusW, BusW')
import Control.Monad.Aff.Bus as Bus
import Control.Monad.Aff.Class (class MonadAff, liftAff)
import Control.Monad.Eff.AVar (AVAR)
import Control.Monad.Eff.Class (class MonadEff, liftEff)
import Control.Monad.Rec.Class (forever)
import Data.Tuple (Tuple(..))
import Unsafe.Coerce (unsafeCoerce)

newtype ProBus i o = ProBus (Tuple (BusW i) (BusR o))

dimapM
  :: forall a b c d m eff
   . MonadAff (avar :: AVAR | eff) m
  => (a -> b)
  -> (c -> d)
  -> ProBus b c
  -> m (ProBus a d)
dimapM a2b c2d (ProBus (Tuple busBIn busCOut)) = do
  busCOut' <- busMapM c2d busCOut
  busBIn' <- busCmapM a2b busBIn
  pure $ ProBus $ Tuple busBIn' busCOut'

busMapM
  :: forall m eff r a b
  . MonadAff (avar :: AVAR | eff) m
  => (a -> b)
  -> BusR' r a
  -> m (BusR' r b)
busMapM f bIn = do
  newB <- liftAff $ Bus.make
  liftAff $ void $ forkAff $ forever do
    x <- Bus.read bIn
    Bus.write (f x) newB
  pure $ (unsafeCoerce :: BusRW b -> BusR' r b) newB

busCmapM
  :: forall m eff r a b
  . MonadAff (avar :: AVAR | eff) m
  => (b -> a)
  -> BusW' r a
  -> m (BusW' r b)
busCmapM f bIn = do
  newB <- liftAff $ Bus.make
  liftAff $ void $ forkAff $ forever do
    x <- Bus.read newB
    Bus.write (f x) bIn
  pure $ (unsafeCoerce :: BusRW b -> BusW' r b) newB

make
  :: forall m eff i o
  . MonadEff (avar :: AVAR | eff) m
  => m (Tuple (ProBus i o) (ProBus o i))
make = do
  Tuple busInR busInW <- liftEff $ Bus.split <$> Bus.make
  Tuple busOutR busOutW <- liftEff $ Bus.split <$> Bus.make
  let proIO = ProBus $ Tuple busInW busOutR
  let proOI = ProBus $ Tuple busOutW busInR
  pure $ Tuple proIO proOI

input
  :: forall m i o eff
  . MonadAff (avar :: AVAR | eff) m
  => i
  -> ProBus i o
  -> m Unit
input i (ProBus (Tuple bIn bOut)) =
  liftAff $ Bus.write i bIn

output
  :: forall m i o eff
  . MonadAff (avar :: AVAR | eff) m
  => ProBus i o
  -> m o
output (ProBus (Tuple bIn bOut)) =
  liftAff $ Bus.read bOut

kill
  :: forall m i o eff
  . MonadAff (avar :: AVAR | eff) m
  => Error
  -> ProBus i o
  -> ProBus o i
  -> m Unit
kill err bIO bOI = do
  killIn bIO
  killIn bOI
  where
  killIn :: forall i' o' . ProBus i' o' -> m Unit
  killIn (ProBus (Tuple bIn bOut)) =
    liftAff $ Bus.kill err bIn