
   0 | ||| Monad morphisms and interaction with monad transformer stacks.
   1 | module Data.MSF.Trans
   2 | 
   3 | import Control.Monad.Identity
   4 | import Control.Monad.Reader
   5 | import Control.Monad.State
   6 | import Control.Monad.Writer
   7 | import Data.MSF.Core
   8 | import Data.MSF.Util
   9 | import Data.MSF.Running
  10 | 
  11 | --------------------------------------------------------------------------------
  12 | --          General Morphisms
  13 | --------------------------------------------------------------------------------
  14 | 
  15 | ||| The most general structure-preserving monad morphism.
  16 | ||| This can be used to change the input and output type plus
  17 | ||| the effect type of an MSF without affecting its internal
  18 | ||| structure (wiring of stream functions).
  19 | |||
  20 | ||| For examples of usage, have a look at the implementations of
  21 | ||| functions like `unreader`, `reader`, `unstate`, and similar.
  22 | export
  23 | morphGS :
  24 |      {auto _ : Monad m1}
  25 |   -> (forall c . (i1 -> m1(o1,c)) -> i2 -> m2(o2,c))
  26 |   -> MSF m1 i1 o1
  27 |   -> MSF m2 i2 o2
  28 | morphGS f sf = feedback sf (arrM run >>^ \(o2,sf2) => [sf2,o2])
  29 |   where run : HList [MSF m1 i1 o1,i2] -> m2 (o2, MSF m1 i1 o1)
  30 |         run [sf1,vi2] = f (step sf1) vi2
  31 | 
  32 | ||| Applies a monad morphism to change the context of an MSF.
  33 | |||
  34 | ||| ```idris example
  35 | ||| fromPure : Monad m => MSF Identity i o -> MSF m i o
  36 | ||| fromPure = morph (pure . runIdentity)
  37 | ||| ```
  38 | export
  39 | morph : Monad m1 => (forall c . m1 c -> m2 c) -> MSF m1 i1 o1 -> MSF m2 i1 o1
  40 | morph f = morphGS (f .)
  41 | 
  42 | --------------------------------------------------------------------------------
  43 | --          Identity
  44 | --------------------------------------------------------------------------------
  45 | 
  46 | ||| Puts a pure MSF (over the `Identity` monad) in another
  47 | ||| monadic context.
  48 | export
  49 | fromPure : Monad m => MSF Identity i o -> MSF m i o
  50 | fromPure = morph (pure . runIdentity)
  51 | 
  52 | --------------------------------------------------------------------------------
  53 | --          State
  54 | --------------------------------------------------------------------------------
  55 | 
  56 | ||| Alias for `constM get`
  57 | export
  58 | get : MonadState s m => MSF m i s
  59 | get = constM get
  60 | 
  61 | ||| Alias for `constM put`
  62 | export
  63 | put : MonadState s m => MSF m s ()
  64 | put = arrM put
  65 | 
  66 | ||| Alias for `constM modify`
  67 | export
  68 | modify : MonadState s m => MSF m (s -> s) ()
  69 | modify = arrM modify
  70 | 
  71 | ||| Converts an outer `StateT` wrapper to an MSF converting
  72 | ||| an additional argument of the state type.
  73 | export
  74 | fromState : Monad m => MSF (StateT s m) i o -> MSF m (HList [s,i]) (HList [s,o])
  75 | fromState =
  76 |   morphGS (\f,[vs,vi] => (\(vs2,vo,vc) => ([vs2,vo],vc)) <$> runStateT vs (f vi))
  77 | 
  78 | ||| Runs the given stateful MSF as a feedback loop with `ini` as the
  79 | ||| initial input.
  80 | |||
  81 | ||| This is a shorthand for `feedback ini . fromState`.
  82 | export
  83 | loopState : Monad m => (ini : s) -> MSF (StateT s m) i o -> MSF m i o
  84 | loopState ini = feedback ini . fromState
  85 | 
  86 | ||| Like `fromState` but drops the uninteresting unit in- and output.
  87 | export
  88 | fromState_ : Monad m => MSF (StateT s m) () () -> MSF m s s
  89 | fromState_ = morphGS (\f,vs => (\(vs2,_,vc) => (vs2,vc)) <$> runStateT vs (f ()))
  90 | 
  91 | ||| Converts a state transforming MSF to one with its monadic context
  92 | ||| wrapped in `StateT s`.
  93 | export
  94 | toState : Monad m => MSF m (HList [s,i]) (HList [s,o]) -> MSF (StateT s m) i o
  95 | toState =
  96 |   morphGS (\f,vi => ST $ \vs => (\([vs2,vo],vc) => (vs2,vo,vc)) <$> f [vs,vi])
  97 | 
  98 | ||| Like `toState` but for MSFs without additional in- or output
  99 | export
 100 | toState_ : Monad m => MSF m s s -> MSF (StateT s m) () ()
 101 | toState_ = morphGS (\f,_ => ST $ \vs => (\(vs2,vc) => (vs2,(),vc)) <$> f vs)
 102 | 
 103 | --------------------------------------------------------------------------------
 104 | --          Reader
 105 | --------------------------------------------------------------------------------
 106 | 
 107 | ||| Alias for `constM ask`
 108 | export
 109 | ask : MonadReader e m => MSF m i e
 110 | ask = constM ask
 111 | 
 112 | ||| Converts an outer `ReaderT` wrapper to an MSF taking an
 113 | ||| an additional input.
 114 | export
 115 | fromReader : Monad m => MSF (ReaderT e m) i o -> MSF m (HList [e,i]) o
 116 | fromReader = morphGS (\f,[ve,vi] => runReaderT ve (f vi))
 117 | 
 118 | ||| Converts the given MSF to use `env` as its environment.
 119 | |||
 120 | ||| This is an alias for `fan [ const env, id ] >>> fromReader sf`.
 121 | export
 122 | withEnv : Monad m => (env : e) -> (sf : MSF (ReaderT e m) i o) -> MSF m i o
 123 | withEnv env sf = fan [ const env, id ] >>> fromReader sf
 124 | 
 125 | ||| Like `unReader` but drops the uninteresting unit input.
 126 | export
 127 | fromReader_ : Monad m => MSF (ReaderT e m) () o -> MSF m e o
 128 | fromReader_ = morphGS (\f,ve => runReaderT ve (f ()))
 129 | 
 130 | ||| Converts an MSF taking an additional input
 131 | ||| to one with its monadic context wrapped in `ReaderT e`.
 132 | export
 133 | toReader : Monad m => MSF m (HList [e,i]) o -> MSF (ReaderT e m) i o
 134 | toReader = morphGS (\f,vi => MkReaderT $ \ve => f [ve,vi])
 135 | 
 136 | ||| Like `toReader` but for MSFs without additional input
 137 | export
 138 | toReader_ : Monad m => MSF m e o -> MSF (ReaderT e m) () o
 139 | toReader_ = morphGS (\f,_ => MkReaderT f)
 140 | 
 141 | --------------------------------------------------------------------------------
 142 | --          Writer
 143 | --------------------------------------------------------------------------------
 144 | 
 145 | 
 146 | ||| Alias for `arrM tell`
 147 | export
 148 | tell : MonadWriter w m => MSF m w ()
 149 | tell = arrM tell
 150 | 
 151 | ||| Converts an outer `WriterT` wrapper to an MSF producing
 152 | ||| an additional output.
 153 | export
 154 | fromWriter : Monoid w => Monad m => MSF (WriterT w m) i o -> MSF m i (HList [w,o])
 155 | fromWriter =
 156 |   morphGS (\f,vi => (\((vo,vc),vw) => ([vw,vo],vc)) <$> runWriterT (f vi))
 157 | 
 158 | ||| Like `fromWriter` but ignores the uninteresting output.
 159 | export
 160 | fromWriter_ : Monoid w => Monad m => MSF (WriterT w m) i () -> MSF m i w
 161 | fromWriter_ =
 162 |   morphGS (\f,vi => (\((_,vc),vw) => (vw,vc)) <$> runWriterT (f vi))
 163 | 
 164 | ||| Converts an MSF producing an additional output
 165 | ||| to one with its monadic context wrapped in `WriterT w`.
 166 | export
 167 | toWriter : Monoid w => Monad m => MSF m i (HList [w,o]) -> MSF (WriterT w m) i o
 168 | toWriter =
 169 |   morphGS (\f,vi =>
 170 |     MkWriterT $ \vw => (\([vw2,vo],vc) => ((vo,vc),vw <+> vw2)) <$> f vi)
 171 | 
 172 | ||| Like `toWriter` but produces unit as output.
 173 | export
 174 | toWriter_ : Monoid w => Monad m => MSF m i w -> MSF (WriterT w m) i ()
 175 | toWriter_ =
 176 |   morphGS (\f,vi =>
 177 |     MkWriterT $ \vw => (\(vw2,vc) => (((),vc),vw <+> vw2)) <$> f vi)
 178 |