复杂状态单子结构答案

【问题标题】：Complex State Monad Structure复杂状态单子结构
【发布时间】：2011-10-10 08:29:12
【问题描述】：

我还是 Haskell 的新手，我想我现在已经不知所措了。我的代码如下所示。

data World = World {
  intStack :: [Int],
  boolStack :: [Bool]
} deriving Show

instance IntStack World where
   getIntStack = intStack
   putIntStack ints (World _ bools) = World ints bools

instance BoolStack World where
    getBoolStack = boolStack
    putBoolStack bools (World ints _) = World ints bools

class IntStack a where
    getIntStack :: a -> [Int]
    putIntStack :: [Int] -> a -> a

class BoolStack a where
    getBoolStack :: a -> [Bool]
    putBoolStack :: [Bool] -> a -> a

(<=>) :: (IntStack c, BoolStack c) => c -> c
(<=>) w = putIntStack xs . putBoolStack ((x == x'):bs) $ w
    where (x:x':xs) = getIntStack w
          bs = getBoolStack w

(<+>) :: (IntStack c) => c -> c
(<+>) w = putIntStack ((x+x'):xs) w
    where (x:x':xs) = getIntStack w

我的重点（现在忽略函数中的错误情况）是能够将 () 和 () 等函数链接在一起，假设底层数据类型实现了函数所需的接口。

我觉得我可以用 state monad 清理很多东西，但我不确定如何构造它以允许更改实现 IntStack、BoolStack 等的任何数据类型。

我知道这是一个非常模糊的描述，但我觉得我上面的代码可能是绝对错误的方法。

感谢您的任何反馈！

【问题讨论】：

标签： haskell monads state-monad

【解决方案1】：

class IntStack a where
    getIntStack :: a -> [Int]
    putIntStack :: [Int] -> a -> a

class BoolStack a where
    getBoolStack :: a -> [Bool]
    putBoolStack :: [Bool] -> a -> a

恭喜，您刚刚发明了镜头！抽象[Int] 和[Bool] 类型，并使用data 而不是class，你会得到类似的东西

data Lens a b = Lens
    { get :: a -> b
    , put :: b -> a -> a
    }

...在 Hackage 上的六个包中实现。大多数至少提供：

能够直接从数据声明中导出投影镜头，例如 getIntStack/putIntStack 和 getBoolStack/putBoolStack
水平构图（运行第一个镜头，然后运行第二个镜头——例如，首先从一些较大的结构中挑选World，然后从World 中挑选intStack）和垂直构图（运行两个镜头平行，每个在一对的一侧）
一些与State 和StateT 的接口（例如Lens a b -> State b r -> State a r 类型的东西），这将允许您在[Bool] 或[Int] 上编写计算并像在@987654344 上一样运行它们@

所以，检查一下黑客攻击！还有data-lens家族，包括a core、the deriving ability和the stateful interface； lens 包；和pointless-lenses 包。可能还有一些我也忘记了。

【讨论】：

是的，我还（重新）发明了镜头！我现在正在从 hackage 中提取包裹。 +1
非常感谢，绝对让我大吃一惊。

【解决方案2】：

您可以在 state monad 中实现 push 和 pop 操作，并使用它们来实现您的功能：

popInt :: IntStack c => State c Int
popInt = do
  (x:xs) <- getIntStack <$> get
  modify $ putIntStack xs
  return x

pushInt :: IntStack c => Int -> State c ()
pushInt x = do
  xs <- getIntStack <$> get
  modify $ putIntStack (x:xs)

(<+>) :: IntStack c => State c ()
(<+>) = do 
  x <- popInt
  x' <- popInt
  pushInt (x + x')

【讨论】：