{-# LANGUAGE GeneralizedNewtypeDeriving, RankNTypes, OverloadedStrings #-}
-- |
-- Module: WildBind.Binding
-- Description: Functions to build Binding
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- This module exports functions to build and manipulate 'Binding', an
-- object binding input symbols to actions.
-- 
module WildBind.Binding
       ( -- * Types
         Action(Action,actDescription,actDo),
         Binding,
         Binding',
         
         -- * Construction

         -- | Functions to create fundamental 'Binding's.
         --
         -- To create complex 'Binding's, use <#Condition Condition> functions
         -- described below and 'mappend' them together.
         
         noBinding,
         Binder,
         binds,
         binds',
         bindsF,
         bindsF',
         on,
         run,
         as,
         binding,
         binding',
         bindingF,
         bindingF',
         
         -- * Condition
         
         -- | #Condition# With these functions, you can create
         -- 'Binding's that behave differently for different front-end
         -- and/or back-end states.
         --
         -- If you call the condition functions multiple times, the
         -- conditions are combined with AND logic.
         ifFront,
         ifBack,
         ifBoth,
         whenFront,
         whenBack,
         whenBoth,
         -- * Conversion
         -- ** Stateful bindings
         startFrom,
         extend,
         -- ** Type conversion
         convFront,
         convInput,
         convBack,
         -- ** Action conversion
         advice,
         revise,
         revise',
         before,
         after,
         justBefore,
         justAfter,
         -- * Execution
         boundAction,
         boundAction',
         boundActions,
         boundActions',
         boundInputs,
         boundInputs'
       ) where

import Control.Applicative (Applicative, (<*), (*>))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT(..), withReaderT)
import Control.Monad.Trans.State (StateT(..), runStateT, mapStateT)
import Control.Monad.Trans.Writer (Writer, tell, execWriter, mapWriter)
import qualified Data.Map as M
import Data.Monoid (Monoid(..), Endo(Endo, appEndo))
import Data.Semigroup (Semigroup(..))

import WildBind.Description (ActionDescription)

-- | Action done by WildBind
data Action m a =
  Action
  { Action m a -> ActionDescription
actDescription :: ActionDescription, -- ^ Human-readable description of the action.
    Action m a -> m a
actDo :: m a -- ^ The actual job.
  }

instance Show (Action m a) where
  show :: Action m a -> String
show Action m a
a = String
"Action " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ActionDescription -> String
forall a. Show a => a -> String
show (Action m a -> ActionDescription
forall (m :: * -> *) a. Action m a -> ActionDescription
actDescription Action m a
a)

instance Functor m => Functor (Action m) where
  fmap :: (a -> b) -> Action m a -> Action m b
fmap a -> b
f Action m a
a = Action m a
a { actDo :: m b
actDo = (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Action m a -> m a
forall (m :: * -> *) a. Action m a -> m a
actDo Action m a
a) }

-- | Make an 'Action' that runs the given monadic action before the
-- original 'Action'.
before :: (Applicative m)
       => m b -- ^ the monadic action prepended
       -> Action m a -- ^ the original 'Action'.
       -> Action m a
before :: m b -> Action m a -> Action m a
before m b
hook Action m a
act = Action m a
act { actDo :: m a
actDo = m b
hook m b -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Action m a -> m a
forall (m :: * -> *) a. Action m a -> m a
actDo Action m a
act }

-- | Make an 'Action' that runs the given monadic action after the
-- original 'Action'.
after :: (Applicative m)
      => m b -- ^ the monadic action appended.
      -> Action m a -- ^ the original 'Action'.
      -> Action m a
after :: m b -> Action m a -> Action m a
after m b
hook Action m a
act = Action m a
act { actDo :: m a
actDo = Action m a -> m a
forall (m :: * -> *) a. Action m a -> m a
actDo Action m a
act m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m b
hook }

-- | Same as 'before', but it returns 'Just'.
--
-- @since 0.1.1.0
justBefore :: (Applicative m) => m b -> Action m a -> Maybe (Action m a)
justBefore :: m b -> Action m a -> Maybe (Action m a)
justBefore m b
m Action m a
a = Action m a -> Maybe (Action m a)
forall a. a -> Maybe a
Just (Action m a -> Maybe (Action m a))
-> Action m a -> Maybe (Action m a)
forall a b. (a -> b) -> a -> b
$ m b -> Action m a -> Action m a
forall (m :: * -> *) b a.
Applicative m =>
m b -> Action m a -> Action m a
before m b
m Action m a
a

-- | Same as 'after', but it returns 'Just'.
--
-- @since 0.1.1.0
justAfter :: (Applicative m) => m b -> Action m a -> Maybe (Action m a)
justAfter :: m b -> Action m a -> Maybe (Action m a)
justAfter m b
m Action m a
a = Action m a -> Maybe (Action m a)
forall a. a -> Maybe a
Just (Action m a -> Maybe (Action m a))
-> Action m a -> Maybe (Action m a)
forall a b. (a -> b) -> a -> b
$ m b -> Action m a -> Action m a
forall (m :: * -> *) b a.
Applicative m =>
m b -> Action m a -> Action m a
after m b
m Action m a
a

-- | State/Reader/IO Monad
type SRIM bs fs = StateT bs (ReaderT fs IO)

-- | WildBind back-end binding with both explicit and implicit
-- states. @bs@ is the explicit back-end state, @fs@ is the front-end
-- state, and @i@ is the input type.
--
-- You can make the explicit state @bs@ implicit by 'startFrom'
-- function.
newtype Binding' bs fs i =
  Binding'
  { Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' :: bs -> fs -> M.Map i (Action (SRIM bs fs) (Binding' bs fs i))
  }

runSRIM :: bs -> fs -> SRIM bs fs a -> IO (a, bs)
runSRIM :: bs -> fs -> SRIM bs fs a -> IO (a, bs)
runSRIM bs
bs fs
fs SRIM bs fs a
m = (ReaderT fs IO (a, bs) -> fs -> IO (a, bs))
-> fs -> ReaderT fs IO (a, bs) -> IO (a, bs)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT fs IO (a, bs) -> fs -> IO (a, bs)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT fs
fs (ReaderT fs IO (a, bs) -> IO (a, bs))
-> ReaderT fs IO (a, bs) -> IO (a, bs)
forall a b. (a -> b) -> a -> b
$ (SRIM bs fs a -> bs -> ReaderT fs IO (a, bs))
-> bs -> SRIM bs fs a -> ReaderT fs IO (a, bs)
forall a b c. (a -> b -> c) -> b -> a -> c
flip SRIM bs fs a -> bs -> ReaderT fs IO (a, bs)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT bs
bs SRIM bs fs a
m

redoSRIM :: IO (a, bs) -> SRIM bs fs a
redoSRIM :: IO (a, bs) -> SRIM bs fs a
redoSRIM IO (a, bs)
m = (bs -> ReaderT fs IO (a, bs)) -> SRIM bs fs a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((bs -> ReaderT fs IO (a, bs)) -> SRIM bs fs a)
-> (bs -> ReaderT fs IO (a, bs)) -> SRIM bs fs a
forall a b. (a -> b) -> a -> b
$ ReaderT fs IO (a, bs) -> bs -> ReaderT fs IO (a, bs)
forall a b. a -> b -> a
const (ReaderT fs IO (a, bs) -> bs -> ReaderT fs IO (a, bs))
-> ReaderT fs IO (a, bs) -> bs -> ReaderT fs IO (a, bs)
forall a b. (a -> b) -> a -> b
$ IO (a, bs) -> ReaderT fs IO (a, bs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO (a, bs)
m

mapActDo :: (m a -> n b) -> Action m a -> Action n b
mapActDo :: (m a -> n b) -> Action m a -> Action n b
mapActDo m a -> n b
f Action m a
act = Action m a
act { actDo :: n b
actDo = m a -> n b
f (m a -> n b) -> m a -> n b
forall a b. (a -> b) -> a -> b
$ Action m a -> m a
forall (m :: * -> *) a. Action m a -> m a
actDo Action m a
act }

mapActResult :: Functor m => (a -> b) -> M.Map i (Action m a) -> M.Map i (Action m b)
mapActResult :: (a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult = (Action m a -> Action m b)
-> Map i (Action m a) -> Map i (Action m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action m a -> Action m b)
 -> Map i (Action m a) -> Map i (Action m b))
-> ((a -> b) -> Action m a -> Action m b)
-> (a -> b)
-> Map i (Action m a)
-> Map i (Action m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Action m a -> Action m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

liftActionR :: Monad m => Action m a -> Action (ReaderT fs m) a
liftActionR :: Action m a -> Action (ReaderT fs m) a
liftActionR = (m a -> ReaderT fs m a) -> Action m a -> Action (ReaderT fs m) a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo m a -> ReaderT fs m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

withActionR :: (fs -> fs') -> Action (SRIM bs fs') a -> Action (SRIM bs fs) a
withActionR :: (fs -> fs') -> Action (SRIM bs fs') a -> Action (SRIM bs fs) a
withActionR fs -> fs'
f = ((StateT bs (ReaderT fs' IO) a -> StateT bs (ReaderT fs IO) a)
-> Action (SRIM bs fs') a -> Action (SRIM bs fs) a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo ((StateT bs (ReaderT fs' IO) a -> StateT bs (ReaderT fs IO) a)
 -> Action (SRIM bs fs') a -> Action (SRIM bs fs) a)
-> ((ReaderT fs' IO (a, bs) -> ReaderT fs IO (a, bs))
    -> StateT bs (ReaderT fs' IO) a -> StateT bs (ReaderT fs IO) a)
-> (ReaderT fs' IO (a, bs) -> ReaderT fs IO (a, bs))
-> Action (SRIM bs fs') a
-> Action (SRIM bs fs) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT fs' IO (a, bs) -> ReaderT fs IO (a, bs))
-> StateT bs (ReaderT fs' IO) a -> StateT bs (ReaderT fs IO) a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT) ((fs -> fs') -> ReaderT fs' IO (a, bs) -> ReaderT fs IO (a, bs)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT fs -> fs'
f)

-- | WildBind back-end binding between inputs and actions. @s@ is the
-- front-end state type, and @i@ is the input type.
type Binding s i = Binding' () s i

-- | See "Monoid" instance.
instance Ord i => Semigroup (Binding' bs fs i) where
  Binding' bs fs i
abind <> :: Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
<> Binding' bs fs i
bbind = (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
 -> Binding' bs fs i)
-> (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs ->
    let amap :: Map i (Action (SRIM bs fs) (Binding' bs fs i))
amap = (Binding' bs fs i -> Binding' bs fs i)
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
forall a. Semigroup a => a -> a -> a
<> Binding' bs fs i
bbind) (Map i (Action (SRIM bs fs) (Binding' bs fs i))
 -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
abind bs
bs fs
fs
        bmap :: Map i (Action (SRIM bs fs) (Binding' bs fs i))
bmap = (Binding' bs fs i -> Binding' bs fs i)
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (Binding' bs fs i
abind Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
forall a. Semigroup a => a -> a -> a
<>) (Map i (Action (SRIM bs fs) (Binding' bs fs i))
 -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
bbind bs
bs fs
fs
    in (Action (SRIM bs fs) (Binding' bs fs i)
 -> Action (SRIM bs fs) (Binding' bs fs i)
 -> Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (\Action (SRIM bs fs) (Binding' bs fs i)
_ Action (SRIM bs fs) (Binding' bs fs i)
b -> Action (SRIM bs fs) (Binding' bs fs i)
b) Map i (Action (SRIM bs fs) (Binding' bs fs i))
amap Map i (Action (SRIM bs fs) (Binding' bs fs i))
bmap

-- | 'mempty' returns a 'Binding' where no binding is
-- defined. 'mappend' combines two 'Binding's while preserving their
-- individual implicit states. The right-hand 'Binding' has precedence
-- over the left-hand one. That is, if the two 'Binding's both have a
-- binding to the same key in the same front-end and back-end state,
-- the binding from the right-hand one is used.
instance Ord i => Monoid (Binding' bs fs i) where
  mempty :: Binding' bs fs i
mempty = Binding' bs fs i
forall bs fs i. Binding' bs fs i
noBinding
  mappend :: Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
mappend = Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
forall a. Semigroup a => a -> a -> a
(<>)

-- | A 'Binding'' with no bindings. It's the same as 'mempty', except
-- 'noBinding' requires no context.
noBinding :: Binding' bs fs i
noBinding :: Binding' bs fs i
noBinding = (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
 -> Binding' bs fs i)
-> (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
_ fs
_ -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall k a. Map k a
M.empty

-- | Get the 'Action' bound to the specified state @s@ and input @i@.
boundAction :: (Ord i) => Binding s i -> s -> i -> Maybe (Action IO (Binding s i))
boundAction :: Binding s i -> s -> i -> Maybe (Action IO (Binding s i))
boundAction Binding s i
b s
state i
input = ((Action IO (Binding s i, ()) -> Action IO (Binding s i))
-> Maybe (Action IO (Binding s i, ()))
-> Maybe (Action IO (Binding s i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action IO (Binding s i, ()) -> Action IO (Binding s i))
 -> Maybe (Action IO (Binding s i, ()))
 -> Maybe (Action IO (Binding s i)))
-> (((Binding s i, ()) -> Binding s i)
    -> Action IO (Binding s i, ()) -> Action IO (Binding s i))
-> ((Binding s i, ()) -> Binding s i)
-> Maybe (Action IO (Binding s i, ()))
-> Maybe (Action IO (Binding s i))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Binding s i, ()) -> Binding s i)
-> Action IO (Binding s i, ()) -> Action IO (Binding s i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Binding s i, ()) -> Binding s i
forall a b. (a, b) -> a
fst (Maybe (Action IO (Binding s i, ()))
 -> Maybe (Action IO (Binding s i)))
-> Maybe (Action IO (Binding s i, ()))
-> Maybe (Action IO (Binding s i))
forall a b. (a -> b) -> a -> b
$ Binding s i -> () -> s -> i -> Maybe (Action IO (Binding s i, ()))
forall i bs fs.
Ord i =>
Binding' bs fs i
-> bs -> fs -> i -> Maybe (Action IO (Binding' bs fs i, bs))
boundAction' Binding s i
b () s
state i
input

-- | Get the 'Action' bound to the specified back-end state @bs@,
-- front-end state @fs@ and input @i@
boundAction' :: (Ord i) => Binding' bs fs i -> bs -> fs -> i -> Maybe (Action IO (Binding' bs fs i, bs))
boundAction' :: Binding' bs fs i
-> bs -> fs -> i -> Maybe (Action IO (Binding' bs fs i, bs))
boundAction' Binding' bs fs i
b bs
bs fs
fs i
input = ((Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
 -> Action IO (Binding' bs fs i, bs))
-> Maybe (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Maybe (Action IO (Binding' bs fs i, bs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
  -> Action IO (Binding' bs fs i, bs))
 -> Maybe (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> Maybe (Action IO (Binding' bs fs i, bs)))
-> ((StateT bs (ReaderT fs IO) (Binding' bs fs i)
     -> IO (Binding' bs fs i, bs))
    -> Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
    -> Action IO (Binding' bs fs i, bs))
-> (StateT bs (ReaderT fs IO) (Binding' bs fs i)
    -> IO (Binding' bs fs i, bs))
-> Maybe (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Maybe (Action IO (Binding' bs fs i, bs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT bs (ReaderT fs IO) (Binding' bs fs i)
 -> IO (Binding' bs fs i, bs))
-> Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
-> Action IO (Binding' bs fs i, bs)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo) (bs
-> fs
-> StateT bs (ReaderT fs IO) (Binding' bs fs i)
-> IO (Binding' bs fs i, bs)
forall bs fs a. bs -> fs -> SRIM bs fs a -> IO (a, bs)
runSRIM bs
bs fs
fs) (Maybe (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> Maybe (Action IO (Binding' bs fs i, bs)))
-> Maybe (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Maybe (Action IO (Binding' bs fs i, bs))
forall a b. (a -> b) -> a -> b
$ i
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Maybe (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup i
input (Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> Maybe (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)))
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Maybe (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs
-> fs
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
b bs
bs fs
fs

-- | Get the list of all bound inputs @i@ and their corresponding
-- actions for the specified front-end state @s@.
boundActions :: Binding s i -> s -> [(i, Action IO (Binding s i))]
boundActions :: Binding s i -> s -> [(i, Action IO (Binding s i))]
boundActions Binding s i
b s
state = ((i, Action IO (Binding s i, ())) -> (i, Action IO (Binding s i)))
-> [(i, Action IO (Binding s i, ()))]
-> [(i, Action IO (Binding s i))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(i
i, Action IO (Binding s i, ())
act) -> (i
i, ((Binding s i, ()) -> Binding s i)
-> Action IO (Binding s i, ()) -> Action IO (Binding s i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Binding s i, ()) -> Binding s i
forall a b. (a, b) -> a
fst Action IO (Binding s i, ())
act)) ([(i, Action IO (Binding s i, ()))]
 -> [(i, Action IO (Binding s i))])
-> [(i, Action IO (Binding s i, ()))]
-> [(i, Action IO (Binding s i))]
forall a b. (a -> b) -> a -> b
$ Binding s i -> () -> s -> [(i, Action IO (Binding s i, ()))]
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> [(i, Action IO (Binding' bs fs i, bs))]
boundActions' Binding s i
b () s
state

-- | Get the list of all bound inputs @i@ and their corresponding
-- actions for the specified back-end state @bs@ and front-end state
-- @fs@.
boundActions' :: Binding' bs fs i -> bs -> fs -> [(i, Action IO (Binding' bs fs i, bs))]
boundActions' :: Binding' bs fs i
-> bs -> fs -> [(i, Action IO (Binding' bs fs i, bs))]
boundActions' Binding' bs fs i
b bs
bs fs
fs = ((i, Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> (i, Action IO (Binding' bs fs i, bs)))
-> [(i, Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))]
-> [(i, Action IO (Binding' bs fs i, bs))]
forall a b. (a -> b) -> [a] -> [b]
map (i, Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> (i, Action IO (Binding' bs fs i, bs))
forall a a.
(a, Action (StateT bs (ReaderT fs IO)) a) -> (a, Action IO (a, bs))
convertAction ([(i, Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))]
 -> [(i, Action IO (Binding' bs fs i, bs))])
-> [(i, Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))]
-> [(i, Action IO (Binding' bs fs i, bs))]
forall a b. (a -> b) -> a -> b
$ Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> [(i, Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))]
forall k a. Map k a -> [(k, a)]
M.toList (Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> [(i, Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))])
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> [(i, Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))]
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs
-> fs
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
b bs
bs fs
fs
  where
    convertAction :: (a, Action (StateT bs (ReaderT fs IO)) a) -> (a, Action IO (a, bs))
convertAction (a
i, Action (StateT bs (ReaderT fs IO)) a
act) = (a
i, (StateT bs (ReaderT fs IO) a -> IO (a, bs))
-> Action (StateT bs (ReaderT fs IO)) a -> Action IO (a, bs)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo (bs -> fs -> StateT bs (ReaderT fs IO) a -> IO (a, bs)
forall bs fs a. bs -> fs -> SRIM bs fs a -> IO (a, bs)
runSRIM bs
bs fs
fs) Action (StateT bs (ReaderT fs IO)) a
act)

-- | Get the list of all bound inputs @i@ for the specified front-end
-- state @s@.
boundInputs :: Binding s i -> s -> [i]
boundInputs :: Binding s i -> s -> [i]
boundInputs Binding s i
b s
s = ((i, Action IO (Binding s i)) -> i)
-> [(i, Action IO (Binding s i))] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i, Action IO (Binding s i)) -> i
forall a b. (a, b) -> a
fst ([(i, Action IO (Binding s i))] -> [i])
-> [(i, Action IO (Binding s i))] -> [i]
forall a b. (a -> b) -> a -> b
$ Binding s i -> s -> [(i, Action IO (Binding s i))]
forall s i. Binding s i -> s -> [(i, Action IO (Binding s i))]
boundActions Binding s i
b s
s

-- | Get the list of all bound inputs @i@ for the specified front-end
-- state @fs@ and the back-end state @bs@.
boundInputs' :: Binding' bs fs i -> bs -> fs -> [i]
boundInputs' :: Binding' bs fs i -> bs -> fs -> [i]
boundInputs' Binding' bs fs i
b bs
bs fs
fs = ((i, Action IO (Binding' bs fs i, bs)) -> i)
-> [(i, Action IO (Binding' bs fs i, bs))] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i, Action IO (Binding' bs fs i, bs)) -> i
forall a b. (a, b) -> a
fst ([(i, Action IO (Binding' bs fs i, bs))] -> [i])
-> [(i, Action IO (Binding' bs fs i, bs))] -> [i]
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs -> fs -> [(i, Action IO (Binding' bs fs i, bs))]
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> [(i, Action IO (Binding' bs fs i, bs))]
boundActions' Binding' bs fs i
b bs
bs fs
fs


-- | A monad to construct 'Binding''. @i@ is the input symbol, and @v@
-- is supposed to be the 'Action' bound to @i@.
newtype Binder i v a = Binder { Binder i v a -> Writer (Endo [(i, v)]) a
unBinder :: Writer (Endo [(i, v)]) a }
                       deriving (Applicative (Binder i v)
a -> Binder i v a
Applicative (Binder i v)
-> (forall a b.
    Binder i v a -> (a -> Binder i v b) -> Binder i v b)
-> (forall a b. Binder i v a -> Binder i v b -> Binder i v b)
-> (forall a. a -> Binder i v a)
-> Monad (Binder i v)
Binder i v a -> (a -> Binder i v b) -> Binder i v b
Binder i v a -> Binder i v b -> Binder i v b
forall a. a -> Binder i v a
forall i v. Applicative (Binder i v)
forall a b. Binder i v a -> Binder i v b -> Binder i v b
forall a b. Binder i v a -> (a -> Binder i v b) -> Binder i v b
forall i v a. a -> Binder i v a
forall i v a b. Binder i v a -> Binder i v b -> Binder i v b
forall i v a b. Binder i v a -> (a -> Binder i v b) -> Binder i v b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Binder i v a
$creturn :: forall i v a. a -> Binder i v a
>> :: Binder i v a -> Binder i v b -> Binder i v b
$c>> :: forall i v a b. Binder i v a -> Binder i v b -> Binder i v b
>>= :: Binder i v a -> (a -> Binder i v b) -> Binder i v b
$c>>= :: forall i v a b. Binder i v a -> (a -> Binder i v b) -> Binder i v b
$cp1Monad :: forall i v. Applicative (Binder i v)
Monad,Functor (Binder i v)
a -> Binder i v a
Functor (Binder i v)
-> (forall a. a -> Binder i v a)
-> (forall a b.
    Binder i v (a -> b) -> Binder i v a -> Binder i v b)
-> (forall a b c.
    (a -> b -> c) -> Binder i v a -> Binder i v b -> Binder i v c)
-> (forall a b. Binder i v a -> Binder i v b -> Binder i v b)
-> (forall a b. Binder i v a -> Binder i v b -> Binder i v a)
-> Applicative (Binder i v)
Binder i v a -> Binder i v b -> Binder i v b
Binder i v a -> Binder i v b -> Binder i v a
Binder i v (a -> b) -> Binder i v a -> Binder i v b
(a -> b -> c) -> Binder i v a -> Binder i v b -> Binder i v c
forall a. a -> Binder i v a
forall i v. Functor (Binder i v)
forall a b. Binder i v a -> Binder i v b -> Binder i v a
forall a b. Binder i v a -> Binder i v b -> Binder i v b
forall a b. Binder i v (a -> b) -> Binder i v a -> Binder i v b
forall i v a. a -> Binder i v a
forall a b c.
(a -> b -> c) -> Binder i v a -> Binder i v b -> Binder i v c
forall i v a b. Binder i v a -> Binder i v b -> Binder i v a
forall i v a b. Binder i v a -> Binder i v b -> Binder i v b
forall i v a b. Binder i v (a -> b) -> Binder i v a -> Binder i v b
forall i v a b c.
(a -> b -> c) -> Binder i v a -> Binder i v b -> Binder i v c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Binder i v a -> Binder i v b -> Binder i v a
$c<* :: forall i v a b. Binder i v a -> Binder i v b -> Binder i v a
*> :: Binder i v a -> Binder i v b -> Binder i v b
$c*> :: forall i v a b. Binder i v a -> Binder i v b -> Binder i v b
liftA2 :: (a -> b -> c) -> Binder i v a -> Binder i v b -> Binder i v c
$cliftA2 :: forall i v a b c.
(a -> b -> c) -> Binder i v a -> Binder i v b -> Binder i v c
<*> :: Binder i v (a -> b) -> Binder i v a -> Binder i v b
$c<*> :: forall i v a b. Binder i v (a -> b) -> Binder i v a -> Binder i v b
pure :: a -> Binder i v a
$cpure :: forall i v a. a -> Binder i v a
$cp1Applicative :: forall i v. Functor (Binder i v)
Applicative,a -> Binder i v b -> Binder i v a
(a -> b) -> Binder i v a -> Binder i v b
(forall a b. (a -> b) -> Binder i v a -> Binder i v b)
-> (forall a b. a -> Binder i v b -> Binder i v a)
-> Functor (Binder i v)
forall a b. a -> Binder i v b -> Binder i v a
forall a b. (a -> b) -> Binder i v a -> Binder i v b
forall i v a b. a -> Binder i v b -> Binder i v a
forall i v a b. (a -> b) -> Binder i v a -> Binder i v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Binder i v b -> Binder i v a
$c<$ :: forall i v a b. a -> Binder i v b -> Binder i v a
fmap :: (a -> b) -> Binder i v a -> Binder i v b
$cfmap :: forall i v a b. (a -> b) -> Binder i v a -> Binder i v b
Functor)

runBinder :: Binder i v a -> [(i, v)] -> [(i, v)]
runBinder :: Binder i v a -> [(i, v)] -> [(i, v)]
runBinder = Endo [(i, v)] -> [(i, v)] -> [(i, v)]
forall a. Endo a -> a -> a
appEndo (Endo [(i, v)] -> [(i, v)] -> [(i, v)])
-> (Binder i v a -> Endo [(i, v)])
-> Binder i v a
-> [(i, v)]
-> [(i, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (Endo [(i, v)]) a -> Endo [(i, v)]
forall w a. Writer w a -> w
execWriter (Writer (Endo [(i, v)]) a -> Endo [(i, v)])
-> (Binder i v a -> Writer (Endo [(i, v)]) a)
-> Binder i v a
-> Endo [(i, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binder i v a -> Writer (Endo [(i, v)]) a
forall i v a. Binder i v a -> Writer (Endo [(i, v)]) a
unBinder

-- | Build a 'Binding' with no explicit or implicit state. The bound
-- actions are activated regardless of the back-end or front-end
-- state.
--
-- If different actions are bound to the same input, the latter action
-- wins.
--
-- Result of action (@r@) is discarded.
binds :: Ord i => Binder i (Action IO r) a -> Binding' bs fs i
binds :: Binder i (Action IO r) a -> Binding' bs fs i
binds = [(i, Action IO r)] -> Binding' bs fs i
forall i r bs fs. Ord i => [(i, Action IO r)] -> Binding' bs fs i
binding ([(i, Action IO r)] -> Binding' bs fs i)
-> (Binder i (Action IO r) a -> [(i, Action IO r)])
-> Binder i (Action IO r) a
-> Binding' bs fs i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binder i (Action IO r) a
 -> [(i, Action IO r)] -> [(i, Action IO r)])
-> [(i, Action IO r)]
-> Binder i (Action IO r) a
-> [(i, Action IO r)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Binder i (Action IO r) a
-> [(i, Action IO r)] -> [(i, Action IO r)]
forall i v a. Binder i v a -> [(i, v)] -> [(i, v)]
runBinder []

-- | Like 'binds', but this function allows actions to use the current
-- front-end state via 'ReaderT'.
--
-- @since 0.1.1.0
bindsF :: Ord i => Binder i (Action (ReaderT fs IO) r) a -> Binding' bs fs i
bindsF :: Binder i (Action (ReaderT fs IO) r) a -> Binding' bs fs i
bindsF = [(i, Action (ReaderT fs IO) r)] -> Binding' bs fs i
forall i fs r bs.
Ord i =>
[(i, Action (ReaderT fs IO) r)] -> Binding' bs fs i
bindingF ([(i, Action (ReaderT fs IO) r)] -> Binding' bs fs i)
-> (Binder i (Action (ReaderT fs IO) r) a
    -> [(i, Action (ReaderT fs IO) r)])
-> Binder i (Action (ReaderT fs IO) r) a
-> Binding' bs fs i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binder i (Action (ReaderT fs IO) r) a
 -> [(i, Action (ReaderT fs IO) r)]
 -> [(i, Action (ReaderT fs IO) r)])
-> [(i, Action (ReaderT fs IO) r)]
-> Binder i (Action (ReaderT fs IO) r) a
-> [(i, Action (ReaderT fs IO) r)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Binder i (Action (ReaderT fs IO) r) a
-> [(i, Action (ReaderT fs IO) r)]
-> [(i, Action (ReaderT fs IO) r)]
forall i v a. Binder i v a -> [(i, v)] -> [(i, v)]
runBinder []

-- | Build a 'Binding'' with an explicit state (but no implicit
-- state). The bound actions are activated regardless of the back-end
-- or front-end state.
binds' :: Ord i => Binder i (Action (StateT bs IO) r) a -> Binding' bs fs i
binds' :: Binder i (Action (StateT bs IO) r) a -> Binding' bs fs i
binds' = [(i, Action (StateT bs IO) r)] -> Binding' bs fs i
forall i bs r fs.
Ord i =>
[(i, Action (StateT bs IO) r)] -> Binding' bs fs i
binding' ([(i, Action (StateT bs IO) r)] -> Binding' bs fs i)
-> (Binder i (Action (StateT bs IO) r) a
    -> [(i, Action (StateT bs IO) r)])
-> Binder i (Action (StateT bs IO) r) a
-> Binding' bs fs i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binder i (Action (StateT bs IO) r) a
 -> [(i, Action (StateT bs IO) r)]
 -> [(i, Action (StateT bs IO) r)])
-> [(i, Action (StateT bs IO) r)]
-> Binder i (Action (StateT bs IO) r) a
-> [(i, Action (StateT bs IO) r)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Binder i (Action (StateT bs IO) r) a
-> [(i, Action (StateT bs IO) r)] -> [(i, Action (StateT bs IO) r)]
forall i v a. Binder i v a -> [(i, v)] -> [(i, v)]
runBinder []

-- | Like 'binds'', but this function allows actions to use the
-- current front-end state via 'ReaderT'.
--
-- @since 0.1.1.0
bindsF' :: Ord i => Binder i (Action (StateT bs (ReaderT fs IO)) r) a -> Binding' bs fs i
bindsF' :: Binder i (Action (StateT bs (ReaderT fs IO)) r) a
-> Binding' bs fs i
bindsF' = [(i, Action (StateT bs (ReaderT fs IO)) r)] -> Binding' bs fs i
forall i bs fs r.
Ord i =>
[(i, Action (StateT bs (ReaderT fs IO)) r)] -> Binding' bs fs i
bindingF' ([(i, Action (StateT bs (ReaderT fs IO)) r)] -> Binding' bs fs i)
-> (Binder i (Action (StateT bs (ReaderT fs IO)) r) a
    -> [(i, Action (StateT bs (ReaderT fs IO)) r)])
-> Binder i (Action (StateT bs (ReaderT fs IO)) r) a
-> Binding' bs fs i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binder i (Action (StateT bs (ReaderT fs IO)) r) a
 -> [(i, Action (StateT bs (ReaderT fs IO)) r)]
 -> [(i, Action (StateT bs (ReaderT fs IO)) r)])
-> [(i, Action (StateT bs (ReaderT fs IO)) r)]
-> Binder i (Action (StateT bs (ReaderT fs IO)) r) a
-> [(i, Action (StateT bs (ReaderT fs IO)) r)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Binder i (Action (StateT bs (ReaderT fs IO)) r) a
-> [(i, Action (StateT bs (ReaderT fs IO)) r)]
-> [(i, Action (StateT bs (ReaderT fs IO)) r)]
forall i v a. Binder i v a -> [(i, v)] -> [(i, v)]
runBinder []

-- | Create a 'Binder' that binds the action @v@ to the input @i@.
on :: i -> v -> Binder i v ()
on :: i -> v -> Binder i v ()
on i
i v
v = Writer (Endo [(i, v)]) () -> Binder i v ()
forall i v a. Writer (Endo [(i, v)]) a -> Binder i v a
Binder (Writer (Endo [(i, v)]) () -> Binder i v ())
-> Writer (Endo [(i, v)]) () -> Binder i v ()
forall a b. (a -> b) -> a -> b
$ Endo [(i, v)] -> Writer (Endo [(i, v)]) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (Endo [(i, v)] -> Writer (Endo [(i, v)]) ())
-> Endo [(i, v)] -> Writer (Endo [(i, v)]) ()
forall a b. (a -> b) -> a -> b
$ ([(i, v)] -> [(i, v)]) -> Endo [(i, v)]
forall a. (a -> a) -> Endo a
Endo ((i
i,v
v) (i, v) -> [(i, v)] -> [(i, v)]
forall a. a -> [a] -> [a]
:)

-- | Transform the given action @m a@ into an 'Action' and apply the
-- continuation to it. It discards the result of action (type
-- @a@). Usually used as an operator.
run :: Functor m => (Action m () -> b) -> m a -> b
run :: (Action m () -> b) -> m a -> b
run Action m () -> b
cont m a
raw_act = Action m () -> b
cont (Action m () -> b) -> Action m () -> b
forall a b. (a -> b) -> a -> b
$ Action :: forall (m :: * -> *) a. ActionDescription -> m a -> Action m a
Action { actDescription :: ActionDescription
actDescription = ActionDescription
"", actDo :: m ()
actDo = (a -> ()) -> m a -> m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> a -> ()
forall a b. a -> b -> a
const ()) m a
raw_act }

infixl 2 `run`

-- | Transform the given continuation so that the 'ActionDescription'
-- is set to the 'Action' passed to the continuation. Usually used as
-- an operator.
as :: (Action m a -> b) -> ActionDescription -> Action m a -> b
as :: (Action m a -> b) -> ActionDescription -> Action m a -> b
as Action m a -> b
cont ActionDescription
desc Action m a
act = Action m a -> b
cont (Action m a -> b) -> Action m a -> b
forall a b. (a -> b) -> a -> b
$ Action m a
act { actDescription :: ActionDescription
actDescription = ActionDescription
desc }

infixl 2 `as`

-- | Transform the actions in the given 'Binder'.
advice :: (v -> v') -> Binder i v a -> Binder i v' a
advice :: (v -> v') -> Binder i v a -> Binder i v' a
advice v -> v'
f = Writer (Endo [(i, v')]) a -> Binder i v' a
forall i v a. Writer (Endo [(i, v)]) a -> Binder i v a
Binder (Writer (Endo [(i, v')]) a -> Binder i v' a)
-> (Binder i v a -> Writer (Endo [(i, v')]) a)
-> Binder i v a
-> Binder i v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Endo [(i, v)]) -> (a, Endo [(i, v')]))
-> Writer (Endo [(i, v)]) a -> Writer (Endo [(i, v')]) a
forall a w b w'. ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
mapWriter (a, Endo [(i, v)]) -> (a, Endo [(i, v')])
forall a a. (a, Endo [(a, v)]) -> (a, Endo [(a, v')])
f_writer (Writer (Endo [(i, v)]) a -> Writer (Endo [(i, v')]) a)
-> (Binder i v a -> Writer (Endo [(i, v)]) a)
-> Binder i v a
-> Writer (Endo [(i, v')]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binder i v a -> Writer (Endo [(i, v)]) a
forall i v a. Binder i v a -> Writer (Endo [(i, v)]) a
unBinder where
  f_writer :: (a, Endo [(a, v)]) -> (a, Endo [(a, v')])
f_writer (a
a, Endo [(a, v)]
e) = (a
a, Endo [(a, v)] -> Endo [(a, v')]
forall a. Endo [(a, v)] -> Endo [(a, v')]
f_endo Endo [(a, v)]
e)
  f_endo :: Endo [(a, v)] -> Endo [(a, v')]
f_endo (Endo [(a, v)] -> [(a, v)]
prepender) = ([(a, v')] -> [(a, v')]) -> Endo [(a, v')]
forall a. (a -> a) -> Endo a
Endo ((((a, v) -> (a, v')) -> [(a, v)] -> [(a, v')]
forall a b. (a -> b) -> [a] -> [b]
map (a, v) -> (a, v')
forall a. (a, v) -> (a, v')
f_pair ([(a, v)] -> [(a, v')]) -> [(a, v)] -> [(a, v')]
forall a b. (a -> b) -> a -> b
$ [(a, v)] -> [(a, v)]
prepender []) [(a, v')] -> [(a, v')] -> [(a, v')]
forall a. [a] -> [a] -> [a]
++)
  f_pair :: (a, v) -> (a, v')
f_pair (a
i, v
v) = (a
i, v -> v'
f v
v)

statelessBinding :: M.Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
statelessBinding :: Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
statelessBinding Map i (Action (ReaderT fs IO) r)
bind_map = Binding' bs fs i
forall bs. Binding' bs fs i
impl where
  impl :: Binding' bs fs i
impl = (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
 -> Binding' bs fs i)
-> (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
_ fs
_ -> ((Action (ReaderT fs IO) (Binding' bs fs i)
 -> Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (ReaderT fs IO) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action (ReaderT fs IO) (Binding' bs fs i)
  -> Action (SRIM bs fs) (Binding' bs fs i))
 -> Map i (Action (ReaderT fs IO) (Binding' bs fs i))
 -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> ((ReaderT fs IO (Binding' bs fs i)
     -> StateT bs (ReaderT fs IO) (Binding' bs fs i))
    -> Action (ReaderT fs IO) (Binding' bs fs i)
    -> Action (SRIM bs fs) (Binding' bs fs i))
-> (ReaderT fs IO (Binding' bs fs i)
    -> StateT bs (ReaderT fs IO) (Binding' bs fs i))
-> Map i (Action (ReaderT fs IO) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT fs IO (Binding' bs fs i)
 -> StateT bs (ReaderT fs IO) (Binding' bs fs i))
-> Action (ReaderT fs IO) (Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo) ReaderT fs IO (Binding' bs fs i)
-> StateT bs (ReaderT fs IO) (Binding' bs fs i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Map i (Action (ReaderT fs IO) (Binding' bs fs i))
 -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (ReaderT fs IO) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ (r -> Binding' bs fs i)
-> Map i (Action (ReaderT fs IO) r)
-> Map i (Action (ReaderT fs IO) (Binding' bs fs i))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (Binding' bs fs i -> r -> Binding' bs fs i
forall a b. a -> b -> a
const Binding' bs fs i
impl) (Map i (Action (ReaderT fs IO) r)
 -> Map i (Action (ReaderT fs IO) (Binding' bs fs i)))
-> Map i (Action (ReaderT fs IO) r)
-> Map i (Action (ReaderT fs IO) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ Map i (Action (ReaderT fs IO) r)
bind_map

-- | Non-monadic version of 'binds'.
binding :: Ord i => [(i, Action IO r)] -> Binding' bs fs i
binding :: [(i, Action IO r)] -> Binding' bs fs i
binding = Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
forall i fs r bs.
Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
statelessBinding (Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i)
-> ([(i, Action IO r)] -> Map i (Action (ReaderT fs IO) r))
-> [(i, Action IO r)]
-> Binding' bs fs i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Action IO r -> Action (ReaderT fs IO) r)
-> Map i (Action IO r) -> Map i (Action (ReaderT fs IO) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action IO r -> Action (ReaderT fs IO) r
forall (m :: * -> *) a fs.
Monad m =>
Action m a -> Action (ReaderT fs m) a
liftActionR (Map i (Action IO r) -> Map i (Action (ReaderT fs IO) r))
-> ([(i, Action IO r)] -> Map i (Action IO r))
-> [(i, Action IO r)]
-> Map i (Action (ReaderT fs IO) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(i, Action IO r)] -> Map i (Action IO r)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

-- | Non-monadic version of 'bindsF'.
--
-- @since 0.1.1.0
bindingF :: Ord i => [(i, Action (ReaderT fs IO) r)] -> Binding' bs fs i
bindingF :: [(i, Action (ReaderT fs IO) r)] -> Binding' bs fs i
bindingF = Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
forall i fs r bs.
Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
statelessBinding (Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i)
-> ([(i, Action (ReaderT fs IO) r)]
    -> Map i (Action (ReaderT fs IO) r))
-> [(i, Action (ReaderT fs IO) r)]
-> Binding' bs fs i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(i, Action (ReaderT fs IO) r)] -> Map i (Action (ReaderT fs IO) r)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

-- | Create a binding that behaves differently for different front-end
-- states @fs@.
ifFront :: (fs -> Bool) -- ^ The predicate
        -> Binding' bs fs i -- ^ Enabled if the predicate is 'True'
        -> Binding' bs fs i -- ^ Enabled if the predicate is 'False'
        -> Binding' bs fs i
ifFront :: (fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifFront fs -> Bool
p = (bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBoth ((bs -> fs -> Bool)
 -> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i)
-> (bs -> fs -> Bool)
-> Binding' bs fs i
-> Binding' bs fs i
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
_ fs
fs -> fs -> Bool
p fs
fs

-- | Create a binding that behaves differently for different back-end
-- states @bs@.
ifBack :: (bs -> Bool) -- ^ The predicate
       -> Binding' bs fs i -- ^ Enabled if the predicate is 'True'
       -> Binding' bs fs i -- ^ Enabled if the predicate is 'False'
       -> Binding' bs fs i
ifBack :: (bs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBack bs -> Bool
p = (bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBoth ((bs -> fs -> Bool)
 -> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i)
-> (bs -> fs -> Bool)
-> Binding' bs fs i
-> Binding' bs fs i
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
bs fs
_ -> bs -> Bool
p bs
bs

-- | Create a binding that behaves differently for different front-end
-- and back-end states, @fs@ and @bs@.
ifBoth :: (bs -> fs -> Bool) -- ^ The predicate
       -> Binding' bs fs i -- ^ Enabled if the predicate is 'True'
       -> Binding' bs fs i -- ^ Enabled if the predicate is 'False'
       -> Binding' bs fs i
ifBoth :: (bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBoth bs -> fs -> Bool
p Binding' bs fs i
thenb Binding' bs fs i
elseb = (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
 -> Binding' bs fs i)
-> (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs ->
  if bs -> fs -> Bool
p bs
bs fs
fs
  then (Binding' bs fs i -> Binding' bs fs i)
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (\Binding' bs fs i
nextb -> (bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBoth bs -> fs -> Bool
p Binding' bs fs i
nextb Binding' bs fs i
elseb) (Map i (Action (SRIM bs fs) (Binding' bs fs i))
 -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
thenb bs
bs fs
fs
  else (Binding' bs fs i -> Binding' bs fs i)
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (\Binding' bs fs i
nextb -> (bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBoth bs -> fs -> Bool
p Binding' bs fs i
thenb Binding' bs fs i
nextb) (Map i (Action (SRIM bs fs) (Binding' bs fs i))
 -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
elseb bs
bs fs
fs

-- | Add a condition on the front-end state to 'Binding'.
whenFront :: (fs -> Bool) -- ^ The predicate.
          -> Binding' bs fs i -- ^ Enabled if the predicate is 'True'
          -> Binding' bs fs i
whenFront :: (fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenFront fs -> Bool
p = (bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenBoth ((bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i)
-> (bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
_ fs
fs -> fs -> Bool
p fs
fs

-- | Add a condition on the back-end state to 'Binding'.
whenBack :: (bs -> Bool) -- ^ The predicate.
         -> Binding' bs fs i -- ^ Enabled if the predicate is 'True'
         -> Binding' bs fs i
whenBack :: (bs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenBack bs -> Bool
p = (bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenBoth ((bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i)
-> (bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
bs fs
_ -> bs -> Bool
p bs
bs

-- | Add a condition on the back-end and front-end states to
-- 'Binding'.
whenBoth :: (bs -> fs -> Bool) -- ^ The predicate.
         -> Binding' bs fs i -- ^ Enabled if the predicate is 'True'.
         -> Binding' bs fs i
whenBoth :: (bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenBoth bs -> fs -> Bool
p Binding' bs fs i
b = (bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBoth bs -> fs -> Bool
p Binding' bs fs i
b Binding' bs fs i
forall bs fs i. Binding' bs fs i
noBinding

-- | Contramap the front-end state.
convFront :: (fs -> fs') -> Binding' bs fs' i -> Binding' bs fs i
convFront :: (fs -> fs') -> Binding' bs fs' i -> Binding' bs fs i
convFront fs -> fs'
cmapper Binding' bs fs' i
orig_bind = (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
 -> Binding' bs fs i)
-> (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs ->
  (Binding' bs fs' i -> Binding' bs fs i)
-> Map i (Action (SRIM bs fs) (Binding' bs fs' i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult ((fs -> fs') -> Binding' bs fs' i -> Binding' bs fs i
forall fs fs' bs i.
(fs -> fs') -> Binding' bs fs' i -> Binding' bs fs i
convFront fs -> fs'
cmapper) (Map i (Action (SRIM bs fs) (Binding' bs fs' i))
 -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (SRIM bs fs) (Binding' bs fs' i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ (Action (SRIM bs fs') (Binding' bs fs' i)
 -> Action (SRIM bs fs) (Binding' bs fs' i))
-> Map i (Action (SRIM bs fs') (Binding' bs fs' i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs' i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((fs -> fs')
-> Action (SRIM bs fs') (Binding' bs fs' i)
-> Action (SRIM bs fs) (Binding' bs fs' i)
forall fs fs' bs a.
(fs -> fs') -> Action (SRIM bs fs') a -> Action (SRIM bs fs) a
withActionR fs -> fs'
cmapper) (Map i (Action (SRIM bs fs') (Binding' bs fs' i))
 -> Map i (Action (SRIM bs fs) (Binding' bs fs' i)))
-> Map i (Action (SRIM bs fs') (Binding' bs fs' i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs' i))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs' i
-> bs -> fs' -> Map i (Action (SRIM bs fs') (Binding' bs fs' i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs' i
orig_bind bs
bs (fs -> fs'
cmapper fs
fs)

-- | Map the front-end input.
convInput :: Ord i' => (i -> i') -> Binding' bs fs i -> Binding' bs fs i'
convInput :: (i -> i') -> Binding' bs fs i -> Binding' bs fs i'
convInput i -> i'
mapper Binding' bs fs i
orig_bind = (bs -> fs -> Map i' (Action (SRIM bs fs) (Binding' bs fs i')))
-> Binding' bs fs i'
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i' (Action (SRIM bs fs) (Binding' bs fs i')))
 -> Binding' bs fs i')
-> (bs -> fs -> Map i' (Action (SRIM bs fs) (Binding' bs fs i')))
-> Binding' bs fs i'
forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs ->
  (Binding' bs fs i -> Binding' bs fs i')
-> Map i' (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i' (Action (SRIM bs fs) (Binding' bs fs i'))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult ((i -> i') -> Binding' bs fs i -> Binding' bs fs i'
forall i' i bs fs.
Ord i' =>
(i -> i') -> Binding' bs fs i -> Binding' bs fs i'
convInput i -> i'
mapper) (Map i' (Action (SRIM bs fs) (Binding' bs fs i))
 -> Map i' (Action (SRIM bs fs) (Binding' bs fs i')))
-> Map i' (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i' (Action (SRIM bs fs) (Binding' bs fs i'))
forall a b. (a -> b) -> a -> b
$ (i -> i')
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i' (Action (SRIM bs fs) (Binding' bs fs i))
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys i -> i'
mapper (Map i (Action (SRIM bs fs) (Binding' bs fs i))
 -> Map i' (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i' (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
orig_bind bs
bs fs
fs

-- | Convert the back-end state. Intuitively, it converts a small
-- state type @bs@ into a bigger state type @bs'@, which includes
-- @bs@.
--
-- For example, if you have a 'Control.Lens.Lens'' @l@, you can do
--
-- > convBack (set l) (view l) b
convBack :: (bs -> bs' -> bs') -- ^ A setter. It's supposed to set
                               -- @bs@ into the original @bs'@ and
                               -- return the result.
         -> (bs' -> bs) -- ^ A getter. It's supposed to extract @bs@
                        -- from @bs'@.
         -> Binding' bs fs i
         -> Binding' bs' fs i
convBack :: (bs -> bs' -> bs')
-> (bs' -> bs) -> Binding' bs fs i -> Binding' bs' fs i
convBack bs -> bs' -> bs'
setter bs' -> bs
getter Binding' bs fs i
orig_bind = (bs' -> fs -> Map i (Action (SRIM bs' fs) (Binding' bs' fs i)))
-> Binding' bs' fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs' -> fs -> Map i (Action (SRIM bs' fs) (Binding' bs' fs i)))
 -> Binding' bs' fs i)
-> (bs' -> fs -> Map i (Action (SRIM bs' fs) (Binding' bs' fs i)))
-> Binding' bs' fs i
forall a b. (a -> b) -> a -> b
$ \bs'
bs' fs
fs ->
  ((Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
 -> Action (SRIM bs' fs) (Binding' bs' fs i))
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Map i (Action (SRIM bs' fs) (Binding' bs' fs i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
  -> Action (SRIM bs' fs) (Binding' bs' fs i))
 -> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> Map i (Action (SRIM bs' fs) (Binding' bs' fs i)))
-> ((StateT bs (ReaderT fs IO) (Binding' bs fs i)
     -> StateT bs' (ReaderT fs IO) (Binding' bs' fs i))
    -> Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
    -> Action (SRIM bs' fs) (Binding' bs' fs i))
-> (StateT bs (ReaderT fs IO) (Binding' bs fs i)
    -> StateT bs' (ReaderT fs IO) (Binding' bs' fs i))
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Map i (Action (SRIM bs' fs) (Binding' bs' fs i))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT bs (ReaderT fs IO) (Binding' bs fs i)
 -> StateT bs' (ReaderT fs IO) (Binding' bs' fs i))
-> Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
-> Action (SRIM bs' fs) (Binding' bs' fs i)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo) StateT bs (ReaderT fs IO) (Binding' bs fs i)
-> StateT bs' (ReaderT fs IO) (Binding' bs' fs i)
forall (m :: * -> *) fs i.
Functor m =>
StateT bs m (Binding' bs fs i) -> StateT bs' m (Binding' bs' fs i)
convState (Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> Map i (Action (SRIM bs' fs) (Binding' bs' fs i)))
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Map i (Action (SRIM bs' fs) (Binding' bs' fs i))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs
-> fs
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
orig_bind (bs' -> bs
getter bs'
bs') fs
fs
  where
    convState :: StateT bs m (Binding' bs fs i) -> StateT bs' m (Binding' bs' fs i)
convState StateT bs m (Binding' bs fs i)
ms = (bs' -> m (Binding' bs' fs i, bs'))
-> StateT bs' m (Binding' bs' fs i)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((bs' -> m (Binding' bs' fs i, bs'))
 -> StateT bs' m (Binding' bs' fs i))
-> (bs' -> m (Binding' bs' fs i, bs'))
-> StateT bs' m (Binding' bs' fs i)
forall a b. (a -> b) -> a -> b
$ \bs'
bs' -> ((Binding' bs fs i, bs) -> (Binding' bs' fs i, bs'))
-> m (Binding' bs fs i, bs) -> m (Binding' bs' fs i, bs')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (bs' -> (Binding' bs fs i, bs) -> (Binding' bs' fs i, bs')
forall fs i.
bs' -> (Binding' bs fs i, bs) -> (Binding' bs' fs i, bs')
convResult bs'
bs') (m (Binding' bs fs i, bs) -> m (Binding' bs' fs i, bs'))
-> m (Binding' bs fs i, bs) -> m (Binding' bs' fs i, bs')
forall a b. (a -> b) -> a -> b
$ StateT bs m (Binding' bs fs i) -> bs -> m (Binding' bs fs i, bs)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT bs m (Binding' bs fs i)
ms (bs -> m (Binding' bs fs i, bs)) -> bs -> m (Binding' bs fs i, bs)
forall a b. (a -> b) -> a -> b
$ bs' -> bs
getter bs'
bs'
    convResult :: bs' -> (Binding' bs fs i, bs) -> (Binding' bs' fs i, bs')
convResult bs'
bs' (Binding' bs fs i
next_b, bs
bs) = ((bs -> bs' -> bs')
-> (bs' -> bs) -> Binding' bs fs i -> Binding' bs' fs i
forall bs bs' fs i.
(bs -> bs' -> bs')
-> (bs' -> bs) -> Binding' bs fs i -> Binding' bs' fs i
convBack bs -> bs' -> bs'
setter bs' -> bs
getter Binding' bs fs i
next_b, bs -> bs' -> bs'
setter bs
bs bs'
bs')

-- | Convert 'Binding'' to 'Binding' by hiding the explicit state
-- @bs@.
startFrom :: bs -- ^ Initial state
          -> Binding' bs fs i -- ^ Binding' with explicit state
          -> Binding fs i -- ^ Binding containing the state inside
startFrom :: bs -> Binding' bs fs i -> Binding fs i
startFrom bs
init_state Binding' bs fs i
b' = (() -> fs -> Map i (Action (SRIM () fs) (Binding fs i)))
-> Binding fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((() -> fs -> Map i (Action (SRIM () fs) (Binding fs i)))
 -> Binding fs i)
-> (() -> fs -> Map i (Action (SRIM () fs) (Binding fs i)))
-> Binding fs i
forall a b. (a -> b) -> a -> b
$ \() fs
front_state ->
  ((Binding' bs fs i, bs) -> Binding fs i)
-> Map i (Action (SRIM () fs) (Binding' bs fs i, bs))
-> Map i (Action (SRIM () fs) (Binding fs i))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (Binding' bs fs i, bs) -> Binding fs i
forall bs fs i. (Binding' bs fs i, bs) -> Binding fs i
toB (Map i (Action (SRIM () fs) (Binding' bs fs i, bs))
 -> Map i (Action (SRIM () fs) (Binding fs i)))
-> Map i (Action (SRIM () fs) (Binding' bs fs i, bs))
-> Map i (Action (SRIM () fs) (Binding fs i))
forall a b. (a -> b) -> a -> b
$ ((Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
 -> Action (SRIM () fs) (Binding' bs fs i, bs))
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Map i (Action (SRIM () fs) (Binding' bs fs i, bs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
  -> Action (SRIM () fs) (Binding' bs fs i, bs))
 -> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> Map i (Action (SRIM () fs) (Binding' bs fs i, bs)))
-> ((StateT bs (ReaderT fs IO) (Binding' bs fs i)
     -> StateT () (ReaderT fs IO) (Binding' bs fs i, bs))
    -> Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
    -> Action (SRIM () fs) (Binding' bs fs i, bs))
-> (StateT bs (ReaderT fs IO) (Binding' bs fs i)
    -> StateT () (ReaderT fs IO) (Binding' bs fs i, bs))
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Map i (Action (SRIM () fs) (Binding' bs fs i, bs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT bs (ReaderT fs IO) (Binding' bs fs i)
 -> StateT () (ReaderT fs IO) (Binding' bs fs i, bs))
-> Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i)
-> Action (SRIM () fs) (Binding' bs fs i, bs)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo) (bs
-> StateT bs (ReaderT fs IO) (Binding' bs fs i)
-> StateT () (ReaderT fs IO) (Binding' bs fs i, bs)
forall bs fs a. bs -> SRIM bs fs a -> SRIM () fs (a, bs)
startSRIM bs
init_state) (Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
 -> Map i (Action (SRIM () fs) (Binding' bs fs i, bs)))
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
-> Map i (Action (SRIM () fs) (Binding' bs fs i, bs))
forall a b. (a -> b) -> a -> b
$ Binding' bs fs i
-> bs
-> fs
-> Map i (Action (StateT bs (ReaderT fs IO)) (Binding' bs fs i))
forall bs fs i.
Binding' bs fs i
-> bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
unBinding' Binding' bs fs i
b' bs
init_state fs
front_state
  where
    toB :: (Binding' bs fs i, bs) -> Binding fs i
toB (Binding' bs fs i
next_b', bs
next_state) = bs -> Binding' bs fs i -> Binding fs i
forall bs fs i. bs -> Binding' bs fs i -> Binding fs i
startFrom bs
next_state Binding' bs fs i
next_b'

startSRIM :: bs -> SRIM bs fs a -> SRIM () fs (a, bs)
startSRIM :: bs -> SRIM bs fs a -> SRIM () fs (a, bs)
startSRIM bs
bs SRIM bs fs a
m = (() -> ReaderT fs IO ((a, bs), ())) -> SRIM () fs (a, bs)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((() -> ReaderT fs IO ((a, bs), ())) -> SRIM () fs (a, bs))
-> (() -> ReaderT fs IO ((a, bs), ())) -> SRIM () fs (a, bs)
forall a b. (a -> b) -> a -> b
$ \() -> ((a, bs) -> ((a, bs), ()))
-> ReaderT fs IO (a, bs) -> ReaderT fs IO ((a, bs), ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, bs) -> ((a, bs), ())
forall a b. (a, b) -> ((a, b), ())
toState (ReaderT fs IO (a, bs) -> ReaderT fs IO ((a, bs), ()))
-> ReaderT fs IO (a, bs) -> ReaderT fs IO ((a, bs), ())
forall a b. (a -> b) -> a -> b
$ SRIM bs fs a -> bs -> ReaderT fs IO (a, bs)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT SRIM bs fs a
m bs
bs
  where
    toState :: (a, b) -> ((a, b), ())
toState (a
a, b
result_bs) = ((a
a, b
result_bs), ())

-- | Extend 'Binding' to 'Binding''. In the result 'Binding'', the
-- explicit back-end state is just ignored and unmodified.
extend :: Binding fs i -> Binding' bs fs i
extend :: Binding fs i -> Binding' bs fs i
extend = (() -> bs -> bs) -> (bs -> ()) -> Binding fs i -> Binding' bs fs i
forall bs bs' fs i.
(bs -> bs' -> bs')
-> (bs' -> bs) -> Binding' bs fs i -> Binding' bs' fs i
convBack ((bs -> bs) -> () -> bs -> bs
forall a b. a -> b -> a
const bs -> bs
forall a. a -> a
id) (() -> bs -> ()
forall a b. a -> b -> a
const ())

-- | Non-monadic version of 'binds''.
binding' :: Ord i => [(i, Action (StateT bs IO) r)] -> Binding' bs fs i
binding' :: [(i, Action (StateT bs IO) r)] -> Binding' bs fs i
binding' = Map i (Action (SRIM bs fs) r) -> Binding' bs fs i
forall i bs fs r. Map i (Action (SRIM bs fs) r) -> Binding' bs fs i
statefulBinding (Map i (Action (SRIM bs fs) r) -> Binding' bs fs i)
-> ([(i, Action (StateT bs IO) r)]
    -> Map i (Action (SRIM bs fs) r))
-> [(i, Action (StateT bs IO) r)]
-> Binding' bs fs i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Action (StateT bs IO) r -> Action (SRIM bs fs) r)
-> Map i (Action (StateT bs IO) r) -> Map i (Action (SRIM bs fs) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action (StateT bs IO) r -> Action (SRIM bs fs) r
forall s b.
Action (StateT s IO) b -> Action (StateT s (ReaderT fs IO)) b
addR (Map i (Action (StateT bs IO) r) -> Map i (Action (SRIM bs fs) r))
-> ([(i, Action (StateT bs IO) r)]
    -> Map i (Action (StateT bs IO) r))
-> [(i, Action (StateT bs IO) r)]
-> Map i (Action (SRIM bs fs) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(i, Action (StateT bs IO) r)] -> Map i (Action (StateT bs IO) r)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList where
  addR :: Action (StateT s IO) b -> Action (StateT s (ReaderT fs IO)) b
addR = (StateT s IO b -> StateT s (ReaderT fs IO) b)
-> Action (StateT s IO) b -> Action (StateT s (ReaderT fs IO)) b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo ((StateT s IO b -> StateT s (ReaderT fs IO) b)
 -> Action (StateT s IO) b -> Action (StateT s (ReaderT fs IO)) b)
-> (StateT s IO b -> StateT s (ReaderT fs IO) b)
-> Action (StateT s IO) b
-> Action (StateT s (ReaderT fs IO)) b
forall a b. (a -> b) -> a -> b
$ (IO (b, s) -> ReaderT fs IO (b, s))
-> StateT s IO b -> StateT s (ReaderT fs IO) b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT IO (b, s) -> ReaderT fs IO (b, s)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Non-monadic version of 'bindsF''.
--
-- @since 0.1.1.0
bindingF' :: Ord i => [(i, Action (StateT bs (ReaderT fs IO)) r)] -> Binding' bs fs i
bindingF' :: [(i, Action (StateT bs (ReaderT fs IO)) r)] -> Binding' bs fs i
bindingF' = Map i (Action (StateT bs (ReaderT fs IO)) r) -> Binding' bs fs i
forall i bs fs r. Map i (Action (SRIM bs fs) r) -> Binding' bs fs i
statefulBinding (Map i (Action (StateT bs (ReaderT fs IO)) r) -> Binding' bs fs i)
-> ([(i, Action (StateT bs (ReaderT fs IO)) r)]
    -> Map i (Action (StateT bs (ReaderT fs IO)) r))
-> [(i, Action (StateT bs (ReaderT fs IO)) r)]
-> Binding' bs fs i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(i, Action (StateT bs (ReaderT fs IO)) r)]
-> Map i (Action (StateT bs (ReaderT fs IO)) r)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

statefulBinding :: M.Map i (Action (SRIM bs fs) r) -> Binding' bs fs i
statefulBinding :: Map i (Action (SRIM bs fs) r) -> Binding' bs fs i
statefulBinding Map i (Action (SRIM bs fs) r)
bind_map = Binding' bs fs i
impl where
  impl :: Binding' bs fs i
impl = (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
 -> Binding' bs fs i)
-> (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
_ fs
_ -> (r -> Binding' bs fs i)
-> Map i (Action (SRIM bs fs) r)
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (Binding' bs fs i -> r -> Binding' bs fs i
forall a b. a -> b -> a
const Binding' bs fs i
impl) Map i (Action (SRIM bs fs) r)
bind_map

-- | Revise (modify) actions in the given 'Binding''.
--
-- @since 0.1.1.0
revise :: (forall a . bs -> fs -> i -> Action IO a -> Maybe (Action IO a))
       -- ^ A function to revise the action. If it returns 'Nothing',
       -- the action is unbound.
       -> Binding' bs fs i
       -- ^ original binding
       -> Binding' bs fs i
       -- ^ revised binding
revise :: (forall a. bs -> fs -> i -> Action IO a -> Maybe (Action IO a))
-> Binding' bs fs i -> Binding' bs fs i
revise forall a. bs -> fs -> i -> Action IO a -> Maybe (Action IO a)
f = Binding' bs fs i -> Binding' bs fs i
reviseThis where
  reviseThis :: Binding' bs fs i -> Binding' bs fs i
reviseThis (Binding' bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
orig) = (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
 -> Binding' bs fs i)
-> (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs -> (i
 -> Action (SRIM bs fs) (Binding' bs fs i)
 -> Maybe (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey (bs
-> fs
-> i
-> Action (SRIM bs fs) (Binding' bs fs i)
-> Maybe (Action (SRIM bs fs) (Binding' bs fs i))
f_to_map bs
bs fs
fs) (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
orig bs
bs fs
fs)
  f_to_map :: bs
-> fs
-> i
-> Action (SRIM bs fs) (Binding' bs fs i)
-> Maybe (Action (SRIM bs fs) (Binding' bs fs i))
f_to_map bs
bs fs
fs i
i Action (SRIM bs fs) (Binding' bs fs i)
orig_act = (Action IO (Binding' bs fs i, bs)
 -> Action (SRIM bs fs) (Binding' bs fs i))
-> Maybe (Action IO (Binding' bs fs i, bs))
-> Maybe (Action (SRIM bs fs) (Binding' bs fs i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action IO (Binding' bs fs i, bs)
-> Action (SRIM bs fs) (Binding' bs fs i)
convertResult (Maybe (Action IO (Binding' bs fs i, bs))
 -> Maybe (Action (SRIM bs fs) (Binding' bs fs i)))
-> Maybe (Action IO (Binding' bs fs i, bs))
-> Maybe (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ bs
-> fs
-> i
-> Action IO (Binding' bs fs i, bs)
-> Maybe (Action IO (Binding' bs fs i, bs))
forall a. bs -> fs -> i -> Action IO a -> Maybe (Action IO a)
f bs
bs fs
fs i
i (Action IO (Binding' bs fs i, bs)
 -> Maybe (Action IO (Binding' bs fs i, bs)))
-> Action IO (Binding' bs fs i, bs)
-> Maybe (Action IO (Binding' bs fs i, bs))
forall a b. (a -> b) -> a -> b
$ (StateT bs (ReaderT fs IO) (Binding' bs fs i)
 -> IO (Binding' bs fs i, bs))
-> Action (SRIM bs fs) (Binding' bs fs i)
-> Action IO (Binding' bs fs i, bs)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo (bs
-> fs
-> StateT bs (ReaderT fs IO) (Binding' bs fs i)
-> IO (Binding' bs fs i, bs)
forall bs fs a. bs -> fs -> SRIM bs fs a -> IO (a, bs)
runSRIM bs
bs fs
fs) Action (SRIM bs fs) (Binding' bs fs i)
orig_act
  convertResult :: Action IO (Binding' bs fs i, bs)
-> Action (SRIM bs fs) (Binding' bs fs i)
convertResult = (Binding' bs fs i -> Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Binding' bs fs i -> Binding' bs fs i
reviseThis (Action (SRIM bs fs) (Binding' bs fs i)
 -> Action (SRIM bs fs) (Binding' bs fs i))
-> (Action IO (Binding' bs fs i, bs)
    -> Action (SRIM bs fs) (Binding' bs fs i))
-> Action IO (Binding' bs fs i, bs)
-> Action (SRIM bs fs) (Binding' bs fs i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO (Binding' bs fs i, bs)
 -> StateT bs (ReaderT fs IO) (Binding' bs fs i))
-> Action IO (Binding' bs fs i, bs)
-> Action (SRIM bs fs) (Binding' bs fs i)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo IO (Binding' bs fs i, bs)
-> StateT bs (ReaderT fs IO) (Binding' bs fs i)
forall a bs fs. IO (a, bs) -> SRIM bs fs a
redoSRIM

-- | Like 'revise', but this function allows revising the back-end state.
--
-- @since 0.1.1.0
revise' :: (forall a . bs -> fs -> i -> Action (StateT bs IO) a -> Maybe (Action (StateT bs IO) a))
        -> Binding' bs fs i
        -> Binding' bs fs i
revise' :: (forall a.
 bs
 -> fs
 -> i
 -> Action (StateT bs IO) a
 -> Maybe (Action (StateT bs IO) a))
-> Binding' bs fs i -> Binding' bs fs i
revise' forall a.
bs
-> fs
-> i
-> Action (StateT bs IO) a
-> Maybe (Action (StateT bs IO) a)
f = Binding' bs fs i -> Binding' bs fs i
reviseThis where
  reviseThis :: Binding' bs fs i -> Binding' bs fs i
reviseThis (Binding' bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
orig) = (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' ((bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
 -> Binding' bs fs i)
-> (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs -> (i
 -> Action (SRIM bs fs) (Binding' bs fs i)
 -> Maybe (Action (SRIM bs fs) (Binding' bs fs i)))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
-> Map i (Action (SRIM bs fs) (Binding' bs fs i))
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey (bs
-> fs
-> i
-> Action (SRIM bs fs) (Binding' bs fs i)
-> Maybe (Action (SRIM bs fs) (Binding' bs fs i))
f_to_map bs
bs fs
fs) (bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i))
orig bs
bs fs
fs)
  f_to_map :: bs
-> fs
-> i
-> Action (SRIM bs fs) (Binding' bs fs i)
-> Maybe (Action (SRIM bs fs) (Binding' bs fs i))
f_to_map bs
bs fs
fs i
i Action (SRIM bs fs) (Binding' bs fs i)
orig_act = (Action (StateT bs IO) (Binding' bs fs i)
 -> Action (SRIM bs fs) (Binding' bs fs i))
-> Maybe (Action (StateT bs IO) (Binding' bs fs i))
-> Maybe (Action (SRIM bs fs) (Binding' bs fs i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action (StateT bs IO) (Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
convertResult (Maybe (Action (StateT bs IO) (Binding' bs fs i))
 -> Maybe (Action (SRIM bs fs) (Binding' bs fs i)))
-> Maybe (Action (StateT bs IO) (Binding' bs fs i))
-> Maybe (Action (SRIM bs fs) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ bs
-> fs
-> i
-> Action (StateT bs IO) (Binding' bs fs i)
-> Maybe (Action (StateT bs IO) (Binding' bs fs i))
forall a.
bs
-> fs
-> i
-> Action (StateT bs IO) a
-> Maybe (Action (StateT bs IO) a)
f bs
bs fs
fs i
i (Action (StateT bs IO) (Binding' bs fs i)
 -> Maybe (Action (StateT bs IO) (Binding' bs fs i)))
-> Action (StateT bs IO) (Binding' bs fs i)
-> Maybe (Action (StateT bs IO) (Binding' bs fs i))
forall a b. (a -> b) -> a -> b
$ (StateT bs (ReaderT fs IO) (Binding' bs fs i)
 -> StateT bs IO (Binding' bs fs i))
-> Action (SRIM bs fs) (Binding' bs fs i)
-> Action (StateT bs IO) (Binding' bs fs i)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo (fs
-> StateT bs (ReaderT fs IO) (Binding' bs fs i)
-> StateT bs IO (Binding' bs fs i)
forall fs bs a. fs -> SRIM bs fs a -> StateT bs IO a
runR fs
fs) Action (SRIM bs fs) (Binding' bs fs i)
orig_act
  runR :: fs -> SRIM bs fs a -> StateT bs IO a
  runR :: fs -> SRIM bs fs a -> StateT bs IO a
runR fs
fs SRIM bs fs a
m = (ReaderT fs IO (a, bs) -> IO (a, bs))
-> SRIM bs fs a -> StateT bs IO a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((ReaderT fs IO (a, bs) -> fs -> IO (a, bs))
-> fs -> ReaderT fs IO (a, bs) -> IO (a, bs)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT fs IO (a, bs) -> fs -> IO (a, bs)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT fs
fs) SRIM bs fs a
m
  convertResult :: Action (StateT bs IO) (Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
convertResult = (Binding' bs fs i -> Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Binding' bs fs i -> Binding' bs fs i
reviseThis (Action (SRIM bs fs) (Binding' bs fs i)
 -> Action (SRIM bs fs) (Binding' bs fs i))
-> (Action (StateT bs IO) (Binding' bs fs i)
    -> Action (SRIM bs fs) (Binding' bs fs i))
-> Action (StateT bs IO) (Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT bs IO (Binding' bs fs i)
 -> StateT bs (ReaderT fs IO) (Binding' bs fs i))
-> Action (StateT bs IO) (Binding' bs fs i)
-> Action (SRIM bs fs) (Binding' bs fs i)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo StateT bs IO (Binding' bs fs i)
-> StateT bs (ReaderT fs IO) (Binding' bs fs i)
forall bs a fs. StateT bs IO a -> SRIM bs fs a
toSRIM
  toSRIM :: StateT bs IO a -> SRIM bs fs a
  toSRIM :: StateT bs IO a -> SRIM bs fs a
toSRIM StateT bs IO a
m = (IO (a, bs) -> ReaderT fs IO (a, bs))
-> StateT bs IO a -> SRIM bs fs a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT IO (a, bs) -> ReaderT fs IO (a, bs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT bs IO a
m