Haskell/XMonad: обертка вокруг Монады, которая также отслеживает данные

Question

Это продолжение к Ben's previous answer. Я попросил проверку типов для случаев, в которых X t действия «требуют очистки» (снятие кнопок и/или клавиатуры после завершения). Его ответ был монадическая обертка NeedsCleanup, для которого моя текущая реализация идет что-то вроде этого:

{-# LANGUAGE GeneralizedNewtypeDeriving #-} 

newtype NeedsCleanup m t = 
    NeedsCleanup 
    { 
     -- | Escape hatch from the NeedsCleanup Monad; 
     -- returns the original action. 
     original_action :: m t 
    } 
    deriving (Functor, Applicative, Monad) 

-- | executes unclean_action and cleans up afterwards. 
-- (cleanedUp action) is a normal X() action 
cleanedUp :: NeedsCleanup X t -> X t 
cleanedUp unclean_action = do 
    result <- original_action unclean_action 
    doCleanup 
    return result 

Таким образом, если action имеет тип NeedsCleanup X(), я не могу случайно использовать его в качестве X(), не отправляя его через (cleanedUp action) первый , Фантастика!

---

Я хотел бы улучшить NeedsCleanup обертку, так что он также «monadically» передает данные, указывая на то, что именно нужно очистки.

Это потому, что я обнаружил, что для разных действий могут потребоваться разные вещи, которые нужно очистить, и я должен очистить после всего, что было привязано вместе.

Чтобы быть более точным, для каждого NeedsCleanup X t действия, я хотел бы, чтобы там быть сопоставляется CleanupData:

data CleanupData = CleanupData 
    { 
     keyboard_needs_cleanup :: Bool 
    , buttons_needing_cleanup :: Set.Set Buttons 

    -- any other fields 
    -- ... 
    } 

Два CleanupData могут быть объединены, в результате чего примерно союз ("после этого, вы должны очистите оба эти действия »).

-- | combines two CleanupData into the resulting CleanupData 
combineCleanupData :: CleanupData -> CleanupData -> CleanupData 
combineCleanupData dta1 dta2 = 
    CleanupData 
    { 
     keyboard_needs_cleanup = 
      (keyboard_needs_cleanup dta1) || (keyboard_needs_cleanup dta2) 

     , buttons_needing_cleanup = 
      (buttons_needing_cleanup dta1) `Set.union` (buttons_needing_cleanup dta2) 

     -- union other data fields 
     -- ... 
    } 

Например, если:

action1 :: NeedsCleanup X() связан с dta1 :: CleanupData

action2 :: NeedsCleanup X() связан с dta2 :: CleanupData

Затем action1 >> action2 должен быть связан с combineCleanupData dta1 dta2 (примерно «, что вам нужно очистить для обоих ").

И наконец, в конце функция cleanedUp :: NeedsCleanup X t -> X t должна выполнить основное действие X t и получить действие CleanupData (чтобы посмотреть, что нужно для очистки).

Можно ли использовать монадическую обертку для отслеживания данных таким образом?

---

Update:

я в конечном итоге использовать что-то похожее на ответ Ilmo Euro, за исключением определения структуры моноидной для CleanupData вместо использования список моноидного.Нечто похожее на:

import Control.Monad.Writer.Lazy (WriterT(..), runWriterT, tell, MonadWriter(..)) 
import Control.Monad.Trans.Class (MonadTrans(..)) 
import Data.Monoid (Monoid(..)) 

initialCleanupData = 
    CleanupData 
    { 
     keyboard_needs_cleanup = False 
     , buttons_needing_cleanup = Set.empty 

     -- initial values for other fields 
    } 

instance Monoid CleanupData where 
    mempty = initialCleanupData 
    mappend = combineCleanupData 

newtype NeedsCleanup m t = 
    NeedsCleanup 
    { 
     to_writable :: WriterT CleanupData m t 
    } deriving (MonadTrans, Monad, Applicative, Functor, MonadIO, MonadWriter CleanupData) 

cleanup :: NeedsCleanup X t -> X t 
cleanup action = do 
    (ret_val, cleanup_data) <- runWriterT (to_writable action) 

    -- clean up based on cleanup_data 
    -- ... 

    return ret_val 

Для того, чтобы определить действие, которое нуждается в очистке, я бы tell ему его CleanupData, например, что-то подобное:

needsCleanup_GrabButton 
    :: MonadIO m => Display -> Window -> Button -> NeedsCleanup m() 
needsCleanup_GrabButton dply window button = do 
    liftIO $ grabButton dply button anyModifier window True buttonReleaseMask grabModeAsync grabModeAsync none none 

    tell cleanup_data 
    where 
    -- the stuff we need to clean up from this 
    -- particular action 
    cleanup_data = initialCleanupData 
     { 
      buttons_needing_cleanup = Set.singleton button 
     } 

Answer 1

Вы можете использовать, например, Writer монады для этого:

import Control.Monad.Writer 

data DirtyThing = Keyboard | Mouse 
newtype Dirty m a = Dirty { unDirty :: WriterT [DirtyThing] m a } 

doFoo :: Dirty IO() 
doFoo = -- doing something dirty 

cleanup :: Dirty m a -> m a 
cleanup action = do 
    (val, dirtyThings) <- runWriterT (unDirty action) 
    -- cleanup dirtyThings 
    return val 

для повышения эффективности можно использовать Set вместо списков (и определить NewType обертку для него с соответствующий пример Monoid). Другой, более безопасный по типу (но гораздо более утомительный) способ - использовать indexed monads.