{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Control.Monad.State.Profunctor.IxState(
  IxStateT(..)
, IxState
, ixState
, swap
, lift
) where

import Control.Category ( Category(..) )
import Control.Lens
    ( Choice(..),
      Profunctor(dimap),
      view,
      iso,
      over,
      _Wrapped,
      Field1(_1),
      Field2(_2),
      Iso,
      Rewrapped,
      Wrapped(..) )
import Control.Applicative ( Applicative((<*>), pure) )
import Control.Monad
    ( Monad(return, (>>=)), Functor(..), ap, (>=>) )
import Control.Monad.Cont ( MonadCont(..) )
import Control.Monad.Error.Class ( MonadError(..) )
import Control.Monad.Fix ( MonadFix(..) )
import Control.Monad.IO.Class ( MonadIO(..) )
import Control.Monad.Reader.Class ( MonadReader(..) )
import Control.Monad.State.Class ( MonadState(..) )
import Control.Monad.Writer.Class
    ( MonadWriter(writer, listen, pass) )
import Data.Either ( Either(Right, Left), either )
import Data.Functor.Apply ( Apply((<.>)) )
import Data.Functor.Bind ( Bind((>>-)), (->-) )
import Data.Functor.Identity ( Identity(..) )
import Data.Monoid ( (<>), Monoid(mempty) )
import Data.Profunctor ( Strong(..) )
import Data.Semigroup ( Semigroup )
import Data.Semigroupoid ( Semigroupoid(..) )

newtype IxStateT f t s a =
  IxStateT (s -> f (a, t))

type IxState t s a =
  IxStateT Identity t s a

ixState ::
  Iso
    (IxState t s a)
    (IxState t s a)
    (s -> (a, t))
    (s -> (a, t))
ixState :: forall t s a (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (s -> (a, t)) (f (s -> (a, t)))
-> p (IxState t s a) (f (IxState t s a))
ixState =
  (IxState t s a -> s -> (a, t))
-> ((s -> (a, t)) -> IxState t s a)
-> Iso (IxState t s a) (IxState t s a) (s -> (a, t)) (s -> (a, t))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\(IxStateT s -> Identity (a, t)
f) -> Identity (a, t) -> (a, t)
forall a. Identity a -> a
runIdentity (Identity (a, t) -> (a, t))
-> (s -> Identity (a, t)) -> s -> (a, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Identity (a, t)
f)
    (\s -> (a, t)
f -> (s -> Identity (a, t)) -> IxState t s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT ((a, t) -> Identity (a, t)
forall a. a -> Identity a
Identity ((a, t) -> Identity (a, t))
-> (s -> (a, t)) -> s -> Identity (a, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> (a, t)
f))

swap ::
  (Functor f, Functor f') =>
  Iso
    (IxStateT f t s a)
    (IxStateT f' t' s' a')
    (IxStateT f a s t)
    (IxStateT f' a' s' t')
swap :: forall (f :: * -> *) (f' :: * -> *) t s a t' s' a'.
(Functor f, Functor f') =>
Iso
  (IxStateT f t s a)
  (IxStateT f' t' s' a')
  (IxStateT f a s t)
  (IxStateT f' a' s' t')
swap =
  (IxStateT f t s a -> IxStateT f a s t)
-> (IxStateT f' a' s' t' -> IxStateT f' t' s' a')
-> Iso
     (IxStateT f t s a)
     (IxStateT f' t' s' a')
     (IxStateT f a s t)
     (IxStateT f' a' s' t')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (ASetter
  (IxStateT f t s a)
  (IxStateT f a s t)
  (s -> f (a, t))
  (s -> f (t, a))
-> ((s -> f (a, t)) -> s -> f (t, a))
-> IxStateT f t s a
-> IxStateT f a s t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Unwrapped (IxStateT f t s a)
 -> Identity (Unwrapped (IxStateT f a s t)))
-> IxStateT f t s a -> Identity (IxStateT f a s t)
ASetter
  (IxStateT f t s a)
  (IxStateT f a s t)
  (s -> f (a, t))
  (s -> f (t, a))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f t s a)
  (IxStateT f a s t)
  (Unwrapped (IxStateT f t s a))
  (Unwrapped (IxStateT f a s t))
_Wrapped (\s -> f (a, t)
f s
s -> ((a, t) -> (t, a)) -> f (a, t) -> f (t, a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
a, t
t) -> (t
t, a
a)) (s -> f (a, t)
f s
s)))
    (ASetter
  (IxStateT f' a' s' t')
  (IxStateT f' t' s' a')
  (s' -> f' (t', a'))
  (s' -> f' (a', t'))
-> ((s' -> f' (t', a')) -> s' -> f' (a', t'))
-> IxStateT f' a' s' t'
-> IxStateT f' t' s' a'
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Unwrapped (IxStateT f' a' s' t')
 -> Identity (Unwrapped (IxStateT f' t' s' a')))
-> IxStateT f' a' s' t' -> Identity (IxStateT f' t' s' a')
ASetter
  (IxStateT f' a' s' t')
  (IxStateT f' t' s' a')
  (s' -> f' (t', a'))
  (s' -> f' (a', t'))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f' a' s' t')
  (IxStateT f' t' s' a')
  (Unwrapped (IxStateT f' a' s' t'))
  (Unwrapped (IxStateT f' t' s' a'))
_Wrapped (\s' -> f' (t', a')
f s'
s -> ((t', a') -> (a', t')) -> f' (t', a') -> f' (a', t')
forall a b. (a -> b) -> f' a -> f' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(t'
t, a'
a) -> (a'
a, t'
t)) (s' -> f' (t', a')
f s'
s)))

lift ::
  Functor f =>
  f a
  -> IxStateT f s s a
lift :: forall (f :: * -> *) a s. Functor f => f a -> IxStateT f s s a
lift f a
a =
  (s -> f (a, s)) -> IxStateT f s s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\s
s -> (a -> (a, s)) -> f a -> f (a, s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, s
s) f a
a)

instance IxStateT f t s a ~ x =>
  Rewrapped (IxStateT f' t' s' a') x

instance Wrapped (IxStateT f t s a) where
  type Unwrapped (IxStateT f t s a) =
    s -> f (a, t)
  _Wrapped' :: Iso' (IxStateT f t s a) (Unwrapped (IxStateT f t s a))
_Wrapped' =
    (IxStateT f t s a -> s -> f (a, t))
-> ((s -> f (a, t)) -> IxStateT f t s a)
-> Iso
     (IxStateT f t s a)
     (IxStateT f t s a)
     (s -> f (a, t))
     (s -> f (a, t))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(IxStateT s -> f (a, t)
x) -> s -> f (a, t)
x) (s -> f (a, t)) -> IxStateT f t s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT

instance Functor f => Functor (IxStateT f t s) where
  fmap :: forall a b. (a -> b) -> IxStateT f t s a -> IxStateT f t s b
fmap a -> b
f (IxStateT s -> f (a, t)
g) =
    (s -> f (b, t)) -> IxStateT f t s b
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (((a, t) -> (b, t)) -> f (a, t) -> f (b, t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter (a, t) (b, t) a b -> (a -> b) -> (a, t) -> (b, t)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (a, t) (b, t) a b
forall s t a b. Field1 s t a b => Lens s t a b
Lens (a, t) (b, t) a b
_1 a -> b
f) (f (a, t) -> f (b, t)) -> (s -> f (a, t)) -> s -> f (b, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> f (a, t)
g)

instance Monad f => Apply (IxStateT f s s) where
  <.> :: forall a b.
IxStateT f s s (a -> b) -> IxStateT f s s a -> IxStateT f s s b
(<.>) =
    IxStateT f s s (a -> b) -> IxStateT f s s a -> IxStateT f s s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad f => Applicative (IxStateT f s s) where
  pure :: forall a. a -> IxStateT f s s a
pure =
    a -> IxStateT f s s a
forall a. a -> IxStateT f s s a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: forall a b.
IxStateT f s s (a -> b) -> IxStateT f s s a -> IxStateT f s s b
(<*>) =
    IxStateT f s s (a -> b) -> IxStateT f s s a -> IxStateT f s s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad f => Bind (IxStateT f s s) where
  IxStateT s -> f (a, s)
f >>- :: forall a b.
IxStateT f s s a -> (a -> IxStateT f s s b) -> IxStateT f s s b
>>- a -> IxStateT f s s b
g =
    (s -> f (b, s)) -> IxStateT f s s b
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (s -> f (a, s)
f (s -> f (a, s)) -> ((a, s) -> f (b, s)) -> s -> f (b, s)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\ ~(a
a', s
t') -> Getting (s -> f (b, s)) (IxStateT f s s b) (s -> f (b, s))
-> IxStateT f s s b -> s -> f (b, s)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Unwrapped (IxStateT f s s b)
 -> Const (s -> f (b, s)) (Unwrapped (IxStateT f s s b)))
-> IxStateT f s s b -> Const (s -> f (b, s)) (IxStateT f s s b)
Getting (s -> f (b, s)) (IxStateT f s s b) (s -> f (b, s))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f s s b)
  (IxStateT f s s b)
  (Unwrapped (IxStateT f s s b))
  (Unwrapped (IxStateT f s s b))
_Wrapped (a -> IxStateT f s s b
g a
a') s
t'))

instance Monad f => Monad (IxStateT f s s) where
  return :: forall a. a -> IxStateT f s s a
return a
a =
    (s -> f (a, s)) -> IxStateT f s s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\s
s -> (a, s) -> f (a, s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, s
s))
  >>= :: forall a b.
IxStateT f s s a -> (a -> IxStateT f s s b) -> IxStateT f s s b
(>>=) =
    IxStateT f s s a -> (a -> IxStateT f s s b) -> IxStateT f s s b
forall a b.
IxStateT f s s a -> (a -> IxStateT f s s b) -> IxStateT f s s b
forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)

instance Monad f => MonadState s (IxStateT f s s) where
  state :: forall a. (s -> (a, s)) -> IxStateT f s s a
state s -> (a, s)
f =
    (s -> f (a, s)) -> IxStateT f s s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT ((a, s) -> f (a, s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, s) -> f (a, s)) -> (s -> (a, s)) -> s -> f (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> (a, s)
f)
  get :: IxStateT f s s s
get =
    (s -> f (s, s)) -> IxStateT f s s s
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\s
s -> (s, s) -> f (s, s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s, s
s))
  put :: s -> IxStateT f s s ()
put s
a =
    (s -> f ((), s)) -> IxStateT f s s ()
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\s
_ -> ((), s) -> f ((), s)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), s
a))

instance MonadReader r f => MonadReader r (IxStateT f s s) where
  ask :: IxStateT f s s r
ask =
    f r -> IxStateT f s s r
forall (f :: * -> *) a s. Functor f => f a -> IxStateT f s s a
lift f r
forall r (m :: * -> *). MonadReader r m => m r
ask
  reader :: forall a. (r -> a) -> IxStateT f s s a
reader =
    f a -> IxStateT f s s a
forall (f :: * -> *) a s. Functor f => f a -> IxStateT f s s a
lift (f a -> IxStateT f s s a)
-> ((r -> a) -> f a) -> (r -> a) -> IxStateT f s s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (r -> a) -> f a
forall a. (r -> a) -> f a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader
  local :: forall a. (r -> r) -> IxStateT f s s a -> IxStateT f s s a
local r -> r
f (IxStateT s -> f (a, s)
g) =
    (s -> f (a, s)) -> IxStateT f s s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT ((r -> r) -> f (a, s) -> f (a, s)
forall a. (r -> r) -> f a -> f a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (f (a, s) -> f (a, s)) -> (s -> f (a, s)) -> s -> f (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> f (a, s)
g)

instance MonadWriter r f => MonadWriter r (IxStateT f s s) where
  writer :: forall a. (a, r) -> IxStateT f s s a
writer =
    f a -> IxStateT f s s a
forall (f :: * -> *) a s. Functor f => f a -> IxStateT f s s a
lift (f a -> IxStateT f s s a)
-> ((a, r) -> f a) -> (a, r) -> IxStateT f s s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a, r) -> f a
forall a. (a, r) -> f a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  listen :: forall a. IxStateT f s s a -> IxStateT f s s (a, r)
listen =
    ASetter
  (IxStateT f s s a)
  (IxStateT f s s (a, r))
  (s -> f (a, s))
  (s -> f ((a, r), s))
-> ((s -> f (a, s)) -> s -> f ((a, r), s))
-> IxStateT f s s a
-> IxStateT f s s (a, r)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Unwrapped (IxStateT f s s a)
 -> Identity (Unwrapped (IxStateT f s s (a, r))))
-> IxStateT f s s a -> Identity (IxStateT f s s (a, r))
ASetter
  (IxStateT f s s a)
  (IxStateT f s s (a, r))
  (s -> f (a, s))
  (s -> f ((a, r), s))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f s s a)
  (IxStateT f s s (a, r))
  (Unwrapped (IxStateT f s s a))
  (Unwrapped (IxStateT f s s (a, r)))
_Wrapped (\s -> f (a, s)
f s
s -> (((a, s), r) -> ((a, r), s)) -> f ((a, s), r) -> f ((a, r), s)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((a
a, s
t), r
r) -> ((a
a, r
r), s
t)) (f (a, s) -> f ((a, s), r)
forall a. f a -> f (a, r)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (s -> f (a, s)
f s
s)))
  pass :: forall a. IxStateT f s s (a, r -> r) -> IxStateT f s s a
pass =
    ASetter
  (IxStateT f s s (a, r -> r))
  (IxStateT f s s a)
  (s -> f ((a, r -> r), s))
  (s -> f (a, s))
-> ((s -> f ((a, r -> r), s)) -> s -> f (a, s))
-> IxStateT f s s (a, r -> r)
-> IxStateT f s s a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Unwrapped (IxStateT f s s (a, r -> r))
 -> Identity (Unwrapped (IxStateT f s s a)))
-> IxStateT f s s (a, r -> r) -> Identity (IxStateT f s s a)
ASetter
  (IxStateT f s s (a, r -> r))
  (IxStateT f s s a)
  (s -> f ((a, r -> r), s))
  (s -> f (a, s))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f s s (a, r -> r))
  (IxStateT f s s a)
  (Unwrapped (IxStateT f s s (a, r -> r)))
  (Unwrapped (IxStateT f s s a))
_Wrapped (\s -> f ((a, r -> r), s)
f s
s -> f ((a, s), r -> r) -> f (a, s)
forall a. f (a, r -> r) -> f a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass ((((a, r -> r), s) -> ((a, s), r -> r))
-> f ((a, r -> r), s) -> f ((a, s), r -> r)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((a
a, r -> r
k), s
t) -> ((a
a, s
t), r -> r
k)) (s -> f ((a, r -> r), s)
f s
s)))

instance MonadError r f => MonadError r (IxStateT f s s) where
  throwError :: forall a. r -> IxStateT f s s a
throwError =
    f a -> IxStateT f s s a
forall (f :: * -> *) a s. Functor f => f a -> IxStateT f s s a
lift (f a -> IxStateT f s s a) -> (r -> f a) -> r -> IxStateT f s s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. r -> f a
forall a. r -> f a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a.
IxStateT f s s a -> (r -> IxStateT f s s a) -> IxStateT f s s a
catchError (IxStateT s -> f (a, s)
f) r -> IxStateT f s s a
g =
    (s -> f (a, s)) -> IxStateT f s s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\s
s -> f (a, s) -> (r -> f (a, s)) -> f (a, s)
forall a. f a -> (r -> f a) -> f a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (s -> f (a, s)
f s
s) (\r
r -> Getting (s -> f (a, s)) (IxStateT f s s a) (s -> f (a, s))
-> IxStateT f s s a -> s -> f (a, s)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Unwrapped (IxStateT f s s a)
 -> Const (s -> f (a, s)) (Unwrapped (IxStateT f s s a)))
-> IxStateT f s s a -> Const (s -> f (a, s)) (IxStateT f s s a)
Getting (s -> f (a, s)) (IxStateT f s s a) (s -> f (a, s))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f s s a)
  (IxStateT f s s a)
  (Unwrapped (IxStateT f s s a))
  (Unwrapped (IxStateT f s s a))
_Wrapped (r -> IxStateT f s s a
g r
r) s
s))

instance MonadFix f => MonadFix (IxStateT f s s) where
  mfix :: forall a. (a -> IxStateT f s s a) -> IxStateT f s s a
mfix a -> IxStateT f s s a
f =
    (s -> f (a, s)) -> IxStateT f s s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\s
s -> ((a, s) -> f (a, s)) -> f (a, s)
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\ ~(a
a, s
_) -> Getting (s -> f (a, s)) (IxStateT f s s a) (s -> f (a, s))
-> IxStateT f s s a -> s -> f (a, s)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Unwrapped (IxStateT f s s a)
 -> Const (s -> f (a, s)) (Unwrapped (IxStateT f s s a)))
-> IxStateT f s s a -> Const (s -> f (a, s)) (IxStateT f s s a)
Getting (s -> f (a, s)) (IxStateT f s s a) (s -> f (a, s))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f s s a)
  (IxStateT f s s a)
  (Unwrapped (IxStateT f s s a))
  (Unwrapped (IxStateT f s s a))
_Wrapped (a -> IxStateT f s s a
f a
a) s
s))

instance MonadCont f => MonadCont (IxStateT f s s) where
  callCC :: forall a b.
((a -> IxStateT f s s b) -> IxStateT f s s a) -> IxStateT f s s a
callCC (a -> IxStateT f s s b) -> IxStateT f s s a
f =
    (s -> f (a, s)) -> IxStateT f s s a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\s
s -> (((a, s) -> f (b, s)) -> f (a, s)) -> f (a, s)
forall a b. ((a -> f b) -> f a) -> f a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (\(a, s) -> f (b, s)
k -> Getting (s -> f (a, s)) (IxStateT f s s a) (s -> f (a, s))
-> IxStateT f s s a -> s -> f (a, s)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Unwrapped (IxStateT f s s a)
 -> Const (s -> f (a, s)) (Unwrapped (IxStateT f s s a)))
-> IxStateT f s s a -> Const (s -> f (a, s)) (IxStateT f s s a)
Getting (s -> f (a, s)) (IxStateT f s s a) (s -> f (a, s))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f s s a)
  (IxStateT f s s a)
  (Unwrapped (IxStateT f s s a))
  (Unwrapped (IxStateT f s s a))
_Wrapped ((a -> IxStateT f s s b) -> IxStateT f s s a
f (\a
a -> (s -> f (b, s)) -> IxStateT f s s b
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\s
s' -> (a, s) -> f (b, s)
k (a
a, s
s')))) s
s))

instance MonadIO f => MonadIO (IxStateT f s s) where
  liftIO :: forall a. IO a -> IxStateT f s s a
liftIO =
    f a -> IxStateT f s s a
forall (f :: * -> *) a s. Functor f => f a -> IxStateT f s s a
lift (f a -> IxStateT f s s a)
-> (IO a -> f a) -> IO a -> IxStateT f s s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO a -> f a
forall a. IO a -> f a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (Semigroup t, Bind f) => Semigroupoid (IxStateT f t) where
  IxStateT j -> f (k1, t)
f o :: forall j k1 i.
IxStateT f t j k1 -> IxStateT f t i j -> IxStateT f t i k1
`o` IxStateT i -> f (j, t)
g =
    (i -> f (k1, t)) -> IxStateT f t i k1
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (i -> f (j, t)
g (i -> f (j, t)) -> ((j, t) -> f (k1, t)) -> i -> f (k1, t)
forall (m :: * -> *) a b c.
Bind m =>
(a -> m b) -> (b -> m c) -> a -> m c
->- (\ ~(j
a, t
t) -> ((k1, t) -> (k1, t)) -> f (k1, t) -> f (k1, t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter (k1, t) (k1, t) t t -> (t -> t) -> (k1, t) -> (k1, t)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (k1, t) (k1, t) t t
forall s t a b. Field2 s t a b => Lens s t a b
Lens (k1, t) (k1, t) t t
_2 (t
t t -> t -> t
forall a. Semigroup a => a -> a -> a
<>)) (j -> f (k1, t)
f j
a)))

instance (Monoid t, Monad f) => Category (IxStateT f t) where
  IxStateT b -> f (c, t)
f . :: forall b c a.
IxStateT f t b c -> IxStateT f t a b -> IxStateT f t a c
. IxStateT a -> f (b, t)
g =
    (a -> f (c, t)) -> IxStateT f t a c
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (a -> f (b, t)
g (a -> f (b, t)) -> ((b, t) -> f (c, t)) -> a -> f (c, t)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\ ~(b
a, t
t) -> ((c, t) -> (c, t)) -> f (c, t) -> f (c, t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter (c, t) (c, t) t t -> (t -> t) -> (c, t) -> (c, t)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (c, t) (c, t) t t
forall s t a b. Field2 s t a b => Lens s t a b
Lens (c, t) (c, t) t t
_2 (t
t t -> t -> t
forall a. Semigroup a => a -> a -> a
<>)) (b -> f (c, t)
f b
a)))
  id :: forall a. IxStateT f t a a
id =
    (a -> f (a, t)) -> IxStateT f t a a
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (\a
s -> (a, t) -> f (a, t)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
s, t
forall a. Monoid a => a
mempty))

instance Functor f => Profunctor (IxStateT f t) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> IxStateT f t b c -> IxStateT f t a d
dimap a -> b
f c -> d
g (IxStateT b -> f (c, t)
k) =
    (a -> f (d, t)) -> IxStateT f t a d
forall (f :: * -> *) t s a. (s -> f (a, t)) -> IxStateT f t s a
IxStateT (((c, t) -> (d, t)) -> f (c, t) -> f (d, t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter (c, t) (d, t) c d -> (c -> d) -> (c, t) -> (d, t)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (c, t) (d, t) c d
forall s t a b. Field1 s t a b => Lens s t a b
Lens (c, t) (d, t) c d
_1 c -> d
g) (f (c, t) -> f (d, t)) -> (a -> f (c, t)) -> a -> f (d, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> f (c, t)
k (b -> f (c, t)) -> (a -> b) -> a -> f (c, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f)

instance (Monoid t, Applicative f) => Choice (IxStateT f t) where
  left' :: forall a b c.
IxStateT f t a b -> IxStateT f t (Either a c) (Either b c)
left' =
    ASetter
  (IxStateT f t a b)
  (IxStateT f t (Either a c) (Either b c))
  (a -> f (b, t))
  (Either a c -> f (Either b c, t))
-> ((a -> f (b, t)) -> Either a c -> f (Either b c, t))
-> IxStateT f t a b
-> IxStateT f t (Either a c) (Either b c)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Unwrapped (IxStateT f t a b)
 -> Identity (Unwrapped (IxStateT f t (Either a c) (Either b c))))
-> IxStateT f t a b
-> Identity (IxStateT f t (Either a c) (Either b c))
ASetter
  (IxStateT f t a b)
  (IxStateT f t (Either a c) (Either b c))
  (a -> f (b, t))
  (Either a c -> f (Either b c, t))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f t a b)
  (IxStateT f t (Either a c) (Either b c))
  (Unwrapped (IxStateT f t a b))
  (Unwrapped (IxStateT f t (Either a c) (Either b c)))
_Wrapped (\a -> f (b, t)
f -> (a -> f (Either b c, t))
-> (c -> f (Either b c, t)) -> Either a c -> f (Either b c, t)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (((b, t) -> (Either b c, t)) -> f (b, t) -> f (Either b c, t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter (b, t) (Either b c, t) b (Either b c)
-> (b -> Either b c) -> (b, t) -> (Either b c, t)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (b, t) (Either b c, t) b (Either b c)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (b, t) (Either b c, t) b (Either b c)
_1 b -> Either b c
forall a b. a -> Either a b
Left) (f (b, t) -> f (Either b c, t))
-> (a -> f (b, t)) -> a -> f (Either b c, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f (b, t)
f) (\c
c -> (Either b c, t) -> f (Either b c, t)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> Either b c
forall a b. b -> Either a b
Right c
c, t
forall a. Monoid a => a
mempty)))
  right' :: forall a b c.
IxStateT f t a b -> IxStateT f t (Either c a) (Either c b)
right' =
    ASetter
  (IxStateT f t a b)
  (IxStateT f t (Either c a) (Either c b))
  (a -> f (b, t))
  (Either c a -> f (Either c b, t))
-> ((a -> f (b, t)) -> Either c a -> f (Either c b, t))
-> IxStateT f t a b
-> IxStateT f t (Either c a) (Either c b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Unwrapped (IxStateT f t a b)
 -> Identity (Unwrapped (IxStateT f t (Either c a) (Either c b))))
-> IxStateT f t a b
-> Identity (IxStateT f t (Either c a) (Either c b))
ASetter
  (IxStateT f t a b)
  (IxStateT f t (Either c a) (Either c b))
  (a -> f (b, t))
  (Either c a -> f (Either c b, t))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f t a b)
  (IxStateT f t (Either c a) (Either c b))
  (Unwrapped (IxStateT f t a b))
  (Unwrapped (IxStateT f t (Either c a) (Either c b)))
_Wrapped (\a -> f (b, t)
f -> (c -> f (Either c b, t))
-> (a -> f (Either c b, t)) -> Either c a -> f (Either c b, t)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\c
c -> (Either c b, t) -> f (Either c b, t)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> Either c b
forall a b. a -> Either a b
Left c
c, t
forall a. Monoid a => a
mempty)) (((b, t) -> (Either c b, t)) -> f (b, t) -> f (Either c b, t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter (b, t) (Either c b, t) b (Either c b)
-> (b -> Either c b) -> (b, t) -> (Either c b, t)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (b, t) (Either c b, t) b (Either c b)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (b, t) (Either c b, t) b (Either c b)
_1 b -> Either c b
forall a b. b -> Either a b
Right) (f (b, t) -> f (Either c b, t))
-> (a -> f (b, t)) -> a -> f (Either c b, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f (b, t)
f))

instance Functor f => Strong (IxStateT f t) where
  first' :: forall a b c. IxStateT f t a b -> IxStateT f t (a, c) (b, c)
first' =
    ASetter
  (IxStateT f t a b)
  (IxStateT f t (a, c) (b, c))
  (a -> f (b, t))
  ((a, c) -> f ((b, c), t))
-> ((a -> f (b, t)) -> (a, c) -> f ((b, c), t))
-> IxStateT f t a b
-> IxStateT f t (a, c) (b, c)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Unwrapped (IxStateT f t a b)
 -> Identity (Unwrapped (IxStateT f t (a, c) (b, c))))
-> IxStateT f t a b -> Identity (IxStateT f t (a, c) (b, c))
ASetter
  (IxStateT f t a b)
  (IxStateT f t (a, c) (b, c))
  (a -> f (b, t))
  ((a, c) -> f ((b, c), t))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f t a b)
  (IxStateT f t (a, c) (b, c))
  (Unwrapped (IxStateT f t a b))
  (Unwrapped (IxStateT f t (a, c) (b, c)))
_Wrapped (\a -> f (b, t)
f (a
a, c
c) -> ((b, t) -> ((b, c), t)) -> f (b, t) -> f ((b, c), t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, t
t) -> ((b
b, c
c), t
t)) (a -> f (b, t)
f a
a))
  second' :: forall a b c. IxStateT f t a b -> IxStateT f t (c, a) (c, b)
second' =
    ASetter
  (IxStateT f t a b)
  (IxStateT f t (c, a) (c, b))
  (a -> f (b, t))
  ((c, a) -> f ((c, b), t))
-> ((a -> f (b, t)) -> (c, a) -> f ((c, b), t))
-> IxStateT f t a b
-> IxStateT f t (c, a) (c, b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Unwrapped (IxStateT f t a b)
 -> Identity (Unwrapped (IxStateT f t (c, a) (c, b))))
-> IxStateT f t a b -> Identity (IxStateT f t (c, a) (c, b))
ASetter
  (IxStateT f t a b)
  (IxStateT f t (c, a) (c, b))
  (a -> f (b, t))
  ((c, a) -> f ((c, b), t))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (IxStateT f t a b)
  (IxStateT f t (c, a) (c, b))
  (Unwrapped (IxStateT f t a b))
  (Unwrapped (IxStateT f t (c, a) (c, b)))
_Wrapped (\a -> f (b, t)
f (c
c, a
a) -> ((b, t) -> ((c, b), t)) -> f (b, t) -> f ((c, b), t)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
b, t
t) -> ((c
c, b
b), t
t)) (a -> f (b, t)
f a
a))