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)