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

Question

Это продолжение предыдущего ответа Бена. Я попросил проверить тип для случаев, когда 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 обертка, так что она также "монадически" передает данные, указывая, что именно нужно очистить.

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

Чтобы быть более точным, для каждого 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 (чтобы увидеть, что нуждается в очистке).

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

---

Обновить:

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

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 вместо списков (и определите для него упаковку нового типа с соответствующей Monoid пример). Другим, более безопасным для типов (но гораздо более утомительным) способом было бы использование индексированных монад.