{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Copyright  : (c) Ivan Perez and Manuel Baerenz, 2016
-- License    : BSD3
-- Maintainer : ivan.perez@keera.co.uk
--
-- Instance of 'ArrowChoice' for Monadic Stream Functions ('MSF').
--
-- Import this module to include that (orphan) instance.
module Data.MonadicStreamFunction.Instances.ArrowChoice where

-- External imports
import Control.Arrow (ArrowChoice (..))

-- Internal imports
import Data.MonadicStreamFunction.Core         ()
import Data.MonadicStreamFunction.InternalCore (MSF (MSF, unMSF))

-- | 'ArrowChoice' instance for MSFs.
instance Monad m => ArrowChoice (MSF m) where
  left :: MSF m a b -> MSF m (Either a c) (Either b c)
  left :: forall b c d. MSF m b c -> MSF m (Either b d) (Either c d)
left MSF m a b
sf = (Either a c -> m (Either b c, MSF m (Either a c) (Either b c)))
-> MSF m (Either a c) (Either b c)
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF Either a c -> m (Either b c, MSF m (Either a c) (Either b c))
forall {b} {d}.
Either a b -> m (Either b b, MSF m (Either a d) (Either b d))
f
    where
      f :: Either a b -> m (Either b b, MSF m (Either a d) (Either b d))
f (Left a
a) = do (b
b, MSF m a b
sf') <- MSF m a b -> a -> m (b, MSF m a b)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF MSF m a b
sf a
a
                      (Either b b, MSF m (Either a d) (Either b d))
-> m (Either b b, MSF m (Either a d) (Either b d))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either b b
forall a b. a -> Either a b
Left b
b, MSF m a b -> MSF m (Either a d) (Either b d)
forall b c d. MSF m b c -> MSF m (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MSF m a b
sf')
      f (Right b
c) = (Either b b, MSF m (Either a d) (Either b d))
-> m (Either b b, MSF m (Either a d) (Either b d))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either b b
forall a b. b -> Either a b
Right b
c, MSF m a b -> MSF m (Either a d) (Either b d)
forall b c d. MSF m b c -> MSF m (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MSF m a b
sf)