{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
-- |
-- 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 (..), mapStateT, runStateT)
import           Control.Monad.Trans.Writer (Writer, execWriter, mapWriter, tell)
import qualified Data.Map                   as M
import           Data.Monoid                (Endo (Endo, appEndo), Monoid (..))
import           Data.Semigroup             (Semigroup (..))

import           WildBind.Description       (ActionDescription)

-- | Action done by WildBind
data Action m a
  = Action
      { forall (m :: * -> *) a. Action m a -> ActionDescription
actDescription :: ActionDescription
        -- ^ Human-readable description of the action.
      , forall (m :: * -> *) a. 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (m :: * -> *) a. Action m a -> ActionDescription
actDescription Action m a
a)

instance Functor m => Functor (Action m) where
  fmap :: forall a b. (a -> b) -> Action m a -> Action m b
fmap a -> b
f Action m a
a = Action m a
a { actDo :: m b
actDo = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (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 :: forall (m :: * -> *) b a.
Applicative m =>
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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 :: forall (m :: * -> *) b a.
Applicative m =>
m b -> Action m a -> Action m a
after m b
hook Action m a
act = Action m a
act { actDo :: m a
actDo = forall (m :: * -> *) a. Action m a -> m a
actDo Action m a
act 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 :: forall (m :: * -> *) b a.
Applicative m =>
m b -> Action m a -> Maybe (Action m a)
justBefore m b
m Action m a
a = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *) b a.
Applicative m =>
m b -> Action m a -> Maybe (Action m a)
justAfter m b
m Action m a
a = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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' { forall bs fs i.
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 :: forall bs fs a. bs -> fs -> SRIM bs fs a -> IO (a, bs)
runSRIM bs
bs fs
fs SRIM bs fs a
m = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT fs
fs forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall a bs fs. IO (a, bs) -> SRIM bs fs a
redoSRIM IO (a, bs)
m = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *) a (n :: * -> *) b.
(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 forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a fs.
Monad m =>
Action m a -> Action (ReaderT fs m) a
liftActionR = forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo 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 :: forall fs fs' bs a.
(fs -> fs') -> Action (SRIM bs fs') a -> Action (SRIM bs fs) a
withActionR fs -> fs'
f = (forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT) (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 = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs ->
    let amap :: Map i (Action (SRIM bs fs) (Binding' bs fs i))
amap = forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (forall a. Semigroup a => a -> a -> a
<> Binding' bs fs i
bbind) forall a b. (a -> b) -> a -> b
$ 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 = 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 forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ 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 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 = forall bs fs i. Binding' bs fs i
noBinding
  mappend :: Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
mappend = 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 :: forall bs fs i. Binding' bs fs i
noBinding = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
_ fs
_ -> 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 :: forall i s.
Ord i =>
Binding s i -> s -> i -> Maybe (Action IO (Binding s i))
boundAction Binding s i
b s
state i
input = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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' :: forall i bs fs.
Ord i =>
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 = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo) (forall bs fs a. bs -> fs -> SRIM bs fs a -> IO (a, bs)
runSRIM bs
bs fs
fs) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup i
input forall a b. (a -> b) -> a -> b
$ 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 :: forall s i. Binding s i -> s -> [(i, Action IO (Binding s i))]
boundActions Binding s i
b s
state = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(i
i, Action IO (Binding s i, ())
act) -> (i
i, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Action IO (Binding s i, ())
act)) forall a b. (a -> b) -> a -> b
$ 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' :: 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 = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}.
(a, Action (StateT bs (ReaderT fs IO)) a) -> (a, Action IO (a, bs))
convertAction forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ 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, forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo (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 :: forall s i. Binding s i -> s -> [i]
boundInputs Binding s i
b s
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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' :: forall bs fs i. Binding' bs fs i -> bs -> fs -> [i]
boundInputs' Binding' bs fs i
b bs
bs fs
fs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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 { forall i v a. Binder i v a -> Writer (Endo [(i, v)]) a
unBinder :: Writer (Endo [(i, v)]) a }
  deriving (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
<* :: forall a b. 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
*> :: forall a b. 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 :: forall a b c.
(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
<*> :: forall a b. 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 :: forall a. a -> Binder i v a
$cpure :: forall i v a. a -> Binder i v a
Applicative, 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
<$ :: forall a b. 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 :: forall a b. (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, 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 :: forall a. a -> Binder i v a
$creturn :: forall i v a. a -> Binder i v a
>> :: forall a b. 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
>>= :: forall a 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
Monad)

runBinder :: Binder i v a -> [(i, v)] -> [(i, v)]
runBinder :: forall i v a. Binder i v a -> [(i, v)] -> [(i, v)]
runBinder = forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> w
execWriter forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall i r a bs fs.
Ord i =>
Binder i (Action IO r) a -> Binding' bs fs i
binds = forall i r bs fs. Ord i => [(i, Action IO r)] -> Binding' bs fs i
binding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall i fs r a bs.
Ord i =>
Binder i (Action (ReaderT fs IO) r) a -> Binding' bs fs i
bindsF = forall i fs r bs.
Ord i =>
[(i, Action (ReaderT fs IO) r)] -> Binding' bs fs i
bindingF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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' :: forall i bs r a fs.
Ord i =>
Binder i (Action (StateT bs IO) r) a -> Binding' bs fs i
binds' = forall i bs r fs.
Ord i =>
[(i, Action (StateT bs IO) r)] -> Binding' bs fs i
binding' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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' :: forall i bs fs r a.
Ord i =>
Binder i (Action (StateT bs (ReaderT fs IO)) r) a
-> Binding' bs fs i
bindsF' = forall i bs fs r.
Ord i =>
[(i, Action (StateT bs (ReaderT fs IO)) r)] -> Binding' bs fs i
bindingF' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall i v. i -> v -> Binder i v ()
on i
i v
v = forall i v a. Writer (Endo [(i, v)]) a -> Binder i v a
Binder forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Endo a
Endo ((i
i,v
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 :: forall (m :: * -> *) b a.
Functor m =>
(Action m () -> b) -> m a -> b
run Action m () -> b
cont m a
raw_act = Action m () -> b
cont forall a b. (a -> b) -> a -> b
$ Action { actDescription :: ActionDescription
actDescription = ActionDescription
"", actDo :: m ()
actDo = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 :: forall (m :: * -> *) a b.
(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 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 :: forall v v' i a. (v -> v') -> Binder i v a -> Binder i v' a
advice v -> v'
f = forall i v a. Writer (Endo [(i, v)]) a -> Binder i v a
Binder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a w b w'. ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
mapWriter forall {a} {a}. (a, Endo [(a, v)]) -> (a, Endo [(a, v')])
f_writer forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, 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) = forall a. (a -> a) -> Endo a
Endo ((forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (a, v) -> (a, v')
f_pair forall a b. (a -> b) -> a -> b
$ [(a, v)] -> [(a, v)]
prepender []) 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 :: forall i fs r bs.
Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
statelessBinding Map i (Action (ReaderT fs IO) r)
bind_map = forall {bs}. Binding' bs fs i
impl where
  impl :: Binding' bs fs i
impl = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
_ fs
_ -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (forall a b. a -> b -> a
const Binding' bs fs i
impl) 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 :: forall i r bs fs. Ord i => [(i, Action IO r)] -> Binding' bs fs i
binding = forall i fs r bs.
Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
statelessBinding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a fs.
Monad m =>
Action m a -> Action (ReaderT fs m) a
liftActionR forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall i fs r bs.
Ord i =>
[(i, Action (ReaderT fs IO) r)] -> Binding' bs fs i
bindingF = forall i fs r bs.
Map i (Action (ReaderT fs IO) r) -> Binding' bs fs i
statelessBinding forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall fs bs i.
(fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifFront fs -> Bool
p = forall bs fs i.
(bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBoth 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 :: forall bs fs i.
(bs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBack bs -> Bool
p = forall bs fs i.
(bs -> fs -> Bool)
-> Binding' bs fs i -> Binding' bs fs i -> Binding' bs fs i
ifBoth 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 :: 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
elseb = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs ->
  if bs -> fs -> Bool
p bs
bs fs
fs
  then 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 -> 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) forall a b. (a -> b) -> a -> b
$ 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 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 -> 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) forall a b. (a -> b) -> a -> b
$ 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 :: forall fs bs i.
(fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenFront fs -> Bool
p = forall bs fs i.
(bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenBoth 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 :: forall bs fs i.
(bs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenBack bs -> Bool
p = forall bs fs i.
(bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenBoth 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 :: forall bs fs i.
(bs -> fs -> Bool) -> Binding' bs fs i -> Binding' bs fs i
whenBoth bs -> fs -> Bool
p Binding' bs fs i
b = 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 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 :: forall fs fs' bs i.
(fs -> fs') -> Binding' bs fs' i -> Binding' bs fs i
convFront fs -> fs'
cmapper Binding' bs fs' i
orig_bind = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs ->
  forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (forall fs fs' bs i.
(fs -> fs') -> Binding' bs fs' i -> Binding' bs fs i
convFront fs -> fs'
cmapper) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall fs fs' bs a.
(fs -> fs') -> Action (SRIM bs fs') a -> Action (SRIM bs fs) a
withActionR fs -> fs'
cmapper) forall a b. (a -> b) -> a -> b
$ 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 :: forall i' i bs fs.
Ord i' =>
(i -> i') -> Binding' bs fs i -> Binding' bs fs i'
convInput i -> i'
mapper Binding' bs fs i
orig_bind = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs ->
  forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (forall i' i bs fs.
Ord i' =>
(i -> i') -> Binding' bs fs i -> Binding' bs fs i'
convInput i -> i'
mapper) forall a b. (a -> b) -> a -> b
$ forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys i -> i'
mapper forall a b. (a -> b) -> a -> b
$ 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 :: 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
orig_bind = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs'
bs' fs
fs ->
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo) forall {m :: * -> *} {fs} {i}.
Functor m =>
StateT bs m (Binding' bs fs i) -> StateT bs' m (Binding' bs' fs i)
convState forall a b. (a -> b) -> a -> b
$ 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 = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \bs'
bs' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {fs} {i}.
bs' -> (Binding' bs fs i, bs) -> (Binding' bs' fs i, bs')
convResult bs'
bs') forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT bs m (Binding' bs fs i)
ms 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) = (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 :: forall bs fs i. bs -> Binding' bs fs i -> Binding fs i
startFrom bs
init_state Binding' bs fs i
b' = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \() fs
front_state ->
  forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult forall {bs} {fs} {i}. (Binding' bs fs i, bs) -> Binding fs i
toB forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo) (forall bs fs a. bs -> SRIM bs fs a -> SRIM () fs (a, bs)
startSRIM bs
init_state) forall a b. (a -> b) -> a -> b
$ 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) = 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 :: forall bs fs a. bs -> SRIM bs fs a -> SRIM () fs (a, bs)
startSRIM bs
bs SRIM bs fs a
m = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \() -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {b}. (a, b) -> ((a, b), ())
toState forall a b. (a -> b) -> a -> b
$ 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 :: forall fs i bs. Binding fs i -> Binding' bs fs i
extend = forall bs bs' fs i.
(bs -> bs' -> bs')
-> (bs' -> bs) -> Binding' bs fs i -> Binding' bs' fs i
convBack (forall a b. a -> b -> a
const forall a. a -> a
id) (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' :: forall i bs r fs.
Ord i =>
[(i, Action (StateT bs IO) r)] -> Binding' bs fs i
binding' = forall i bs fs r. Map i (Action (SRIM bs fs) r) -> Binding' bs fs i
statefulBinding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {s} {b}.
Action (StateT s IO) b -> Action (StateT s (ReaderT fs IO)) b
addR forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT 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' :: forall i bs fs r.
Ord i =>
[(i, Action (StateT bs (ReaderT fs IO)) r)] -> Binding' bs fs i
bindingF' = forall i bs fs r. Map i (Action (SRIM bs fs) r) -> Binding' bs fs i
statefulBinding forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall i bs fs r. 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 = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
_ fs
_ -> forall (m :: * -> *) a b i.
Functor m =>
(a -> b) -> Map i (Action m a) -> Map i (Action m b)
mapActResult (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 bs fs i.
(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) = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs -> 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 = 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 forall a b. (a -> b) -> a -> b
$ forall a. bs -> fs -> i -> Action IO a -> Maybe (Action IO a)
f bs
bs fs
fs i
i forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Binding' bs fs i -> Binding' bs fs i
reviseThis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo 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 bs fs i.
(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) = forall bs fs i.
(bs -> fs -> Map i (Action (SRIM bs fs) (Binding' bs fs i)))
-> Binding' bs fs i
Binding' forall a b. (a -> b) -> a -> b
$ \bs
bs fs
fs -> 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 = 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 forall a b. (a -> b) -> a -> b
$ forall a.
bs
-> fs
-> i
-> Action (StateT bs IO) a
-> Maybe (Action (StateT bs IO) a)
f bs
bs fs
fs i
i forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo (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 :: forall fs bs a. fs -> SRIM bs fs a -> StateT bs IO a
runR fs
fs SRIM bs fs a
m = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Binding' bs fs i -> Binding' bs fs i
reviseThis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> Action m a -> Action n b
mapActDo forall bs a fs. StateT bs IO a -> SRIM bs fs a
toSRIM
  toSRIM :: StateT bs IO a -> SRIM bs fs a
  toSRIM :: forall bs a fs. StateT bs IO a -> SRIM bs fs a
toSRIM StateT bs IO a
m = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT bs IO a
m