haskell - Combinando múltiples estados en StateT

tree haskell

Question

Estoy escribiendo un programa que se ejecuta como un demonio. Para crear el demonio, el usuario proporciona un conjunto de implementaciones para cada una de las clases requeridas (una de ellas es una base de datos). Todas estas clases tienen funciones con firmas de tipo con el formato StateT s IO a , pero s es diferente para cada clase .

Supongamos que cada una de las clases sigue este patrón:

import Control.Monad (liftM)
import Control.Monad.State (StateT(..), get)

class Hammer h where
  driveNail :: StateT h IO ()

data ClawHammer = MkClawHammer Int -- the real implementation is more complex

instance Hammer ClawHammer where
  driveNail = return () -- the real implementation is more complex

-- Plus additional classes for wrenches, screwdrivers, etc.

Ahora puedo definir un registro que representa la implementación elegida por el usuario para cada "ranura".

data MultiTool h = MultiTool {
    hammer :: h
    -- Plus additional fields for wrenches, screwdrivers, etc.
  }

Y el daemon realiza la mayor parte de su trabajo en la mónada StateT (MultiTool h ...) IO () .

Ahora, dado que la multiherramienta contiene un martillo, puedo usarlo en cualquier situación donde se necesite un martillo. En otras palabras, el tipo MultiTool puede implementar cualquiera de las clases que contiene, si escribo un código como este:

stateMap :: Monad m => (s -> t) -> (t -> s) -> StateT s m a -> StateT t m a
stateMap f g (StateT h) = StateT $ liftM (fmap f) . h . g

withHammer :: StateT h IO () -> StateT (MultiTool h) IO ()
withHammer runProgram = do
  t <- get
  stateMap (/h -> t {hammer=h}) hammer runProgram

instance Hammer h => Hammer (MultiTool h) where
  driveNail = withHammer driveNail

Pero las implementaciones de withHammer , withWrench , withScrewdriver , etc. son básicamente idénticas. Sería bueno poder escribir algo como esto ...

--withMember accessor runProgram = do
--  u <- get
--  stateMap (/h -> u {accessor=h}) accessor runProgram

-- instance Hammer h => Hammer (MultiTool h) where
--   driveNail = withMember hammer driveNail

Pero claro que eso no compilará.

Sospecho que mi solución está demasiado orientada a objetos. ¿Hay alguna manera mejor? Transformadores de mónada, tal vez? Gracias de antemano por cualquier sugerencia.

Answer 1

Aquí hay un ejemplo concreto de cómo usar lens como todos los demás están hablando. En el siguiente ejemplo de código, Type1 es el estado local (es decir, su martillo), y Type2 es el estado global (es decir, su multiherramienta). lens proporciona la función de zoom que le permite ejecutar un cálculo de estado localizado que zoom cualquier campo definido por una lente:

import Control.Lens
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State

data Type1 = Type1 {
    _field1 :: Int   ,
    _field2 :: Double}

field1 :: SimpleLens Type1 Int
field1 = lens _field1 (/x a -> x { _field1 = a})

field2 :: SimpleLens Type1 Double
field2 = lens _field2 (/x a -> x { _field2 = a})

data Type2 = Type2 {
    _type1  :: Type1 ,
    _field3 :: String}

type1 :: SimpleLens Type2 Type1
type1 = lens _type1 (/x a -> x { _type1 = a})

field3 :: SimpleLens Type2 String
field3 = lens _field3 (/x a -> x { _field3 = a})

localCode :: StateT Type1 IO ()
localCode = do
    field1 += 3
    field2 .= 5.0
    lift $ putStrLn "Done!"

globalCode :: StateT Type2 IO ()
globalCode = do
    f1 <- zoom type1 $ do
        localCode
        use field1
    field3 %= (++ show f1)
    f3 <- use field3
    lift $ putStrLn f3

main = runStateT globalCode (Type2 (Type1 9 4.0) "Hello: ")

zoom no se limita a los subcampos inmediatos de un tipo. Dado que las lentes son compactables, puede hacer el zoom a la profundidad que desee en una sola operación simplemente haciendo algo como:

zoom (field1a . field2c . field3b . field4j) $ do ...

Answer 2

Creé una biblioteca de registros extensible con lentes llamada data-diverse-lens que permite combinar múltiples ReaderT (o StateT) como esta gist :

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}

module Main where

import Control.Lens
import Control.Monad.Reader
import Control.Monad.State
import Data.Diverse.Lens
import Data.Semigroup

foo :: (MonadReader r m, HasItem'' Int r, HasItem'' String r) => m (Int, String)
foo = do
    i <- view (item'' @Int) -- explicitly specify type
    s <- view item'' -- type can also be inferred
    pure (i + 10, s <> "bar")

bar :: (MonadState s m, HasItem'' Int s, HasItem'' String s) => m ()
bar = do
    (item'' @Int) %= (+10) -- explicitly specify type
    item'' %= (<> "bar") -- type can also be inferred
    pure ()

main :: IO ()
main = do
    -- example of running ReaderT with multiple items
    (i, s) <- runReaderT foo ((2 :: Int) ./ "foo" ./ nil)
    putStrLn $ show i <> s -- prints out "12foobar"
    -- example of running StateT with multiple items
    is <- execStateT bar ((2 :: Int) ./ "foo" ./ nil)
    putStrLn $ show (view (item @Int) is) <> (view (item @String) is) -- prints out "12foobar"

Data.Has es una biblioteca más simple que hace lo mismo con tuplas. Ejemplo de la portada de la biblioteca:

 {-# LANGUAGE FlexibleContexts #-}

 -- in some library code
 ...
 logInAnyReaderHasLogger :: (Has Logger r, MonadReader r m) => LogString -> m ()
 logInAnyReaderHasLogger s = asks getter >>= logWithLogger s

 queryInAnyReaderHasSQL :: (Has SqlBackEnd r, MonadReader r m) => Query -> m a
 queryInAnyReaderHasSQL q = asks getter >>= queryWithSQL q
 ...

 -- now you want to use these effects together
 ...
 logger <- initLogger  ...
 sql <- initSqlBackEnd ...

 (`runReader` (logger, sql)) $ do
       ...
       logInAnyReaderHasLogger ...
       ...
       x <- queryInAnyReaderHasSQL ...
       ...  

Answer 3

Esto suena muy parecido a una aplicación de lentes.

Las lentes son una especificación de un subcampo de algunos datos. La idea es que tengas algún valor en la view y set toolLens y las herramientas, de modo que la view toolLens :: MultiTool h -> h recupera la herramienta y set toolLens :: MultiTool h -> h -> MultiTool h la herramienta set toolLens :: MultiTool h -> h -> MultiTool h reemplaza con un nuevo valor. Luego, puede definir fácilmente su withMember como una función que solo acepta una lente.

La tecnología de lentes ha avanzado mucho recientemente, y ahora son increíblemente capaces. La biblioteca más poderosa que existe en el momento de escribir es la biblioteca de lens Edward Kmett, que es mucho más que tragar, pero bastante simple una vez que encuentre las funciones que desea. También puede buscar más preguntas sobre lentes aquí en SO, por ejemplo, lentes funcionales que se vinculan con lentes, etiquetas, accesores de datos, qué biblioteca para el acceso de la estructura y la mutación es mejor , o la etiqueta de lenses .

Answer 4

Si desea ir con un gran estado global como en su caso, entonces lo que quiere usar es lentes, como lo sugiere Ben. Yo también recomiendo la biblioteca de lentes de Edward Kmett. Sin embargo, hay otra forma, quizás mejor.

Los servidores tienen la propiedad de que el programa se ejecuta continuamente y realiza la misma operación en un espacio de estado. El problema comienza cuando desea modularizar su servidor, en cuyo caso desea algo más que un estado global. Quieres que los módulos tengan su propio estado.

Pensemos en un módulo como algo que transforma una solicitud de respuesta :

Module :: (Request -> m Response) -> Module m

Ahora, si tiene algún estado, entonces este estado se vuelve notable en que el módulo podría dar una respuesta diferente la próxima vez. Hay varias formas de hacerlo, por ejemplo, las siguientes:

Module :: s -> ((Request, s) -> m (Response s)) -> Module m

Pero una forma mucho más agradable y equivalente de expresar esto es el siguiente constructor (pronto construiremos un tipo a su alrededor):

Module :: (Request -> m (Response, Module m)) -> Module m

Este módulo asigna una solicitud a una respuesta, pero en el camino también devuelve una nueva versión de sí mismo. Vayamos más lejos y hagamos peticiones y respuestas polimórficas:

Module :: (a -> m (b, Module m a b)) -> Module m a b

Ahora, si el tipo de salida de un módulo coincide con el tipo de entrada de otro módulo, entonces puede componerlos como funciones normales. Esta composición es asociativa y tiene una identidad polimórfica. Esto suena mucho como una categoría, y de hecho lo es! Es una categoría, un funtor aplicativo y una flecha.

newtype Module m a b =
    Module (a -> m (b, Module m a b))

instance (Monad m) => Applicative (Module m a)
instance (Monad m) => Arrow (Module m)
instance (Monad m) => Category (Module m)
instance (Monad m) => Functor (Module m a)

¡Ahora podemos componer dos módulos que tienen su propio estado local sin siquiera saberlo! Pero eso no es suficiente. Queremos más. ¿Qué hay de los módulos que se pueden cambiar entre? Extendamos nuestro pequeño sistema de módulos de modo que los módulos realmente puedan elegir no dar una respuesta:

newtype Module m a b =
    Module (a -> m (Maybe b, Module m a b))

Esto permite otra forma de composición que es ortogonal a (.) : Ahora nuestro tipo también es una familia de funtores Alternative :

instance (Monad m) => Alternative (Module m a)

Ahora, un módulo puede elegir si responder a una solicitud, y si no, se intentará con el siguiente módulo. Sencillo. Acabas de reinventar la categoría de cables. =)

Por supuesto que no necesitas reinventar esto. La biblioteca Netwire implementa este patrón de diseño y viene con una gran biblioteca de "módulos" predefinidos (llamados cables). Vea el módulo Control.Wire para un tutorial.