Parsing

Tip

Understanding parser combinators is a prerequisite for this module. See here for information.

module Parser where

import Chess
  ( Color (Black, White),
    File (..),
    Piece (..),
    PieceType (..),
    Rank (..),
  ) -- (13)!
import Control.Applicative (asum, optional)
import Data.Char (digitToInt, isDigit)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void (Void)
import Text.Megaparsec
import Text.Megaparsec.Char (char, space)
import Text.Megaparsec.Char.Lexer (lexeme)
import qualified Data.Map as M -- (14)!
import Witch (into)

type Parser = Parsec Void T.Text -- (15)!

data ChessError = ReplError Text | ParseError Text | Exit deriving Show -- (1)!

-- the result of the parser will be a value of this type
data Instruction where
  Set :: File -> Rank -> Piece -> Instruction
  ReplInstruction :: Text -> Instruction
  deriving (Show)

-- run the parser
parse :: Text -> Either ChessError Instruction
parse line =
  either -- (3)!
    (Left . ParseError . into @Text . errorBundlePretty)
    Right
    (runParser parser "" line)

-- the parser
parser :: Parser Instruction
parser =
  let replCommand (name, instr) = -- (9)!
        const (ReplInstruction instr) <$> name -- (4) (8)
   in asum -- (2)!
        [ replCommand (":q", "quit"),
          replCommand (":r", "reset"),
          replCommand (":d", "display"),
          place
        ] -- (5)!
  where

    -- place (a) white bishop on a4
    place :: Parser Instruction -- (6)!
    place = do -- (12)!
      word "place" -- (7)!
      optional $ word "a"
      piece <- parsePiece
      word "on"
      file <- asum $ parseFile <$> [A .. H] 
      rank <- asum $ parseRank <$> [One .. Eight]
      eof -- (10)!
      return $ Set file rank piece -- (11)!

-- a helper function to add trailing whitespace to a parser
word :: Parser b -> Parser b
word = lexeme (" " >> space)

parsePiece :: Parser Piece
parsePiece = do
  color <- word $ (const White <$> "white") <|> (const Black <$> "black")
  pieceType <-
    word $
      try (const Bishop <$> "bishop")
        <|> try (const King <$> "king")
        <|> try (const Queen <$> "queen")
        <|> try (const Knight <$> "knight")
        <|> try (const Rook <$> "rook")
        <|> try (const Pawn <$> "pawn")
  return (Piece pieceType color)

-- given a Rank, produce a parser that only recognizes that rank
parseRank :: Rank -> Parser Rank
parseRank x =
  const x
    <$> char
      ( case x of
          One -> '1'
          Two -> '2'
          Three -> '3'
          Four -> '4'
          Five -> '5'
          Six -> '6'
          Seven -> '7'
          Eight -> '8'
      )

-- given a File, produce a parser that only recognizes that file
parseFile :: File -> Parser File
parseFile x =
  const x
    <$> char
      ( case x of
          A -> 'a'
          B -> 'b'
          C -> 'c'
          D -> 'd'
          E -> 'e'
          F -> 'f'
          G -> 'g'
          H -> 'h'
      )

1. It's often useful to make a custom type for errors specific to the domain in question.
2. asum comes from the Alternative typeclass: asum [x,y,z] = x <|> y <|> z.
3. either :: (a -> c) -> (b -> c) -> Either a b -> c is a useful function for handling an Either X Y.
4. Viewed with the Haskell Language Server, this will be underlined in blue, with a simplification suggested.
5. Like anything else in Haskell, parsers are just values, so it's possible (and idiomatic) to put them in a list and then fold the list.
6. Observe how the parser as a whole is built out of smaller parsers.
7. "place" is itself a parser, thanks to OverloadedStrings.
8. a <$> b = fmap a b. That is: <$> is an infix synonym for fmap. Example with const: fmap (const 1) [1,2,3,4] = [1,1,1,1]
9. We abstract some boilerplate with a function that makes a simple parser given a name and return value.
10. eof only succeeds at the end of a line, so ensures there are no more characters left.
11. return is not a keyword. Here, it converts an Instruction into a Parser Instruction, namely the trivial parser that does nothing and immediately returns an Instruction. This Parser Instruction is the final parser in the sequence of parsers in the do-notation code block.
12. do-notation used to build a complex parser out of a series of simpler ones and their results.
13. Explicit imports like this are useful both for readability and to avoid namespace clashes.
14. Another way to avoid namespace clashes. Common for both Data.Map and Data.Text.
15. Void is the empty type. This says that the custom error type is Void (i.e. doesn't exist), and that the type of the input sequence is Text.

Analysis

This module exists to parse user input on the command line into the Instruction type. Parsing directly into a custom type is idiomatic Haskell because it handles errors nicely: either parsing succeeds and you're guaranteed to get an Instruction, or you get an interpretable parse failure.

Note the use of word, a function which takes a parser and returns a new parser that handles white space. This abstracts white space handling to a single function, and makes for clean, idiomatic parsing.

parsePiece

original

```haskell

parsePiece :: Ord a => Parsec a Text Piece parsePiece = do color <- word $ (const White <\(> "white") <|> (const Black <\)> "black") pieceType <- word $ try (const Bishop <\(> "bishop") <|> try (const King <\)> "king") <|> try (const Queen <\(> "queen") <|> try (const Knight <\)> "knight") <|> try (const Rook <\(> "rook") <|> try (const Pawn <\)> "pawn") return (Piece pieceType color) ```

abstracted

```haskell

parsePiece :: Ord a => Parsec a Text Piece parsePiece = do color <- word $ (const White <\(> "white") <|> (const Black <\)> "black") pieceType <- word $ asum [try (const piece <$> "bishop") | piece <- [Bishop, King, Queen, Knight, Rook, Pawn]] return (Piece pieceType color) ```

Using <$

```haskell

parsePiece :: Ord a => Parsec a Text Piece parsePiece = do color <- word $ ( White <$ "white") <|> ( Black <$ "black") pieceType <- word $ asum [try ( piece <$ "bishop") | piece <- [Bishop, King, Queen, Knight, Rook, Pawn]] return (Piece pieceType color) ```

parseRank

original

```haskell

parseRank :: Rank -> Parser Rank parseRank x = const x <$> char ( case x of One -> '1' Two -> '2' Three -> '3' Four -> '4' Five -> '5' Six -> '6' Seven -> '7' Eight -> '8' ) ```

with a Map

```haskell

import qualified Data.Map as M

parseRank :: Rank -> Parser Rank
parseRank x =  const x <$>
case x `M.lookup` M.fromList (zip [One .. Eight] ['1'..'8']) of
    Just c -> char c
    Nothing -> error "unreachable state"
```

---

Last update: February 9, 2023
Created: August 18, 2022