{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Box.Box
( Box (..),
liftB,
bmap,
)
where
import Prelude
import Box.Committer
import Box.Emitter
import Control.Applicative
import Control.Lens hiding ((.>), (:>), (<|), (|>))
import Control.Monad.Conc.Class
data Box m c e
= Box
{ committer :: Committer m c,
emitter :: Emitter m e
}
instance (Functor m) => Profunctor (Box m) where
dimap f g (Box c e) = Box (contramap f c) (fmap g e)
instance (Alternative m, Monad m) => Semigroup (Box m c e) where
(<>) (Box c e) (Box c' e') = Box (c <> c') (e <> e')
instance (Alternative m, Monad m) => Monoid (Box m c e) where
mempty = Box mempty mempty
mappend = (<>)
liftB :: (MonadConc m) => Box (STM m) a b -> Box m a b
liftB (Box c e) = Box (liftC c) (liftE e)
bmap :: (Monad m) => (a' -> m (Maybe a)) -> (b -> m (Maybe b')) -> Box m a b -> Box m a' b'
bmap fc fe (Box c e) = Box (cmap fc c) (emap fe e)