Trying to compose the non-composable: monads

How many times have you heard this mantra "monads don't compose"? I spent a lot of time to try to refute this statement, trying to solve the problem head-on. But like many things in mathematics, sometimes, in order to try to understand something, sometimes it is worth changing the scale.





It is recommended to read the first and second part of this series, if you have not done so.





When we want to merge two effects into one, that is, concatenate them into a transformer, we have two options: nest the left into the right, or the right into the left. These two options are defined with TU and UT charts :





newtype TU t u a = TU (t :. u := a)
newtype UT t u a = UT (u :. t := a)
      
      



As we already know from the previous parts of this series, for computations with an immutable environment ( Reader ), direct composition of functors is sufficient, and for error handling effects ( Maybe and Either ), a scheme with inverse composition of UT is suitable .





type instance Schema (Reader e) = TU ((->) e)
type instance Schema (Either e) = UT (Either e)
type instance Schema Maybe = UT Maybe
      
      



Instances of the regular covariant and applicative functor look trivial, since it is still a functor, and functors are composited:





(<$$>) :: (Functor t, Functor u) => (a -> b) -> t :. u := a -> t :. u := b
(<$$>) = (<$>) . (<$>)

(<**>) :: (Applicative t, Applicative u) => t :. u := (a -> b) -> t :. u := a -> t :. u := b
f <**> x = (<*>) <$> f <*> x

instance (Functor t, Functor u) => Functor (TU t u) where
    fmap f (TU x) = TU $ f <$$> x

instance (Applicative t, Applicative u) => Applicative (TU t u) where
    pure = TU . pure . pure
    TU f <*> TU x = TU $ f <**> x

instance (Functor t, Functor u) => Functor (UT t u) where
    fmap f (UT x) = UT $ f <$$> x

instance (Applicative t, Applicative u) => Applicative (UT t u) where
    pure = UT . pure . pure
    UT f <*> UT x = UT $ f <**> x
      
      



Problems arise when we try to describe monads. It is not clear how to find a generalized way, given that both effects are unknown to us:





instance (Monad t, Monad u) => Monad (TU t u) where
  x >>= f = ???

instance (Monad t, Monad u) => Monad (UT t u) where
  x >>= f = ???
      
      



, . :





instance Monad u => Monad (TU ((->) e) u) where
    TU x >>= f = TU $ \e -> x e >>= ($ e) . run . f

instance Monad u => Monad (UT (Either e) u) where
    UT x >>= f = UT $ x >>= \case
        Left e -> pure $ Left e
        Right r -> run $ f r

instance Monad u => Monad (UT Maybe u) where
    UT x >>= f = UT $ x >>= \case
        Nothing -> pure Nothing
        Just r -> run $ f r
      
      



(Maybe Either), : a, . Traversable! :





class (Functor t, Foldable t) => Traversable t where
    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)

instance Traversable Maybe where
    traverse _ Nothing = pure Nothing
    traverse f (Just x) = Just <$> f x

instance Traversable (Either a) where
    traverse _ (Left x) = pure (Left x)
    traverse f (Right y) = Right <$> f y
      
      



:





instance (Traversable t, Monad t, Monad u) => Monad (UT t u) where
    UT x >>= f = UT $ x >>= \i -> join <$> traverse (run . f) i
      
      



! , Traversable .





TU, - Reader? . - - Traversable - Distributive. , Reader (, - (->) e)!





class Functor g => Distributive g where
    collect :: Functor f => (a -> g b) -> f a -> g (f b)

instance Distributive ((->) e) where
    collect f q e = flip f e <$> q
      
      



? , a -> t b , - id:





sequence :: (Traversable t, Applicative u) => t (u a) -> u (t a)
sequence = traverse id

distribute :: (Distributive t, Functor u) => u (t a) -> t (u a)
distribute = collect id
      
      



! , . Traversable , Distributive ?





instance (Monad t, Distributive t, Monad u) => Monad (TU t u) where
    TU x >>= f = TU $ x >>= \i -> join <$> collect (run . f) i
      
      



! , :





  • UT - Traversable.





  • TU - Distributive.









, State Store:





newtype TUT t t' u a = TUT (t :. u :. t' := a)

newtype State s a = State ((->) s :. (,) s := a)
newtype Store s a = Store ((,) s :. (->) s := a)

type instance Schema (State s) = TUT ((->) s) ((,) s)
type instance Schema (Store s) = TUT ((,) s) ((->) s)
      
      



, . , - , . , , , .





instance (Functor t, Functor t', Functor u) => Functor (TUT t t' u) where
    fmap f (TUT x) = TUT $ f <$$$> x
      
      



, ( (->) s) Distributive, ((,) s) - Traversable... , ( ):





class Functor t => Adjunction t u where
    leftAdjunct  :: (t a -> b) -> a -> u b
    rightAdjunct :: (a -> u b) -> t a -> b
    unit :: a -> u :. t := a
    unit = leftAdjunct id
    counit :: t :. u := a -> a
    counit = rightAdjunct id

instance Adjunction ((,) s) ((->) s) where
    leftAdjunct :: ((s, a) -> b) -> a -> (s -> b) 
    leftAdjunct f a s = f (s, a)
    rightAdjunct :: (a -> s -> b) -> (s, a) -> b
    rightAdjunct f (s, a) = f a s
    unit :: a -> s -> (s, a)
    unit x = \s -> (s, x)
    counit :: (s, (s -> a)) -> a
    counit (s, f) = f s
      
      



. State unit, , :





instance Monad (State s) where
    State x >>= f = State $ rightAdjunct (run . f) <$> x
    --  : State x >>= f = State $ counit <$> ((run . f) <$$> x)
    return = State . unit
      
      



? ((->) s) ((,) s) , . , - :





instance (Adjunction t' t, Monad u) => Monad (TUT t t' u) where
    x >>= f = TUT $ (>>= rightAdjunct (run . f)) <$> run x
    return = TUT . (leftAdjunct pure)
      
      



, , :





instance (Adjunction t' t, Comonad u) => Comonad (TUT t' t := u) where
    extend f x = TUT $ (=>> leftAdjunct (f . TUT)) <$> run x
    extract = rightAdjunct extract . run
      
      



, , ? ! , ...





instance (Adjunction t' t, Distributive t) => MonadTrans (TUT t t') where
    lift = TUT . collect (leftAdjunct id)

instance (Adjunction t' t, Applicative t, forall u . Traversable u) => ComonadTrans (TUT t' t) where
    lower = rightAdjunct (traverse id) . run
      
      



, :





  • Traversable - UT.





  • Distributive - TU.





  • (Adjunction) - TUT.





, - , .





Sources with definitions can be found  here . Examples of using the described system of effects can be found here .








All Articles