{-# LANGUAGE ExistentialQuantification #-}
{- |
Process chunks of data in the IO monad.
Typical inputs are strict storable vectors and piecewise constant values,
and typical outputs are strict storable vectors.
You may also combine several of these types using the Zip type constructor.

We may substitute IO by ST in the future, but I am uncertain about that.
On the one hand, the admissible IO functionality is very restricted,
only memory manipulation is allowed,
on the other hand we use ForeignPtrs that are not part of ST framework.
-}
module Synthesizer.CausalIO.Process (
   T(Cons),
   fromCausal,
   mapAccum,
   Synthesizer.CausalIO.Process.traverse,
   runCont,
   runStorableChunkyCont,
   zip,
   continue,
   continueChunk,
   ) where

import qualified Synthesizer.Causal.Process as Causal

import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Cut as CutG
import qualified Synthesizer.Zip as Zip

import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV

import Foreign.Storable (Storable, )

import qualified Control.Monad.Trans.State as MS
import qualified Control.Arrow    as Arr
import qualified Control.Category as Cat
import Control.Arrow ((^<<), (&&&), )
import Control.Monad (mplus, )

import Data.Monoid (Monoid, mempty, mappend, )
import Data.Semigroup (Semigroup, (<>), )

import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO, )

import Prelude hiding (zip, )


{-
Like the Causal arrow but unlike the Causal arrow from @synthesizer-llvm@,
we are not using a parameter type @p@.
In order to parameterize the process,
you simply use a plain Haskell function, i.e. @p -> T a b@.
This way, we do not need the Parameter type from @synthesizer-llvm@.
However, the internal state type can depend
on the value of parameters.
This may be an advantage or a disadvantage, I do not know.
-}
data T a b =
   forall state.
   Cons
      {-
      If the transition function returns a chunk
      that is shorter than the input,
      then this is the last chunk.
      This way we do not need a MaybeT IO.
      -}
      (a -> state -> IO (b, state))
      (IO state)
      {-
      The delete function must not do anything serious,
      e.g. close files,
      because it might not be called.
      Something like 'touchForeignPtr' is reasonable.
      -}
      (state -> IO ())


instance Cat.Category T where
   id :: forall a. T a a
id = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arr.arr forall a. a -> a
id
   (Cons b -> state -> IO (c, state)
nextB IO state
createB state -> IO ()
deleteB) . :: forall b c a. T b c -> T a b -> T a c
.
          (Cons a -> state -> IO (b, state)
nextA IO state
createA state -> IO ()
deleteA) = forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
      (\a
a (state
sa0,state
sb0) -> do
         (b
b,state
sa1) <- a -> state -> IO (b, state)
nextA a
a state
sa0
         (c
c,state
sb1) <- b -> state -> IO (c, state)
nextB b
b state
sb0
         forall (m :: * -> *) a. Monad m => a -> m a
return (c
c,(state
sa1,state
sb1)))
      (do
         state
sa <- IO state
createA
         state
sb <- IO state
createB
         forall (m :: * -> *) a. Monad m => a -> m a
return (state
sa,state
sb))
      (\(state
sa,state
sb) ->
         state -> IO ()
deleteA state
sa forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> state -> IO ()
deleteB state
sb)

instance Arr.Arrow T where
   arr :: forall b c. (b -> c) -> T b c
arr b -> c
f = forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
      (\ b
a () -> forall (m :: * -> *) a. Monad m => a -> m a
return (b -> c
f b
a, ()))
      (forall (m :: * -> *) a. Monad m => a -> m a
return ())
      (\ () -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
   first :: forall b c d. T b c -> T (b, d) (c, d)
first (Cons b -> state -> IO (c, state)
next IO state
create state -> IO ()
delete) = forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
      (\(b
b,d
d) state
sa0 ->
         do (c
c,state
sa1) <- b -> state -> IO (c, state)
next b
b state
sa0
            forall (m :: * -> *) a. Monad m => a -> m a
return ((c
c,d
d), state
sa1))
      IO state
create
      state -> IO ()
delete

fromCausal ::
   (Monoid b) =>
   Causal.T a b -> T a b
fromCausal :: forall b a. Monoid b => T a b -> T a b
fromCausal (Causal.Cons a -> StateT s Maybe b
next s
start) = forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
   (\a
a s
s0 ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      case forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT (a -> StateT s Maybe b
next a
a) s
s0 of
         Maybe (b, s)
Nothing -> (forall a. Monoid a => a
mempty, s
s0)
         Just (b
b,s
s1) -> (b
b,s
s1))
   (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ s
start)
   (\ s
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())

mapAccum ::
   (a -> state -> (b, state)) ->
   state ->
   T a b
mapAccum :: forall a state b. (a -> state -> (b, state)) -> state -> T a b
mapAccum a -> state -> (b, state)
next state
start =
   forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
      (\a
a state
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> state -> (b, state)
next a
a state
s)
      (forall (m :: * -> *) a. Monad m => a -> m a
return state
start)
      (\ state
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())

{-
The parameter order is chosen this way,
because the 'next' function definition might be large
and can be separated with a ($).
-}
traverse ::
   state ->
   (a -> MS.State state b) ->
   T a b
traverse :: forall state a b. state -> (a -> State state b) -> T a b
traverse state
start a -> State state b
next =
   forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
      (\a
a state
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
MS.runState (a -> State state b
next a
a) state
s)
      (forall (m :: * -> *) a. Monad m => a -> m a
return state
start)
      (\ state
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())


{- |
This function converts a process
into a function on lazy storable vectors.
To this end it must call unsafePerformIO,
that is, the effects of all functions called in the process
must not be observable.

I am not sure, we need this function at all.
-}
runCont ::
   (CutG.Transform a, CutG.Transform b) =>
   T a b -> IO (([a] -> [b]) -> [a] -> [b])
runCont :: forall a b.
(Transform a, Transform b) =>
T a b -> IO (([a] -> [b]) -> [a] -> [b])
runCont (Cons a -> state -> IO (b, state)
next IO state
create state -> IO ()
delete) =
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      \ [a] -> [b]
procRest [a]
sig ->
      forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
         let go :: [a] -> state -> IO [b]
go [a]
xt state
s0 =
               forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$
               case [a]
xt of
                  [] -> state -> IO ()
delete state
s0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []
                  a
x:[a]
xs -> do
                     (b
y,state
s1) <- a -> state -> IO (b, state)
next a
x state
s0
                     (if forall sig. Read sig => sig -> Int
CutG.length b
y forall a. Ord a => a -> a -> Bool
> Int
0
                        then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b
yforall a. a -> [a] -> [a]
:)
                        else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
                        (if forall sig. Read sig => sig -> Int
CutG.length b
y forall a. Ord a => a -> a -> Bool
< forall sig. Read sig => sig -> Int
CutG.length a
x
                           then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a] -> [b]
procRest forall a b. (a -> b) -> a -> b
$
                                forall sig. Transform sig => Int -> sig -> sig
CutG.drop (forall sig. Read sig => sig -> Int
CutG.length b
y) a
x forall a. a -> [a] -> [a]
: [a]
xs
                           else [a] -> state -> IO [b]
go [a]
xs state
s1)
         [a] -> state -> IO [b]
go [a]
sig forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO state
create

{- |
The same restrictions as for 'runCont' apply.
-}
runStorableChunkyCont ::
   (Storable a, Storable b) =>
   T (SV.Vector a) (SV.Vector b) ->
   IO ((SVL.Vector a -> SVL.Vector b) ->
       SVL.Vector a -> SVL.Vector b)
runStorableChunkyCont :: forall a b.
(Storable a, Storable b) =>
T (Vector a) (Vector b)
-> IO ((Vector a -> Vector b) -> Vector a -> Vector b)
runStorableChunkyCont T (Vector a) (Vector b)
proc =
   forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b.
(Transform a, Transform b) =>
T a b -> IO (([a] -> [b]) -> [a] -> [b])
runCont T (Vector a) (Vector b)
proc) forall a b. (a -> b) -> a -> b
$ \([Vector a] -> [Vector b]) -> [Vector a] -> [Vector b]
f Vector a -> Vector b
cont ->
      forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ([Vector a] -> [Vector b]) -> [Vector a] -> [Vector b]
f (forall a. Vector a -> [Vector a]
SVL.chunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Vector b
cont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. Vector a -> [Vector a]
SVL.chunks


zip ::
   (Arr.Arrow arrow) =>
   arrow a b -> arrow a c -> arrow a (Zip.T b c)
zip :: forall (arrow :: * -> * -> *) a b c.
Arrow arrow =>
arrow a b -> arrow a c -> arrow a (T b c)
zip arrow a b
ab arrow a c
ac =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. a -> b -> T a b
Zip.Cons forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< arrow a b
ab forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& arrow a c
ac


instance (CutG.Transform a, CutG.Read b, Semigroup b) => Semigroup (T a b) where
   <> :: T a b -> T a b -> T a b
(<>) = forall a b.
(Transform a, Read b) =>
(b -> b -> b) -> T a b -> T a b -> T a b
append forall a. Semigroup a => a -> a -> a
(<>)

{- |
@mappend@ should be used sparingly.
In a loop it will have to construct types at runtime
which is rather expensive.
-}
instance (CutG.Transform a, CutG.Read b, Monoid b) => Monoid (T a b) where
   mempty :: T a b
mempty = forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
      (\ a
_a () -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, ()))
      (forall (m :: * -> *) a. Monad m => a -> m a
return ())
      (\() -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
   mappend :: T a b -> T a b -> T a b
mappend = forall a b.
(Transform a, Read b) =>
(b -> b -> b) -> T a b -> T a b -> T a b
append forall a. Monoid a => a -> a -> a
mappend

append ::
   (CutG.Transform a, CutG.Read b) =>
   (b -> b -> b) -> T a b -> T a b -> T a b
append :: forall a b.
(Transform a, Read b) =>
(b -> b -> b) -> T a b -> T a b -> T a b
append b -> b -> b
app
      (Cons a -> state -> IO (b, state)
nextX IO state
createX state -> IO ()
deleteX)
      (Cons a -> state -> IO (b, state)
nextY IO state
createY state -> IO ()
deleteY) = forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
   (\a
a Either state state
s ->
      case Either state state
s of
         Left state
s0 -> do
            (b
b1,state
s1) <- a -> state -> IO (b, state)
nextX a
a state
s0
            let lenA :: Int
lenA = forall sig. Read sig => sig -> Int
CutG.length a
a
                lenB :: Int
lenB = forall sig. Read sig => sig -> Int
CutG.length b
b1
            case forall a. Ord a => a -> a -> Ordering
compare Int
lenA Int
lenB of
               Ordering
LT -> forall a. HasCallStack => [Char] -> a
error [Char]
"CausalIO.Process.mappend: output chunk is larger than input chunk"
               Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
return (b
b1, forall a b. a -> Either a b
Left state
s1)
               Ordering
GT -> do
                  state -> IO ()
deleteX state
s1
                  (b
b2,state
s2) <- a -> state -> IO (b, state)
nextY (forall sig. Transform sig => Int -> sig -> sig
CutG.drop Int
lenB a
a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO state
createY
                  forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b -> b
app b
b1 b
b2, forall a b. b -> Either a b
Right state
s2)
         Right state
s0 -> do
            (b
b1,state
s1) <- a -> state -> IO (b, state)
nextY a
a state
s0
            forall (m :: * -> *) a. Monad m => a -> m a
return (b
b1, forall a b. b -> Either a b
Right state
s1))
   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left IO state
createX)
   (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either state -> IO ()
deleteX state -> IO ()
deleteY)


data State a b =
   forall state.
   State
      (a -> state -> IO (b, state))
      (state -> IO ())
      state -- the only difference to (T a b) is the IO


forceMaybe :: (Maybe a -> b) -> Maybe a -> b
forceMaybe :: forall a b. (Maybe a -> b) -> Maybe a -> b
forceMaybe Maybe a -> b
f Maybe a
ma =
   case Maybe a
ma of
      Maybe a
Nothing -> Maybe a -> b
f forall a. Maybe a
Nothing
      Just a
a -> Maybe a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
a

{- |
If the first process does not produce any output,
then the continuing process will not be started.
-}
continue ::
   (CutG.Transform a, SigG.Transform sig b) =>
   T a (sig b) -> (b -> T a (sig b)) -> T a (sig b)
continue :: forall a (sig :: * -> *) b.
(Transform a, Transform sig b) =>
T a (sig b) -> (b -> T a (sig b)) -> T a (sig b)
continue (Cons a -> state -> IO (sig b, state)
nextX IO state
createX state -> IO ()
deleteX) b -> T a (sig b)
procY = forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
   (\a
a Either (Maybe b, state) (State a (sig b))
s ->
      case Either (Maybe b, state) (State a (sig b))
s of
         Left (Maybe b
lastB0, state
s0) -> do
            (sig b
b1,state
s1) <- a -> state -> IO (sig b, state)
nextX a
a state
s0
            let lenA :: Int
lenA = forall sig. Read sig => sig -> Int
CutG.length a
a
                lenB :: Int
lenB = forall sig. Read sig => sig -> Int
CutG.length sig b
b1
                lastB1 :: Maybe b
lastB1 =
                   forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (sig :: * -> *) y.
(Transform0 sig, Storage (sig y)) =>
sig y -> Maybe (sig y, y)
SigG.viewR sig b
b1) Maybe b
lastB0
                cont :: a -> (sig b, Either (a, state) b)
cont a
lastB = (sig b
b1, forall a b. a -> Either a b
Left (a
lastB,state
s1))
            case forall a. Ord a => a -> a -> Ordering
compare Int
lenA Int
lenB of
               Ordering
LT -> forall a. HasCallStack => [Char] -> a
error [Char]
"CausalIO.Process.continue: output chunk is larger than input chunk"
               Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Maybe a -> b) -> Maybe a -> b
forceMaybe forall {a} {b}. a -> (sig b, Either (a, state) b)
cont Maybe b
lastB1
               Ordering
GT ->
                  case Maybe b
lastB1 of
                     Maybe b
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, forall a b. a -> Either a b
Left (Maybe b
lastB1,state
s1))
                     Just b
lastB ->
                        case b -> T a (sig b)
procY b
lastB of
                           Cons a -> state -> IO (sig b, state)
nextY IO state
createY state -> IO ()
deleteY -> do
                              state -> IO ()
deleteX state
s1
                              (sig b
b2,state
s2) <- a -> state -> IO (sig b, state)
nextY (forall sig. Transform sig => Int -> sig -> sig
CutG.drop Int
lenB a
a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO state
createY
                              forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a -> a -> a
mappend sig b
b1 sig b
b2, forall a b. b -> Either a b
Right (forall a b state.
(a -> state -> IO (b, state))
-> (state -> IO ()) -> state -> State a b
State a -> state -> IO (sig b, state)
nextY state -> IO ()
deleteY state
s2))
         Right (State a -> state -> IO (sig b, state)
nextY state -> IO ()
deleteY state
s0) -> do
            (sig b
b1,state
s1) <- a -> state -> IO (sig b, state)
nextY a
a state
s0
            forall (m :: * -> *) a. Monad m => a -> m a
return (sig b
b1, forall a b. b -> Either a b
Right (forall a b state.
(a -> state -> IO (b, state))
-> (state -> IO ()) -> state -> State a b
State a -> state -> IO (sig b, state)
nextY state -> IO ()
deleteY state
s1)))
   (do
      state
sa <- IO state
createX
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall a. Maybe a
Nothing, state
sa)))
   (\Either (Maybe b, state) (State a (sig b))
s ->
      case Either (Maybe b, state) (State a (sig b))
s of
         Left (Maybe b
_lastB,state
s0) -> state -> IO ()
deleteX state
s0
         Right (State a -> state -> IO (sig b, state)
_ state -> IO ()
deleteY state
s0) -> state -> IO ()
deleteY state
s0)

{- |
Pass the last non-empty output chunk
as parameter to the continuing process.
This breaks the abstraction from the chunk sizes,
but we need it for implementing vectorized processing.
-}
continueChunk ::
   (CutG.Transform a, CutG.Transform b) =>
   T a b -> (b -> T a b) -> T a b
continueChunk :: forall a b.
(Transform a, Transform b) =>
T a b -> (b -> T a b) -> T a b
continueChunk (Cons a -> state -> IO (b, state)
nextX IO state
createX state -> IO ()
deleteX) b -> T a b
procY = forall a b state.
(a -> state -> IO (b, state))
-> IO state -> (state -> IO ()) -> T a b
Cons
   (\a
a Either (b, state) (State a b)
s ->
      case Either (b, state) (State a b)
s of
         Left (b
lastB0, state
s0) -> do
            (b
b1,state
s1) <- a -> state -> IO (b, state)
nextX a
a state
s0
            let lenA :: Int
lenA = forall sig. Read sig => sig -> Int
CutG.length a
a
                lenB :: Int
lenB = forall sig. Read sig => sig -> Int
CutG.length b
b1
                cont :: a -> (b, Either (a, state) b)
cont a
lastB = (b
b1, forall a b. a -> Either a b
Left (a
lastB,state
s1))
            case forall a. Ord a => a -> a -> Ordering
compare Int
lenA Int
lenB of
               Ordering
LT -> forall a. HasCallStack => [Char] -> a
error [Char]
"CausalIO.Process.continueChunk: output chunk is larger than input chunk"
               Ordering
EQ ->
                  -- force the decision on lenB, otherwise thunks will accumulate
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int
lenBforall a. Eq a => a -> a -> Bool
==Int
0 then forall {a} {b}. a -> (b, Either (a, state) b)
cont b
lastB0 else forall {a} {b}. a -> (b, Either (a, state) b)
cont b
b1
               Ordering
GT ->
                  if Int
lenBforall a. Eq a => a -> a -> Bool
==Int
0
                    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a} {b}. a -> (b, Either (a, state) b)
cont b
lastB0
                    else
                       case b -> T a b
procY b
b1 of
                          Cons a -> state -> IO (b, state)
nextY IO state
createY state -> IO ()
deleteY -> do
                             state -> IO ()
deleteX state
s1
                             (b
b2,state
s2) <- a -> state -> IO (b, state)
nextY (forall sig. Transform sig => Int -> sig -> sig
CutG.drop Int
lenB a
a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO state
createY
                             forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a -> a -> a
mappend b
b1 b
b2, forall a b. b -> Either a b
Right (forall a b state.
(a -> state -> IO (b, state))
-> (state -> IO ()) -> state -> State a b
State a -> state -> IO (b, state)
nextY state -> IO ()
deleteY state
s2))
         Right (State a -> state -> IO (b, state)
nextY state -> IO ()
deleteY state
s0) -> do
            (b
b1,state
s1) <- a -> state -> IO (b, state)
nextY a
a state
s0
            forall (m :: * -> *) a. Monad m => a -> m a
return (b
b1, forall a b. b -> Either a b
Right (forall a b state.
(a -> state -> IO (b, state))
-> (state -> IO ()) -> state -> State a b
State a -> state -> IO (b, state)
nextY state -> IO ()
deleteY state
s1)))
   (do
      state
sa <- IO state
createX
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall a. Monoid a => a
mempty, state
sa)))
   (\Either (b, state) (State a b)
s ->
      case Either (b, state) (State a b)
s of
         Left (b
_lastB,state
s0) -> state -> IO ()
deleteX state
s0
         Right (State a -> state -> IO (b, state)
_ state -> IO ()
deleteY state
s0) -> state -> IO ()
deleteY state
s0)