17

Sto cercando un trasformatore monad che può essere utilizzato per tracciare l'avanzamento di una procedura. Per spiegare come sarebbe stato utilizzato, si consideri il seguente codice:Trasformatore Monad per il monitoraggio dell'avanzamento

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

mi rendo conto che step deve esistere in modo esplicito a causa delle leggi monadici, e che task deve avere un esplicito parametro numero di passo a causa del programma di determinismo/il problema dell'arresto.

La monade come sopra descritto potrebbe, secondo me, essere implementata in due modi:

  1. Via una funzione che restituirà la pila cognomi compito/passo attuale, e una continuazione nel procedura nel punto in cui era stata interrotta. Chiamando ripetutamente questa funzione sulla continuazione restituita si completerebbe l'esecuzione della procedura.
  2. Tramite una funzione che ha intrapreso un'azione descrivendo cosa fare quando una fase di attività è stata completata. La procedura funzionerebbe in modo incontrollabile fino al completamento, "notifica" all'ambiente delle modifiche tramite l'azione fornita.

Per la soluzione (1), ho visto Control.Monad.Coroutine con il functor di sospensione Yield. Per la soluzione (2), non conosco alcun trasformatore monad già disponibile che sarebbe utile.

La soluzione che sto cercando non dovrebbe avere troppe prestazioni in testa e consentire il massimo controllo sulla procedura possibile (ad esempio non richiede l'accesso IO o qualcosa del genere).

Una di queste soluzioni è valida, oppure esistono già altre soluzioni a questo problema? Questo problema è già stato risolto con un trasformatore monad che non sono stato in grado di trovare?

MODIFICA: L'obiettivo non è controllare se tutti i passaggi sono stati eseguiti. L'obiettivo è essere in grado di "monitorare" il processo mentre è in esecuzione, in modo che si possa dire quanto di esso è stato completato.

+0

You continuazioni citate ... Forse mi manca qualcosa di ovvio, ma mi chiedo se potessi semplicemente usare il c ontinuation monad transformer 'ContT'. – mergeconflict

+0

A meno che non abbia reimplementato 'putStr' e' putStrLn' con tipi 'String -> ProgressT IO()', è necessario sollevarli. Usa 'liftIO' per fare ciò. –

+0

La produzione e la visualizzazione delle informazioni sullo stato di avanzamento è un sistema di pubblicazione/sottoscrizione. Come implementarlo sotto il cofano dipenderà dal fatto che il thread principale o uno speciale altro thread o molti altri thread agiranno sullo stato di avanzamento. –

risposta

4

Questa è la mia soluzione pessimistica a questo problema. Utilizza Coroutine s per sospendere il calcolo su ogni passaggio, che consente all'utente di eseguire un calcolo arbitrario per segnalare alcuni progressi.

MODIFICA: L'implementazione completa di questa soluzione è disponibile here.

Questa soluzione può essere migliorata?

In primo luogo, come viene utilizzato:

-- 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 

Le uscite di cui sopra del programma:

--> 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)] 

l'effettiva attuazione (vedi this per una versione commentata):

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 
2

Il modo più ovvio per farlo è con StateT.

import Control.Monad.State 

type ProgressT m a = StateT Int m a 

step :: Monad m => ProgressT m() 
step = modify (subtract 1) 

io non sono sicuro di quello che si vuole la semantica di task di essere, però ...

modifica per mostrare come si farebbe questo con IO

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

Si noti che è necessario il vincolo MonadIO per stampare lo stato. Puoi avere un diverso tipo di vincolo se hai bisogno di un effetto diverso con lo stato (ad esempio, lancia un'eccezione se il numero di passi scende sotto lo zero o qualsiasi altra cosa).

+0

Questo non sarebbe utile, perché si otterrebbe l'accesso allo stato solo dopo che la procedura è terminata, il che non consente di tenere traccia del progresso. – dflemstr

+0

Eh? Puoi chiamare 'get' in qualsiasi momento per leggere lo stato! – sclv

+0

Se ho 'procedure :: StateT Int IO(); procedure = forever step', come posso eseguire 'procedure' in modo che, ad esempio, stampi il valore del passo corrente ogni volta che viene chiamato' step'? Non è possibile con una monade 'State'. – dflemstr

1

Non sono sicuro se questo è esattamente ciò che si desidera, ma qui è un'implementazione che impone il numero corretto di passaggi e richiede che ci siano zero passi rimanenti alla fine. Per semplicità, sto usando una monade invece di un trasformatore monad su IO. Nota che non sto usando la monade Prelude per fare quello che sto facendo.

UPDATE:

Ora è possibile estrarre il numero di passaggi rimanenti. Eseguire quanto segue 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') 
+0

Questa è una soluzione molto bella, ma risolve un problema diverso. Si prega di consultare il mio ** EDIT ** nella domanda originale. – dflemstr

+0

@dflemstr: aggiornato –

+0

Questo risolve ancora un problema diverso.Non è importante monitorare in modo statico i passaggi del progresso in alcun modo. E facendo 'procedure x = attività" pippo "x. forM_ [1..x] $ const step' diventa impossibile con questa soluzione. [Questa soluzione] (http://stackoverflow.com/a/8568374/230461) risolve il problema, ma potrebbe non essere l'ideale. – dflemstr

Problemi correlati