haskell - huella - Combinando tipos libres

dehache festival

Question

Recientemente me he estado enseñando sobre la mónada free paquete free , pero me he encontrado con un problema. Me gustaría tener diferentes mónadas gratuitas para diferentes bibliotecas, básicamente me gustaría crear DSL para diferentes contextos, pero también me gustaría poder combinarlas. Como ejemplo:

{-# LANGUAGE DeriveFunctor #-}
module TestingFree where

import Control.Monad.Free

data BellsF x
    = Ring x
    | Chime x
    deriving (Functor, Show)

type Bells = Free BellsF

data WhistlesF x
    = PeaWhistle x
    | SteamWhistle x
    deriving (Functor, Show)

type Whistles = Free WhistlesF

ring :: Bells ()
ring = liftF $ Ring ()

chime :: Bells ()
chime = liftF $ Chime ()

peaWhistle :: Whistles ()
peaWhistle = liftF $ PeaWhistle ()

steamWhistle :: Whistles ()
steamWhistle = liftF $ SteamWhistle ()


playBells :: Bells r -> IO r
playBells (Pure r)         = return r
playBells (Free (Ring x))  = putStrLn "RingRing!" >> playBells x
playBells (Free (Chime x)) = putStr "Ding-dong!" >> playBells x

playWhistles :: Whistles () -> IO ()
playWhistles (Pure _)                = return ()
playWhistles (Free (PeaWhistle x))   = putStrLn "Preeeet!" >> playWhistles x
playWhistles (Free (SteamWhistle x)) = putStrLn "Choo-choo!" >> playWhistles x

Ahora, me gustaría poder crear un tipo BellsAndWhistles que me permita combinar la funcionalidad de Bells y Whistles sin mucho esfuerzo.

Como el problema es la combinación de mónadas, lo primero que pensé fue mirar el módulo Control.Monad.Trans.Free para obtener una solución rápida y fácil. Desafortunadamente, hay pocos ejemplos y ninguno muestra lo que quiero hacer. Además, parece que apilar dos o más mónadas libres no funciona, ya que MonadFree tiene una dependencia funcional de m -> f . Esencialmente, me gustaría la capacidad de escribir código como:

newtype BellsAndWhistles m a = BellsAndWhistles
    { unBellsAndWhistles :: ???
    } deriving
        ( Functor
        , Monad
        -- Whatever else needed
        )

noisy :: Monad m => BellsAndWhistles m ()
noisy = do
    lift ring
    lift peaWhistle
    lift chime
    lift steamWhistle

play :: BellsAndWhistles IO () -> IO ()
play bellsNwhistles = undefined

Pero de tal manera que Bells y Whistles pueden existir en módulos separados y no tienen que conocer las implementaciones de los demás. La idea es que puedo escribir módulos independientes para diferentes tareas, cada uno implementando su propio DSL, y luego tener una forma de combinarlos en un DSL "más grande" según sea necesario. ¿Hay una forma fácil de hacer esto?

Como beneficio adicional, sería genial poder aprovechar las diferentes funciones de play* que ya están escritas, de tal manera que puedo intercambiarlas. Quiero poder usar un intérprete gratuito para la depuración y otro en la producción, y obviamente sería útil poder elegir qué DSL se estaba depurando individualmente.

Answer 1

Esta es una respuesta basada en el papel Tipos de datos a la carta , excepto sin clases de tipo. Recomiendo leer ese papel.

El truco es que en lugar de escribir intérpretes para Bells y Whistles , defina intérpretes para sus pasos de funtor único, BellsF y WhistlesF , como esto:

playBellsF :: BellsF (IO a) -> IO a
playBellsF (Ring  io) = putStrLn "RingRing!"  >> io
playBellsF (Chime io) = putStr   "Ding-dong!" >> io

playWhistlesF :: WhistelsF (IO a) -> IO a
playWhistlesF (PeaWhistle   io) = putStrLn "Preeeet!"   >> io
playWhistlesF (SteamWhistle io) = putStrLn "choo-choo!" >> io

Si elige no combinarlos, puede pasarlos a Control.Monad.Free.iterM para recuperar sus funciones de reproducción originales:

playBells    :: Bells a    -> IO a
playBells    = iterM playBell

playWhistles :: Whistles a -> IO a
playWhistles = iterM playWhistlesF

... sin embargo, debido a que tratan con pasos individuales, se pueden combinar más fácilmente. Puedes definir una nueva mónada libre combinada como esta:

data BellsAndWhistlesF a = L (BellsF a) | R (WhistlesF a)

Luego convierte eso en una mónada libre:

type BellsAndWhistles = Free BellsAndWhistlesF

Luego, escribe un intérprete para un solo paso de BellsAndWhistlesF en términos de los dos sub-intérpretes:

playBellsAndWhistlesF :: BellsAndWhistlesF (IO a) -> IO a
playBellsAndWhistlesF (L bs) = playBellsF    bs
playBellsAndWhistlesF (R ws) = playWhistlesF ws

... y luego obtienes el intérprete de la mónada gratuita simplemente pasándolo a iterM :

playBellsAndWhistles :: BellsAndWhistles a -> IO a
playBellsAndWhistles = iterM playBellsAndWhistlesF

Entonces, la respuesta a su pregunta es que el truco para combinar mónadas libres es preservar más información mediante la definición de intérpretes intermedios para los pasos del funtor individual ("álgebras"). Estos "álgebras" son mucho más susceptibles de combinarse que los intérpretes para las mónadas gratuitas.

Answer 2

La respuesta de Gabriel es acertada, pero creo que vale la pena resaltar un poco más lo que hace que todo funcione, y es que la suma de dos Functor s también es un Functor :

-- | Data type to encode the sum of two ''Functor''s @f@ and @g@.
data Sum f g a = InL (f a) | InR (g a)

-- | The ''Sum'' of two ''Functor''s is also a ''Functor''.
instance (Functor f, Functor g) => Functor (Sum f g) where
    fmap f (InL fa) = InL (fmap f fa)
    fmap f (InR ga) = InR (fmap f ga)

-- | Elimination rule for the ''Sum'' type.
elimSum :: (f a -> r) -> (g a -> r) -> Sum f g a -> r
elimSum f _ (InL fa) = f fa
elimSum _ g (InR ga) = g ga

(Las bibliotecas de Edward Kmett tienen esto como Data.Functor.Coproduct .)

Así que si los Functor s son los "conjuntos de instrucciones" para las mónadas Free , entonces:

1. Los funtores de suma le dan las uniones de tales conjuntos de instrucciones, y por lo tanto las mónadas libres combinadas correspondientes
2. La función elimSum es la regla básica que le permite crear un intérprete de Sum fg partir de un intérprete para f y uno para g .

Las técnicas de "Tipos de datos a la carta " son exactamente lo que obtienes cuando desarrollas esta visión: vale la pena dedicarte a trabajar a mano.

Este tipo de álgebra funcional es una cosa valiosa para aprender. Por ejemplo:

data Product f g a = Product (f a) (g a)

-- | The ''Product'' of two ''Functor''s is also a ''Functor''.
instance (Functor f, Functor g) => Functor (Product f g) where
   fmap f (Product fa ga) = Product (fmap f fa) (fmap f ga)

-- | The ''Product'' of two ''Applicative''s is also an ''Applicative''.
instance (Applicative f, Applicative g) => Applicative (Product f g) where
   pure x = Product (pure x) (pure x)
   Product ff gf <*> Product fa ga = Product (ff <*> fa) (gf <*> ga)


-- | ''Compose'' is to ''Applicative'' what monad transformers are to ''Monad''.
-- If your problem domain doesn''t need the full power of the ''Monad'' class, 
-- then applicative composition might be a good alternative on how to combine
-- effects.
data Compose f g a = Compose (f (g a))

-- | The composition of two ''Functor''s is also a ''Functor''.
instance (Functor f, Functor g) => Functor (Compose f g) where
   fmap f (Compose fga) = Compose (fmap (fmap f) fga)

-- | The composition of two ''Applicative''s is also an ''Applicative''.
instance (Applicative f, Applicative g) => Applicative (Compose f g) where
   pure = Compose . pure . pure
   Compose fgf <*> Compose fga = Compose ((<*>) <$> fgf <*> fga)

La entrada del blog de Gershom Bazerman "Abstactar con el Applicative s" amplía estos puntos sobre el Applicative y merece la pena leerlo.

EDITAR: Una última cosa que señalaré es que cuando las personas diseñan sus Functor personalizadas para sus mónadas gratuitas, de hecho, implícitamente están usando precisamente estas técnicas. Tomaré dos ejemplos de "Por qué importan las mónadas libres" de Gabriel:

data Toy b next =
    Output b next
  | Bell next
  | Done

data Interaction next =
    Look Direction (Image -> next)
  | Fire Direction next
  | ReadLine (String -> next)
  | WriteLine String (Bool -> next)

Todos estos se pueden analizar en una combinación de los funtores Product , Sum , Compose , (->) y los tres siguientes:

-- | Provided by "Control.Applicative"
newtype Const b a = Const b

instance Functor (Const b) where
    fmap _ (Const b) = Const b


-- | Provided by "Data.Functor.Identity"
newtype Identity a = Identity a

instance Functor Identity where
    fmap f (Identity a) = Identity (f a)


-- | Near-isomorphic to @Const ()@
data VoidF a = VoidF

instance Functor VoidF where
    fmap _ VoidF = VoidF

Entonces, usando los siguientes sinónimos de tipo para brevedad:

{-# LANGUAGE TypeOperators #-}

type f :+: g = Sum f g
type f :*: g = Product f g
type f :.: g = Compose f g

infixr 6 :+:
infixr 7 :*:
infixr 9 :.:

... podemos reescribir esos funtores como este:

type Toy b = Const b :*: Identity :+: Identity :+: VoidF

type Interaction = Const Direction :*: ((->) Image :.: Identity)
               :+: Const Direction :*: Identity
               :+: (->) String :.: Identity
               :+: Const String :*: ((->) Bool :.: Identity)