将“状态”合并到解析器中的最简单方法是根本不这样做。假设我们有一个井字棋盘:
data Piece = X | O | N deriving (Show)
type Board = [[Piece]]
解析移动列表:
X11,O00,X01
进入代表游戏状态的棋盘[[O,X,N],[N,X,N],[N,N,N]]:
O | X |
---+---+---
| X |
---+---+---
| |
我们可以分离解析器,它只生成一个移动列表:
data Move = Move Piece Int Int
moves :: Parser [Move]
moves = sepBy move (char ',')
where move = Move <$> piece <*> num <*> num
piece = X <$ char 'X' <|> O <$ char 'O'
num = read . (:[]) <$> digit
来自重新生成游戏状态的函数:
board0 :: Board
board0 = [[N,N,N],[N,N,N],[N,N,N]]
game :: [Move] -> Board
game = foldl' turn board0
turn :: Board -> Move -> Board
turn brd (Move p r c) = brd & ix r . ix c .~ p
然后在 loadGame 函数中将它们连接在一起:
loadGame :: String -> Board
loadGame str =
case parse moves "" str of
Left err -> error $ "parse error: " ++ show err
Right mvs -> game mvs
这应该是此类问题的首选解决方案:首先解析为简单的无状态中间形式,然后在“有状态”计算中处理此中间形式。
如果您真的想在解析期间建立状态,有几种方法可以做到。在这种特殊情况下,鉴于上面turn 的定义,我们可以通过将game 函数中的折叠合并到解析器中来直接解析为Board:
moves1 :: Parser Board
moves1 = foldl' turn board0 <$> sepBy move (char ',')
where move = Move <$> piece <*> num <*> num
piece = X <$ char 'X' <|> O <$ char 'O'
num = read . (:[]) <$> digit
但是,如果您有多个解析器需要对单个底层状态进行操作,这将无法很好地概括。
要通过一组解析器实际线程化状态,您可以使用 Parsec 的“用户状态”功能。使用Board 用户状态定义解析器:
type Parser' = Parsec String Board
然后是修改用户状态的单个移动的解析器:
move' :: Parser' ()
move' = do
m <- Move <$> piece <*> num <*> num
modifyState (flip turn m)
where piece = X <$ char 'X' <|> O <$ char 'O'
num = read . (:[]) <$> digit
请注意,move' 的返回类型是 (),因为它的操作是作为对用户状态的副作用来实现的。
现在,简单地解析移动列表的行为:
moves' :: Parser' ()
moves' = sepBy move' (char ',')
将生成最终的游戏状态:
loadGame' :: String -> Board
loadGame' str =
case runParser (moves' >> getState) [[N,N,N],[N,N,N],[N,N,N]] "" str of
Left err -> error $ "parse error: " ++ show err
Right brd -> brd
这里,loadGame' 使用 moves' 在用户状态上运行解析器,然后使用 getState 调用来获取最终板。
由于ParsecT 是一个monad 转换器,一个几乎等效的解决方案是创建一个带有标准State 层的ParsecT ... (State Board) monad 转换器堆栈。例如:
type Parser'' = ParsecT String () (Control.Monad.State.State Board)
move'' :: Parser'' ()
move'' = do
m <- Move <$> piece <*> num <*> num
modify (flip turn m)
where piece = X <$ char 'X' <|> O <$ char 'O'
num = read . (:[]) <$> digit
moves'' :: Parser'' ()
moves'' = void $ sepBy move'' (char ',')
loadGame'' :: String -> Board
loadGame'' str =
case runState (runParserT moves'' () "" str) board0 of
(Left err, _) -> error $ "parse error: " ++ show err
(Right (), brd) -> brd
但是,这两种在解析时建立状态的方法都是奇怪且不标准的。以这种形式编写的解析器将比标准方法更难理解和修改。此外,用户状态的预期用途是维护解析器决定如何执行实际解析所必需的状态。例如,如果您正在解析具有动态运算符优先级的语言,您可能希望将当前的一组运算符优先级保持为状态,因此当您解析 infixr 8 ** 行时,您可以修改状态以正确解析后续表达式。使用用户状态来实际构建解析的结果并不是预期的用途。
无论如何,这是我使用的代码:
import Control.Lens
import Control.Monad
import Control.Monad.State
import Data.Foldable
import Text.Parsec
import Text.Parsec.Char
import Text.Parsec.String
data Piece = X | O | N deriving (Show)
type Board = [[Piece]]
data Move = Move Piece Int Int
-- *Standard parsing approach
moves :: Parser [Move]
moves = sepBy move (char ',')
where move = Move <$> piece <*> num <*> num
piece = X <$ char 'X' <|> O <$ char 'O'
num = read . (:[]) <$> digit
board0 :: Board
board0 = [[N,N,N],[N,N,N],[N,N,N]]
game :: [Move] -> Board
game = foldl' turn board0
turn :: Board -> Move -> Board
turn brd (Move p r c) = brd & ix r . ix c .~ p
loadGame :: String -> Board
loadGame str =
case parse moves "" str of
Left err -> error $ "parse error: " ++ show err
Right mvs -> game mvs
-- *Incoporate fold into parser
moves1 :: Parser Board
moves1 = foldl' turn board0 <$> sepBy move (char ',')
where move = Move <$> piece <*> num <*> num
piece = X <$ char 'X' <|> O <$ char 'O'
num = read . (:[]) <$> digit
-- *Non-standard effectful parser
type Parser' = Parsec String Board
move' :: Parser' ()
move' = do
m <- Move <$> piece <*> num <*> num
modifyState (flip turn m)
where piece = X <$ char 'X' <|> O <$ char 'O'
num = read . (:[]) <$> digit
moves' :: Parser' ()
moves' = void $ sepBy move' (char ',')
loadGame' :: String -> Board
loadGame' str =
case runParser (moves' >> getState) board0 "" str of
Left err -> error $ "parse error: " ++ show err
Right brd -> brd
-- *Monad transformer stack
type Parser'' = ParsecT String () (Control.Monad.State.State Board)
move'' :: Parser'' ()
move'' = do
m <- Move <$> piece <*> num <*> num
modify (flip turn m)
where piece = X <$ char 'X' <|> O <$ char 'O'
num = read . (:[]) <$> digit
moves'' :: Parser'' ()
moves'' = void $ sepBy move'' (char ',')
loadGame'' :: String -> Board
loadGame'' str =
case runState (runParserT moves'' () "" str) board0 of
(Left err, _) -> error $ "parse error: " ++ show err
(Right (), brd) -> brd
-- *Tests
main = do
print $ loadGame "X11,O00,X01"
print $ loadGame' "X11,O00,X01"
print $ loadGame'' "X11,O00,X01"