Haskell - Parsec with state

Question

I have a file in which the state of a game is saved in String format. This string consists of a list of moves, seperated by ,. From this list of moves I have to reconstruct the game state. Thus, conceptually, for each move I parse I want to modify the gamestate appropriatly and pass this gamestate to the parsing of the next move. Conceptually, this could be equivalent with having an empty list at the start and for each move consing the parsed move to that list. At the end you should have a list with all parsed moves.

I made the code example below as a simplified version to parse alfabetic letters and push these on the list. The core concept I want to learn is how to have an initial state, pass this on for each parsing cycle and return the final state using parsec. someState is the empty list initially.

parseExample :: State -> Parser [Char]
parseExample someState = do spaces 
                            c <- char 
                            c : someState
                            return someState

Answer 1

The simplest way to incorporate a "state" into a parser is not to do it at all. Let's say we have a tic-tac-toe board:

data Piece = X | O | N deriving (Show)
type Board = [[Piece]]

To parse a list of moves:

X11,O00,X01

into a board [[O,X,N],[N,X,N],[N,N,N]] representing the game state:

 O | X |
---+---+---
   | X |
---+---+---
   |   |

we can separate the parser, which just generates a list of moves:

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

from the functions that regenerate the game state:

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

and then connect them together in a loadGame function:

loadGame :: String -> Board
loadGame str =
  case parse moves "" str of
    Left err -> error $ "parse error: " ++ show err
    Right mvs -> game mvs

This should be your go-to solution for this kind of problem: parse first into a simple stateless intermediate form, and then process this intermediate form in a "stateful" computation.

If you really want to build up the state during the parse, there are several ways to do it. In this particular case, given the definition of turn above, we can parse directly into a Board by incorporating the fold from the game function into the 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

but this won't generalize too well if you have multiple parsers that need to operate on a single underlying state.

To actually thread a state through a set of parsers, you can use the "user state" feature of Parsec. Define a parser with a Board user state:

type Parser' = Parsec String Board

and then a parser for a single move that modifies the user state:

move' :: Parser' ()
move' = do
  m <- Move <$> piece <*> num <*> num
  modifyState (flip turn m)
  where piece = X <$ char 'X' <|> O <$ char 'O'
        num = read . (:[]) <$> digit

Note that move''s return type is () because its action is implemented as a side-effect on the user state.

Now, the act of simply parsing a list of moves:

moves' :: Parser' ()
moves' = sepBy move' (char ',')

will generate the final game state:

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

Here, loadGame' runs the parser on the user state with moves' and then uses a getState call to fetch the final board.

A nearly equivalent solution, since ParsecT is a monad transformer, is to create a ParsecT ... (State Board) monad transformer stack with a standard State layer. For example:

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

However, both these approaches of building up a state while parsing are weird and non-standard. A parser written in this form will be harder to understand and modify than the standard approach. Also, the intended usage for a user state is to maintain state that's necessary for the parser to decide how to perform the actual parse. For example, if you were parsing a language with dynamic operator precedence, you might want to maintain the current set of operator precedences as states, so when you parse an infixr 8 ** line, you can modify the state to correctly parse subsequent expressions. Using the user state to actually build up the result of the parse is not the intended usage.

Anyway, here's the code I used:

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"