复杂状态Monad结构

时间:2011-10-10 08:29:13

标签: haskell monads state-monad

我仍然是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

我的重点(目前忽略函数中的错误情况)能够将函数(如&lt; =&gt;)和(&lt; +&gt;)链接在一起,假设底层数据类型实现了函数所需的接口。

我觉得我可以使用状态monad清理它很多,但我不知道如何构造它以允许更改实现IntStack,BoolStack等的任何数据类型。

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

感谢您的反馈!

2 个答案:

答案 0 :(得分:5)

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 / putIntStackgetBoolStack / putBoolStack等投影镜头的能力
  • 水平构图(运行第一个镜头,然后运行第二个镜头 - 例如首先从一些较大的结构中挑选World,然后从intStack中选择World)垂直构图(并行运行两个镜头,每个镜头一对)
  • StateStateT的某些界面(例如Lens a b -> State b r -> State a r类型的某些内容),可让您在[Bool][Int]上编写计算并运行它们好像是World
  • 上的计算

所以,看看hackage!有data-lens个系列,其中包括a corethe deriving abilitythe stateful interface; lens包裹;和pointless-lenses包。可能有一些我也忘记了。

答案 1 :(得分:1)

您可以在状态monad中实现推送和弹出操作,并使用它们来实现您的功能:

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