Clever Geek Handbook

Tentando compor o não composível: mônadas

Quantas vezes você já ouviu esse mantra "as mônadas não compõem"? Passei muito tempo tentando refutar essa afirmação, tentando resolver o problema de frente. Mas como muitas coisas na matemática, às vezes, para tentar entender algo, às vezes vale a pena mudar a escala.





Recomenda-se ler a primeira e a segunda parte desta série, caso ainda não tenha feito isso.





Quando queremos mesclar dois efeitos em um, ou seja, concatená-los em um transformador, temos duas opções: aninhar a esquerda na direita ou a direita na esquerda. Essas duas opções são definidas com gráficos TU e UT :





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

Como já sabemos das partes anteriores desta série, para cálculos com um ambiente imutável ( Reader ), a composição direta de functores é suficiente, e para efeitos de tratamento de erros ( Maybe e Either ), um esquema com composição inversa de UT é adequado .





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

Instâncias do covariante regular e do functor aplicativo parecem triviais, uma vez que ainda é um functor e os functores são compostos:





(<$$>) :: (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

Os problemas surgem quando tentamos descrever as mônadas. Não está claro como encontrar uma forma generalizada, visto que ambos os efeitos nos são desconhecidos:





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.





, - , .





Fontes com definições podem ser encontradas  aqui . Exemplos de como usar o sistema de efeitos descrito podem ser encontrados aqui .







More articles:


All Articles