Haskell - Parsec with state - parsing

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"

Answer 2

You probably want to use foldl (if I am understanding your question correctly). So you'll end up with a function like:
module Main where
import Data.Text
import Data.String
main :: IO ()
main =
putStrLn (show $ parseGameState "a, b, c")
data State = State deriving (Show)
parseGameState :: String -> [State]
parseGameState stateString = parsedState where
parsedState = Prelude.foldl mkNewStateFromPreviousAndMove [] moves where
moves = splitOn (fromString ",") (fromString stateString)
mkNewStateFromPreviousAndMove oldStates move = oldStates ++ [newState previousState move] where
previousState = Prelude.last oldStates
newState previousState move = State
What this is doing is:
Taking the CSV move string as input.
It is then splitting that string into a list of move strings.
Then, we start with an empty list, and fold the move strings into this list by applying mkNewStateFromPreviousAndMove to each element in the moves list and the last element of the list which is built up by the fold.
Note, you will need to add the following deps to your package.yaml file (if using stack):
text
This dep is used to split strings.