Haskell/XMonad: Monad 的包装器,它也跟踪数据

Haskell/XMonad: wrapper around a Monad that also keeps track of data

这是 的后续。我曾要求对 X t 动作 "require cleanup" 的情况进行类型检查(在完成后取消抓取按钮 and/or 键盘)。他的回应是一个 monadic wrapper 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 ()操作可能需要清理不同的东西,而我必须在所有绑定在一起之后才能清理。

更准确地说,对于每个 NeedsCleanup X t 操作,我希望关联一个 CleanupData:

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

     -- any other fields
     -- ...
  }

两个CleanupData可以合并,大致形成一个并集("afterwards, you have to clean up both for these actions")。

-- | 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 相关联(大约 "what you need to clean up for both")。

最后,函数 cleanedUp :: NeedsCleanup X t -> X t 应该执行底层的 X t 操作并获取操作的 CleanupData(以查看需要清理的内容)。

是否可以使用 monadic 包装器以这种方式跟踪数据?


更新:

除了为 CleanupData 定义一个 Monoid 结构而不是使用 List Monoid 之外,我最终使用了类似于 Ilmo Euro 的答案。类似于:

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
      }

例如,您可以为此使用 Writer monad:

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 实例为其定义一个新类型包装器)。另一种更类型安全(但更乏味)的方法是使用 .