{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Instance of 'ArrowPlus' for Monadic Stream Functions ('MSF').
--
--   Import this module to include that (orphan) instance.
--
--   This is only defined for monads that are instances of 'MonadPlus'.
module Data.MonadicStreamFunction.Instances.ArrowPlus where

-- base
import Control.Arrow
import Control.Monad
import Control.Applicative

-- dunai
import Data.MonadicStreamFunction.Core
import Data.MonadicStreamFunction.InternalCore

-- | Instance of 'ArrowZero' for Monadic Stream Functions ('MSF').
--   The monad must be an instance of 'MonadPlus'.
instance (Monad m, MonadPlus m) => ArrowZero (MSF m) where
  zeroArrow :: MSF m b c
zeroArrow = (b -> m (c, MSF m b c)) -> MSF m b c
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((b -> m (c, MSF m b c)) -> MSF m b c)
-> (b -> m (c, MSF m b c)) -> MSF m b c
forall a b. (a -> b) -> a -> b
$ m (c, MSF m b c) -> b -> m (c, MSF m b c)
forall a b. a -> b -> a
const m (c, MSF m b c)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Instance of 'ArrowPlus' for Monadic Stream Functions ('MSF').
--   The monad must be an instance of 'MonadPlus'.
instance (Monad m, MonadPlus m) => ArrowPlus (MSF m) where
  MSF m b c
sf1 <+> :: MSF m b c -> MSF m b c -> MSF m b c
<+> MSF m b c
sf2 = (b -> m (c, MSF m b c)) -> MSF m b c
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF ((b -> m (c, MSF m b c)) -> MSF m b c)
-> (b -> m (c, MSF m b c)) -> MSF m b c
forall a b. (a -> b) -> a -> b
$ \b
a -> MSF m b c -> b -> m (c, MSF m b c)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF MSF m b c
sf1 b
a m (c, MSF m b c) -> m (c, MSF m b c) -> m (c, MSF m b c)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` MSF m b c -> b -> m (c, MSF m b c)
forall (m :: * -> *) a b. MSF m a b -> a -> m (b, MSF m a b)
unMSF MSF m b c
sf2 b
a

instance (Functor m, Monad m, MonadPlus m) => Alternative (MSF m a) where
  empty :: MSF m a a
empty = MSF m a a
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow
  <|> :: MSF m a a -> MSF m a a -> MSF m a a
(<|>) = MSF m a a -> MSF m a a -> MSF m a a
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
(<+>)