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

Ale*_*lex 4 haskell state-monad monad-transformers

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

完整版:我正在编写一个程序来解决河内之塔.我将解决方案表示为Statemonad 列表,在排序时,操作初始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
Run Code Online (Sandbox Code Playgroud)

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

Towers [] [] [1,2,3,4,5]
Run Code Online (Sandbox Code Playgroud)

然后,我想验证程序是否遵守了拼图的规则,即没有更大的光盘(这里用数字表示)在较小的光盘之前.我想在每次之后插入某种验证Move,所以我尝试使用MaybeTmonad转换器在移动列表中发送失败:

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)
Run Code Online (Sandbox Code Playgroud)

因此,我改变了mainmonad:

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

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

Towers [1,2,3,4,5] [] []
Run Code Online (Sandbox Code Playgroud)

如果我使初始状态无效,它确实无法通过验证.因此,如果由于Moves 的影响被中断而没有状态改变,我希望输出是"违规"一词.

申请后runMaybeT,为什么申请runState等于(Just (), Towers [1,2,3,4,5] [] [])


以下是其余代码,供参考.我尝试在我函数中提升getputmonadpoppush,但是产生了相同的输出.

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)
Run Code Online (Sandbox Code Playgroud)

Li-*_*Xia 9

看看这一行

verifiedMoves = map ((>> verify) . return) moves
Run Code Online (Sandbox Code Playgroud)

相当于

= map (\m -> return m >> verify) moves
Run Code Online (Sandbox Code Playgroud)

但对于所有的x,我们有return x >> a = a,从而

= map (\_ -> verify) moves
Run Code Online (Sandbox Code Playgroud)

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