module Data.Stream.Except where

-- base
import Control.Monad (ap)
import Data.Void

-- transformers
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except

-- mmorph
import Control.Monad.Morph (MFunctor, hoist)

-- selective
import Control.Selective

-- automaton
import Data.Stream.Final (Final (..))
import Data.Stream.Final.Except
import Data.Stream.Optimized (OptimizedStreamT, applyExcept, constM, selectExcept)
import Data.Stream.Optimized qualified as StreamOptimized

{- | A stream that can terminate with an exception.

In @automaton@, such streams mainly serve as a vehicle to bring control flow to 'Data.Automaton.Trans.Except.AutomatonExcept'
(which is based on 'StreamExcept'), and the docs there apply here as well.

'StreamExcept' is not only a 'Monad', it also has more efficient 'Selective', 'Applicative', and 'Functor' interfaces.
-}
data StreamExcept a m e
  = -- | When using '>>=', this encoding will be used.
    FinalExcept (Final (ExceptT e m) a)
  | -- | This is usually the faster encoding, as it can be optimized by GHC.
    InitialExcept (OptimizedStreamT (ExceptT e m) a)

toFinal :: (Functor m) => StreamExcept a m e -> Final (ExceptT e m) a
toFinal :: forall (m :: Type -> Type) a e.
Functor m =>
StreamExcept a m e -> Final (ExceptT e m) a
toFinal (FinalExcept Final (ExceptT e m) a
final) = Final (ExceptT e m) a
final
toFinal (InitialExcept OptimizedStreamT (ExceptT e m) a
initial) = OptimizedStreamT (ExceptT e m) a -> Final (ExceptT e m) a
forall (m :: Type -> Type) a.
Functor m =>
OptimizedStreamT m a -> Final m a
StreamOptimized.toFinal OptimizedStreamT (ExceptT e m) a
initial

runStreamExcept :: StreamExcept a m e -> OptimizedStreamT (ExceptT e m) a
runStreamExcept :: forall a (m :: Type -> Type) e.
StreamExcept a m e -> OptimizedStreamT (ExceptT e m) a
runStreamExcept (FinalExcept Final (ExceptT e m) a
final) = Final (ExceptT e m) a -> OptimizedStreamT (ExceptT e m) a
forall (m :: Type -> Type) a. Final m a -> OptimizedStreamT m a
StreamOptimized.fromFinal Final (ExceptT e m) a
final
runStreamExcept (InitialExcept OptimizedStreamT (ExceptT e m) a
initial) = OptimizedStreamT (ExceptT e m) a
initial

instance (Monad m) => Functor (StreamExcept a m) where
  fmap :: forall a b. (a -> b) -> StreamExcept a m a -> StreamExcept a m b
fmap a -> b
f (FinalExcept Final (ExceptT a m) a
fe) = Final (ExceptT b m) a -> StreamExcept a m b
forall a (m :: Type -> Type) e.
Final (ExceptT e m) a -> StreamExcept a m e
FinalExcept (Final (ExceptT b m) a -> StreamExcept a m b)
-> Final (ExceptT b m) a -> StreamExcept a m b
forall a b. (a -> b) -> a -> b
$ (forall a. ExceptT a m a -> ExceptT b m a)
-> Final (ExceptT a m) a -> Final (ExceptT b m) a
forall {k} (t :: (Type -> Type) -> k -> Type) (m :: Type -> Type)
       (n :: Type -> Type) (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a) -> Final m b -> Final n b
hoist ((a -> b) -> ExceptT a m a -> ExceptT b m a
forall (m :: Type -> Type) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT a -> b
f) Final (ExceptT a m) a
fe
  fmap a -> b
f (InitialExcept OptimizedStreamT (ExceptT a m) a
ae) = OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b
forall a (m :: Type -> Type) e.
OptimizedStreamT (ExceptT e m) a -> StreamExcept a m e
InitialExcept (OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b)
-> OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b
forall a b. (a -> b) -> a -> b
$ (forall a. ExceptT a m a -> ExceptT b m a)
-> OptimizedStreamT (ExceptT a m) a
-> OptimizedStreamT (ExceptT b m) a
forall {k} (t :: (Type -> Type) -> k -> Type) (m :: Type -> Type)
       (n :: Type -> Type) (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a)
-> OptimizedStreamT m b -> OptimizedStreamT n b
hoist ((a -> b) -> ExceptT a m a -> ExceptT b m a
forall (m :: Type -> Type) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT a -> b
f) OptimizedStreamT (ExceptT a m) a
ae

instance (Monad m) => Applicative (StreamExcept a m) where
  pure :: forall a. a -> StreamExcept a m a
pure = OptimizedStreamT (ExceptT a m) a -> StreamExcept a m a
forall a (m :: Type -> Type) e.
OptimizedStreamT (ExceptT e m) a -> StreamExcept a m e
InitialExcept (OptimizedStreamT (ExceptT a m) a -> StreamExcept a m a)
-> (a -> OptimizedStreamT (ExceptT a m) a)
-> a
-> StreamExcept a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT a m a -> OptimizedStreamT (ExceptT a m) a
forall (m :: Type -> Type) a. m a -> OptimizedStreamT m a
constM (ExceptT a m a -> OptimizedStreamT (ExceptT a m) a)
-> (a -> ExceptT a m a) -> a -> OptimizedStreamT (ExceptT a m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExceptT a m a
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE
  InitialExcept OptimizedStreamT (ExceptT (a -> b) m) a
f <*> :: forall a b.
StreamExcept a m (a -> b)
-> StreamExcept a m a -> StreamExcept a m b
<*> InitialExcept OptimizedStreamT (ExceptT a m) a
a = OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b
forall a (m :: Type -> Type) e.
OptimizedStreamT (ExceptT e m) a -> StreamExcept a m e
InitialExcept (OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b)
-> OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b
forall a b. (a -> b) -> a -> b
$ OptimizedStreamT (ExceptT (a -> b) m) a
-> OptimizedStreamT (ExceptT a m) a
-> OptimizedStreamT (ExceptT b m) a
forall (m :: Type -> Type) e1 e2 a.
Monad m =>
OptimizedStreamT (ExceptT (e1 -> e2) m) a
-> OptimizedStreamT (ExceptT e1 m) a
-> OptimizedStreamT (ExceptT e2 m) a
applyExcept OptimizedStreamT (ExceptT (a -> b) m) a
f OptimizedStreamT (ExceptT a m) a
a
  StreamExcept a m (a -> b)
f <*> StreamExcept a m a
a = StreamExcept a m (a -> b)
-> StreamExcept a m a -> StreamExcept a m b
forall (m :: Type -> Type) a b. Monad m => m (a -> b) -> m a -> m b
ap StreamExcept a m (a -> b)
f StreamExcept a m a
a

instance (Monad m) => Selective (StreamExcept a m) where
  select :: forall a b.
StreamExcept a m (Either a b)
-> StreamExcept a m (a -> b) -> StreamExcept a m b
select (InitialExcept OptimizedStreamT (ExceptT (Either a b) m) a
e) (InitialExcept OptimizedStreamT (ExceptT (a -> b) m) a
f) = OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b
forall a (m :: Type -> Type) e.
OptimizedStreamT (ExceptT e m) a -> StreamExcept a m e
InitialExcept (OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b)
-> OptimizedStreamT (ExceptT b m) a -> StreamExcept a m b
forall a b. (a -> b) -> a -> b
$ OptimizedStreamT (ExceptT (Either a b) m) a
-> OptimizedStreamT (ExceptT (a -> b) m) a
-> OptimizedStreamT (ExceptT b m) a
forall (m :: Type -> Type) e1 e2 a.
Monad m =>
OptimizedStreamT (ExceptT (Either e1 e2) m) a
-> OptimizedStreamT (ExceptT (e1 -> e2) m) a
-> OptimizedStreamT (ExceptT e2 m) a
selectExcept OptimizedStreamT (ExceptT (Either a b) m) a
e OptimizedStreamT (ExceptT (a -> b) m) a
f
  select StreamExcept a m (Either a b)
e StreamExcept a m (a -> b)
f = StreamExcept a m (Either a b)
-> StreamExcept a m (a -> b) -> StreamExcept a m b
forall (f :: Type -> Type) a b.
Monad f =>
f (Either a b) -> f (a -> b) -> f b
selectM StreamExcept a m (Either a b)
e StreamExcept a m (a -> b)
f

-- | 'return'/'pure' throw exceptions, '(>>=)' uses the last thrown exception as input for an exception handler.
instance (Monad m) => Monad (StreamExcept a m) where
  >> :: forall a b.
StreamExcept a m a -> StreamExcept a m b -> StreamExcept a m b
(>>) = StreamExcept a m a -> StreamExcept a m b -> StreamExcept a m b
forall a b.
StreamExcept a m a -> StreamExcept a m b -> StreamExcept a m b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
(*>)
  StreamExcept a m a
ae >>= :: forall a b.
StreamExcept a m a
-> (a -> StreamExcept a m b) -> StreamExcept a m b
>>= a -> StreamExcept a m b
f = Final (ExceptT b m) a -> StreamExcept a m b
forall a (m :: Type -> Type) e.
Final (ExceptT e m) a -> StreamExcept a m e
FinalExcept (Final (ExceptT b m) a -> StreamExcept a m b)
-> Final (ExceptT b m) a -> StreamExcept a m b
forall a b. (a -> b) -> a -> b
$ Final (ExceptT a m) a
-> (a -> Final (ExceptT b m) a) -> Final (ExceptT b m) a
forall (m :: Type -> Type) e1 b e2.
Monad m =>
Final (ExceptT e1 m) b
-> (e1 -> Final (ExceptT e2 m) b) -> Final (ExceptT e2 m) b
handleExceptT (StreamExcept a m a -> Final (ExceptT a m) a
forall (m :: Type -> Type) a e.
Functor m =>
StreamExcept a m e -> Final (ExceptT e m) a
toFinal StreamExcept a m a
ae) (StreamExcept a m b -> Final (ExceptT b m) a
forall (m :: Type -> Type) a e.
Functor m =>
StreamExcept a m e -> Final (ExceptT e m) a
toFinal (StreamExcept a m b -> Final (ExceptT b m) a)
-> (a -> StreamExcept a m b) -> a -> Final (ExceptT b m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StreamExcept a m b
f)

instance MonadTrans (StreamExcept a) where
  lift :: forall (m :: Type -> Type) a. Monad m => m a -> StreamExcept a m a
lift = OptimizedStreamT (ExceptT a m) a -> StreamExcept a m a
forall a (m :: Type -> Type) e.
OptimizedStreamT (ExceptT e m) a -> StreamExcept a m e
InitialExcept (OptimizedStreamT (ExceptT a m) a -> StreamExcept a m a)
-> (m a -> OptimizedStreamT (ExceptT a m) a)
-> m a
-> StreamExcept a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT a m a -> OptimizedStreamT (ExceptT a m) a
forall (m :: Type -> Type) a. m a -> OptimizedStreamT m a
constM (ExceptT a m a -> OptimizedStreamT (ExceptT a m) a)
-> (m a -> ExceptT a m a)
-> m a
-> OptimizedStreamT (ExceptT a m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either a a) -> ExceptT a m a
forall e (m :: Type -> Type) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either a a) -> ExceptT a m a)
-> (m a -> m (Either a a)) -> m a -> ExceptT a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either a a) -> m a -> m (Either a a)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a a
forall a b. a -> Either a b
Left

instance MFunctor (StreamExcept a) where
  hoist :: forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a) -> StreamExcept a m b -> StreamExcept a n b
hoist forall a. m a -> n a
morph (InitialExcept OptimizedStreamT (ExceptT b m) a
automaton) = OptimizedStreamT (ExceptT b n) a -> StreamExcept a n b
forall a (m :: Type -> Type) e.
OptimizedStreamT (ExceptT e m) a -> StreamExcept a m e
InitialExcept (OptimizedStreamT (ExceptT b n) a -> StreamExcept a n b)
-> OptimizedStreamT (ExceptT b n) a -> StreamExcept a n b
forall a b. (a -> b) -> a -> b
$ (forall a. ExceptT b m a -> ExceptT b n a)
-> OptimizedStreamT (ExceptT b m) a
-> OptimizedStreamT (ExceptT b n) a
forall {k} (t :: (Type -> Type) -> k -> Type) (m :: Type -> Type)
       (n :: Type -> Type) (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a)
-> OptimizedStreamT m b -> OptimizedStreamT n b
hoist ((m (Either b a) -> n (Either b a))
-> ExceptT b m a -> ExceptT b n a
forall (m :: Type -> Type) e a (n :: Type -> Type) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either b a) -> n (Either b a)
forall a. m a -> n a
morph) OptimizedStreamT (ExceptT b m) a
automaton
  hoist forall a. m a -> n a
morph (FinalExcept Final (ExceptT b m) a
final) = Final (ExceptT b n) a -> StreamExcept a n b
forall a (m :: Type -> Type) e.
Final (ExceptT e m) a -> StreamExcept a m e
FinalExcept (Final (ExceptT b n) a -> StreamExcept a n b)
-> Final (ExceptT b n) a -> StreamExcept a n b
forall a b. (a -> b) -> a -> b
$ (forall a. ExceptT b m a -> ExceptT b n a)
-> Final (ExceptT b m) a -> Final (ExceptT b n) a
forall {k} (t :: (Type -> Type) -> k -> Type) (m :: Type -> Type)
       (n :: Type -> Type) (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a) -> Final m b -> Final n b
hoist ((m (Either b a) -> n (Either b a))
-> ExceptT b m a -> ExceptT b n a
forall (m :: Type -> Type) e a (n :: Type -> Type) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either b a) -> n (Either b a)
forall a. m a -> n a
morph) Final (ExceptT b m) a
final

safely :: (Monad m) => StreamExcept a m Void -> OptimizedStreamT m a
safely :: forall (m :: Type -> Type) a.
Monad m =>
StreamExcept a m Void -> OptimizedStreamT m a
safely = (forall a. ExceptT Void m a -> m a)
-> OptimizedStreamT (ExceptT Void m) a -> OptimizedStreamT m a
forall {k} (t :: (Type -> Type) -> k -> Type) (m :: Type -> Type)
       (n :: Type -> Type) (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: Type -> Type) (n :: Type -> Type) b.
Monad m =>
(forall a. m a -> n a)
-> OptimizedStreamT m b -> OptimizedStreamT n b
hoist ((Either Void a -> a) -> m (Either Void a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Void -> a) -> (a -> a) -> Either Void a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> a
forall a. Void -> a
absurd a -> a
forall a. a -> a
id) (m (Either Void a) -> m a)
-> (ExceptT Void m a -> m (Either Void a))
-> ExceptT Void m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT Void m a -> m (Either Void a)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT) (OptimizedStreamT (ExceptT Void m) a -> OptimizedStreamT m a)
-> (StreamExcept a m Void -> OptimizedStreamT (ExceptT Void m) a)
-> StreamExcept a m Void
-> OptimizedStreamT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamExcept a m Void -> OptimizedStreamT (ExceptT Void m) a
forall a (m :: Type -> Type) e.
StreamExcept a m e -> OptimizedStreamT (ExceptT e m) a
runStreamExcept