为什么我的 MaybeT (State <type>) () 忽略状态变化?

Why does my MaybeT (State <type>) () ignore state changes?

简短版本: 当我在 MaybeT (State <type>) () 类型的 monad 上使用 runMaybeT 然后 runState 时,看起来状态没有变化即使 Maybe 结果等于 Just () 也会发生。为什么?

完整版:我正在写一个解决河内塔的程序。我将解决方案表示为 State monads 的列表,这些 monads 在排序时操纵初始 Towers 状态:

data Towers = Towers [Int] [Int] [Int]
    deriving (Show)
type Move = State Towers ()

towerMoves :: Int -> Rod -> Rod -> [Move]
towerMoves 1 r1 r2 = [pop r1 >>= push r2]
towerMoves n r1 r2 = topToTemp ++ (towerMoves 1 r1 r2) ++ topToFinal
  where
    r3 = other r1 r2
    topToTemp = towerMoves (n - 1) r1 r3
    topToFinal = towerMoves (n - 1) r3 r2

moves = towerMoves 5 First Third
initTowers = Towers [1,2,3,4,5] [] []

main = print $ snd $ runState (sequence_ moves) initTowers

到目前为止,这个程序产生了正确的输出:

Towers [] [] [1,2,3,4,5]

然后,我想验证程序是否遵守拼图规则,即没有较大的圆盘(此处用数字表示)出现在较小的圆盘之前。我想在每个 Move 之后插入某种验证,所以我尝试使用 MaybeT monad 转换器在移动列表中发送失败:

verifiedMoves :: [MaybeT (State Towers) ()]
verifiedMoves = map ((>> verify) . return) moves
  where
    check :: [Int] -> Bool
    check [] = True
    check [_] = True
    check (x:y:ys) = (x < y) && check (y:ys)
    verify :: MaybeT (State Towers) ()
    verify = do
        (Towers xs ys zs) <- lift get
        guard (check xs && check ys && check zs)

因此我改变了 main monad:

main = maybe (putStrLn "violation") (const $ print finalTowers) v
  where
    (v, finalTowers) = runState (runMaybeT $ sequence_ verifiedMoves) initTowers

现在输出看起来不对,好像没有发生状态变化:

Towers [1,2,3,4,5] [] []

如果我让初始状态无效,确实验证失败。因此,如果因为 Moves 的效果被打断而没有状态变化,我希望输出是 "violation."

这个词

为什么应用runMaybeT后,应用runState的结果是否等于(Just (), Towers [1,2,3,4,5] [] [])


下面是剩下的代码,供参考。我尝试了 lifting the get and put monads in my pop and push functions,但产生了相同的输出。

import Control.Monad
import Data.Functor.Identity
import Control.Monad.State
import Control.Monad.Trans.Maybe
import qualified Data.Map as M

data Rod = First | Second | Third
    deriving (Show)

other :: Rod -> Rod -> Rod
other First Second = Third
other Second First = Third
other First Third = Second
other Third First = Second
other Second Third = First
other Third Second = First

getRod :: Towers -> Rod -> [Int]
getRod (Towers x y z) First  = x
getRod (Towers x y z) Second = y
getRod (Towers x y z) Third  = z

setRod :: Rod -> Towers -> [Int] -> Towers
setRod First t ds  = Towers ds r2 r3
  where
    r2 = t `getRod` Second
    r3 = t `getRod` Third
setRod Second t ds = Towers r1 ds r3
  where
    r1 = t `getRod` First
    r3 = t `getRod` Third
setRod Third t ds  = Towers r1 r2 ds 
  where
    r1 = t `getRod` First
    r2 = t `getRod` Second

pop :: Rod -> State Towers Int
pop r = do
    t <- get
    let ds = t `getRod` r
        d = head ds
        load = setRod r
    put $ t `load` (tail ds)
    return d

push :: Rod -> Int -> State Towers ()
push r d = do
    t <- get
    let ds = t `getRod` r
        load = setRod r
    put $ t `load` (d:ds)

看看这一行

verifiedMoves = map ((>> verify) . return) moves

相当于

= map (\m -> return m >> verify) moves

但是对于所有 x,我们有 return x >> a = a,因此

= map (\_ -> verify) moves

所以你放弃了这些动作。您可能打算在那里使用 lift 而不是 return