haskell - preestablecida - monadas filosofía

Transformador de mónada para el seguimiento del progreso.

Question

Estoy buscando un transformador de mónada que pueda usarse para seguir el progreso de un procedimiento. Para explicar cómo se usaría, considere el siguiente código:

procedure :: ProgressT IO ()
procedure = task "Print some lines" 3 $ do
liftIO $ putStrLn "line1"
step
task "Print a complicated line" 2 $ do
liftIO $ putStr "li"
step
liftIO $ putStrLn "ne2"
step
liftIO $ putStrLn "line3"
-- Wraps an action in a task
task :: Monad m
=> String -- Name of task
-> Int -- Number of steps to complete task
-> ProgressT m a -- Action performing the task
-> ProgressT m a
-- Marks one step of the current task as completed
step :: Monad m => ProgressT m ()

Me doy cuenta de que ese step tiene que existir explícitamente debido a las leyes monádicas, y que la task debe tener un parámetro de número de paso explícito debido al determinismo del programa / el problema de la detención.

La mónada como se describió anteriormente podría, según lo veo, implementarse de una de estas dos maneras:

1. A través de una función que devolvería el nombre de la tarea actual / pila de índice de pasos, y una continuación en el procedimiento en el punto en que se detuvo. La activación repetida de esta función en la continuación devuelta completaría la ejecución del procedimiento.
2. A través de una función que realizó una acción que describe qué hacer cuando se ha completado un paso de tarea. El procedimiento se ejecutaría de forma incontrolable hasta que se completara, "notificando" al entorno sobre los cambios a través de la acción provista.

Para la solución (1), he mirado Control.Monad.Coroutine con el functor de suspensión de Yield . Para la solución (2), no conozco ningún transformador de mónada ya disponible que pueda ser útil.

La solución que estoy buscando no debería tener demasiada sobrecarga de rendimiento y permitir tanto control sobre el procedimiento como sea posible (por ejemplo, no requiere acceso a IO o algo así).

¿Parece viable alguna de estas soluciones, o ya existen otras soluciones para este problema? ¿Ya se ha resuelto este problema con un transformador de mónada que no he podido encontrar?

EDITAR: El objetivo no es comprobar si se han realizado todos los pasos. El objetivo es poder "monitorear" el proceso mientras se está ejecutando, para que uno pueda saber cuánto se ha completado.

Answer 1

Esta es mi solución pesimista a este problema. Utiliza Coroutine s para suspender el cálculo en cada paso, lo que le permite al usuario realizar un cálculo arbitrario para informar algún progreso.

EDITAR: La implementación completa de esta solución se puede encontrar here .

¿Se puede mejorar esta solución?

Primero, cómo se usa:

-- The procedure that we want to run.
procedure :: ProgressT IO ()
procedure = task "Print some lines" 3 $ do
liftIO $ putStrLn "--> line 1"
step
task "Print a set of lines" 2 $ do
liftIO $ putStrLn "--> line 2.1"
step
liftIO $ putStrLn "--> line 2.2"
step
liftIO $ putStrLn "--> line 3"
main :: IO ()
main = runConsole procedure
-- A "progress reporter" that simply prints the task stack on each step
-- Note that the monad used for reporting, and the monad used in the procedure,
-- can be different.
runConsole :: ProgressT IO a -> IO a
runConsole proc = do
result <- runProgress proc
case result of
-- We stopped at a step:
Left (cont, stack) -> do
print stack -- Print the stack
runConsole cont -- Continue the procedure
-- We are done with the computation:
Right a -> return a

Los resultados del programa anterior:

--> line 1
[Print some lines (1/3)]
--> line 2.1
[Print a set of lines (1/2),Print some lines (1/3)]
--> line 2.2
[Print a set of lines (2/2),Print some lines (1/3)]
[Print some lines (2/3)]
--> line 3
[Print some lines (3/3)]

La implementación real (ver here para una versión comentada):

type Progress l = ProgressT l Identity
runProgress :: Progress l a
-> Either (Progress l a, TaskStack l) a
runProgress = runIdentity . runProgressT
newtype ProgressT l m a =
ProgressT
{
procedure ::
Coroutine
(Yield (TaskStack l))
(StateT (TaskStack l) m) a
}
instance MonadTrans (ProgressT l) where
lift = ProgressT . lift . lift
instance Monad m => Monad (ProgressT l m) where
return = ProgressT . return
p >>= f = ProgressT (procedure p >>= procedure . f)
instance MonadIO m => MonadIO (ProgressT l m) where
liftIO = lift . liftIO
runProgressT :: Monad m
=> ProgressT l m a
-> m (Either (ProgressT l m a, TaskStack l) a)
runProgressT action = do
result <- evalStateT (resume . procedure $ action) []
return $ case result of
Left (Yield stack cont) -> Left (ProgressT cont, stack)
Right a -> Right a
type TaskStack l = [Task l]
data Task l =
Task
{ taskLabel :: l
, taskTotalSteps :: Word
, taskStep :: Word
} deriving (Show, Eq)
task :: Monad m
=> l
-> Word
-> ProgressT l m a
-> ProgressT l m a
task label steps action = ProgressT $ do
-- Add the task to the task stack
lift . modify $ pushTask newTask
-- Perform the procedure for the task
result <- procedure action
-- Insert an implicit step at the end of the task
procedure step
-- The task is completed, and is removed
lift . modify $ popTask
return result
where
newTask = Task label steps 0
pushTask = (:)
popTask = tail
step :: Monad m => ProgressT l m ()
step = ProgressT $ do
(current : tasks) <- lift get
let currentStep = taskStep current
nextStep = currentStep + 1
updatedTask = current { taskStep = nextStep }
updatedTasks = updatedTask : tasks
when (currentStep > taskTotalSteps current) $
fail "The task has already completed"
yield updatedTasks
lift . put $ updatedTasks

Answer 2

La forma más obvia de hacer esto es con StateT .

import Control.Monad.State
type ProgressT m a = StateT Int m a
step :: Monad m => ProgressT m ()
step = modify (subtract 1)

No estoy seguro de lo que quieres que sea la semántica de la task , sin embargo ...

Editar para mostrar cómo harías esto con IO

step :: (Monad m, MonadIO m) => ProgressT m ()
step = do
modify (subtract 1)
s <- get
liftIO $ putStrLn $ "steps remaining: " ++ show s

Tenga en cuenta que necesitará la restricción MonadIO para imprimir el estado. Puede tener un tipo diferente de restricción si necesita un efecto diferente con el estado (es decir, lanzar una excepción si el número de pasos es inferior a cero, o lo que sea).

Answer 3

No estoy seguro de si esto es exactamente lo que desea, pero aquí hay una implementación que impone la cantidad correcta de pasos y requiere que haya cero pasos al final. Para simplificar, estoy usando una mónada en lugar de un transformador de mónada sobre IO. Tenga en cuenta que no estoy usando la mónada de Prelude para hacer lo que estoy haciendo.

ACTUALIZACIÓN :

Ahora puede extraer el número de pasos restantes. Ejecuta lo siguiente con -XRebindableSyntax

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
module Test where
import Prelude hiding (Monad(..))
import qualified Prelude as Old (Monad(..))
-----------------------------------------------------------
data Z = Z
data S n = S
type Zero = Z
type One = S Zero
type Two = S One
type Three = S Two
type Four = S Three
-----------------------------------------------------------
class Peano n where
peano :: n
fromPeano :: n -> Integer
instance Peano Z where
peano = Z
fromPeano Z = 0
instance Peano (S Z) where
peano = S
fromPeano S = 1
instance Peano (S n) => Peano (S (S n)) where
peano = S
fromPeano s = n `seq` (n + 1)
where
prev :: S (S n) -> (S n)
prev S = S
n = fromPeano $ prev s
-----------------------------------------------------------
class (Peano s, Peano p) => Succ s p | s -> p where
instance Succ (S Z) Z where
instance Succ (S n) n => Succ (S (S n)) (S n) where
-----------------------------------------------------------
infixl 1 >>=, >>
class ParameterisedMonad m where
return :: a -> m s s a
(>>=) :: m s1 s2 t -> (t -> m s2 s3 a) -> m s1 s3 a
fail :: String -> m s1 s2 a
fail = error
(>>) :: ParameterisedMonad m => m s1 s2 t -> m s2 s3 a -> m s1 s3 a
x >> f = x >>= /_ -> f
-----------------------------------------------------------
newtype PIO p q a = PIO { runPIO :: IO a }
instance ParameterisedMonad PIO where
return = PIO . Old.return
PIO io >>= f = PIO $ (Old.>>=) io $ runPIO . f
-----------------------------------------------------------
data Progress p n a = Progress a
instance ParameterisedMonad Progress where
return = Progress
Progress x >>= f = let Progress y = f x in Progress y
runProgress :: Peano n => n -> Progress n Zero a -> a
runProgress _ (Progress x) = x
runProgress'' :: Progress p Zero a -> a
runProgress'' (Progress x) = x
task :: Peano n => n -> Progress n n ()
task _ = return ()
task'' :: Peano n => Progress n n ()
task'' = task peano
step :: Succ s n => Progress s n ()
step = Progress ()
stepsLeft :: Peano s2 => Progress s1 s2 a -> (a -> Integer -> Progress s2 s3 b) -> Progress s1 s3 b
stepsLeft prog f = prog >>= flip f (fromPeano $ getPeano prog)
where
getPeano :: Peano n => Progress s n a -> n
getPeano prog = peano
procedure1 :: Progress Three Zero String
procedure1 = do
task''
step
task (peano :: Two) -- any other Peano is a type error
--step -- uncommenting this is a type error
step -- commenting this is a type error
step
return "hello"
procedure2 :: (Succ two one, Succ one zero) => Progress two zero Integer
procedure2 = do
task''
step `stepsLeft` /_ n -> do
step
return n
main :: IO ()
main = runPIO $ do
PIO $ putStrLn $ runProgress'' procedure1
PIO $ print $ runProgress (peano :: Four) $ do
n <- procedure2
n'' <- procedure2
return (n, n'')