-- This file is part of Goatee.
--
-- Copyright 2014-2021 Bryan Gardiner
--
-- Goatee is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- Goatee is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with Goatee.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE CPP #-}

-- | Parsers of property values.
module Game.Goatee.Lib.Property.Parser (
  colorParser,
  coordElistParser,
  coordListParser,
  coordPairListParser,
  doubleParser,
  gameResultParser,
  labelListParser,
  lineListParser,
  moveParser,
  noneParser,
  integralParser,
  realParser,
  rulesetParser,
  simpleTextPairParser,
  simpleTextParser,
  sizeParser,
  textParser,
  unknownPropertyParser,
  variationModeParser,
  -- * Exposed for testing
  compose,
  line,
  simpleText,
  text,
  ) where

import Control.Monad (when)
import Data.Char (isUpper, ord)
import Data.Maybe (catMaybes)
import qualified Game.Goatee.Common.Bigfloat as BF
import Game.Goatee.Lib.Types
import Text.ParserCombinators.Parsec (
  (<?>), (<|>), Parser,
  anyChar, char, choice, digit, many, many1,
  noneOf, oneOf, option, space, spaces, string,
  try, unexpected,
  )

{-# ANN module "HLint: ignore Reduce duplication" #-}

-- Internal parser builders not corresponding to any particular value type.

-- | A wrapper around 'CoordList' with a 'Monoid' instance used for parsing.
-- The monoid does simple concatenation of the single and rectangle lists, so it
-- is not appropriate for @CoordList@ proper, as it doesn't do duplicate removal
-- between two @CoordList@s.
newtype CoordListMonoid = CoordListMonoid { CoordListMonoid -> CoordList
runCoordListMonoid :: CoordList }

instance Semigroup CoordListMonoid where
  <> :: CoordListMonoid -> CoordListMonoid -> CoordListMonoid
(<>) (CoordListMonoid CoordList
x) (CoordListMonoid CoordList
y) =
    CoordList -> CoordListMonoid
CoordListMonoid (CoordList -> CoordListMonoid) -> CoordList -> CoordListMonoid
forall a b. (a -> b) -> a -> b
$ [Coord] -> [(Coord, Coord)] -> CoordList
coords' (CoordList -> [Coord]
coordListSingles CoordList
x [Coord] -> [Coord] -> [Coord]
forall a. [a] -> [a] -> [a]
++ CoordList -> [Coord]
coordListSingles CoordList
y)
                              (CoordList -> [(Coord, Coord)]
coordListRects CoordList
x [(Coord, Coord)] -> [(Coord, Coord)] -> [(Coord, Coord)]
forall a. [a] -> [a] -> [a]
++ CoordList -> [(Coord, Coord)]
coordListRects CoordList
y)

instance Monoid CoordListMonoid where
  mempty :: CoordListMonoid
mempty = CoordList -> CoordListMonoid
CoordListMonoid CoordList
emptyCoordList

  mappend :: CoordListMonoid -> CoordListMonoid -> CoordListMonoid
mappend = CoordListMonoid -> CoordListMonoid -> CoordListMonoid
forall a. Semigroup a => a -> a -> a
(<>)

single :: Parser a -> Parser a
single :: Parser a -> Parser a
single Parser a
valueParser = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT String () Identity Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
valueParser Parser a -> ParsecT String () Identity Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'

compose :: Parser a -> Parser b -> Parser (a, b)
compose :: Parser a -> Parser b -> Parser (a, b)
compose Parser a
first Parser b
second = do
  a
x <- Parser a
first
  Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  b
y <- Parser b
second
  (a, b) -> Parser (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, b
y)

line :: Parser Int
line :: Parser Int
line = Char -> Int
toLine (Char -> Int) -> ParsecT String () Identity Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
line' Parser Int -> String -> Parser Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"line"
  where line' :: ParsecT String u Identity Char
line' = String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (String -> ParsecT String u Identity Char)
-> String -> ParsecT String u Identity Char
forall a b. (a -> b) -> a -> b
$ [Char
'a'..Char
'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z']
        toLine :: Char -> Int
toLine Char
c = if Char -> Bool
isUpper Char
c
                   then Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
26
                   else Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'

listOf :: Parser a -> Parser [a]
listOf :: Parser a -> Parser [a]
listOf Parser a
valueParser = Parser a -> Parser [a]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parser a -> Parser a
forall a. Parser a -> Parser a
single Parser a
valueParser Parser a -> ParsecT String () Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)

number :: Parser String
number :: Parser String
number = do
  String -> String
addSign <- (Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String () Identity (String -> String)
-> ParsecT String () Identity (String -> String)
-> ParsecT String () Identity (String -> String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             String -> String
forall a. a -> a
id (String -> String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (String -> String)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT String () Identity (String -> String)
-> ParsecT String () Identity (String -> String)
-> ParsecT String () Identity (String -> String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
             (String -> String) -> ParsecT String () Identity (String -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String
forall a. a -> a
id
  String -> String
addSign (String -> String) -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

-- Public parsers.

colorParser :: Parser Color
colorParser :: Parser Color
colorParser = Parser Color -> Parser Color
forall a. Parser a -> Parser a
single Parser Color
color Parser Color -> String -> Parser Color
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"color"

color :: Parser Color
color :: Parser Color
color = [Parser Color] -> Parser Color
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Color
Black Color -> ParsecT String () Identity Char -> Parser Color
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'B',
                Color
White Color -> ParsecT String () Identity Char -> Parser Color
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'W']

coord :: Parser Coord
coord :: Parser Coord
coord = (,) (Int -> Int -> Coord)
-> Parser Int -> ParsecT String () Identity (Int -> Coord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
line ParsecT String () Identity (Int -> Coord)
-> Parser Int -> Parser Coord
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int
line

coordElistParser :: Parser CoordList
coordElistParser :: Parser CoordList
coordElistParser =
  Parser CoordList -> Parser CoordList
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CoordList
emptyCoordList CoordList -> Parser String -> Parser CoordList
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"[]") Parser CoordList -> Parser CoordList -> Parser CoordList
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  Parser CoordList
coordListParser Parser CoordList -> String -> Parser CoordList
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>
  String
"list of points or empty"

coordListParser :: Parser CoordList
coordListParser :: Parser CoordList
coordListParser =
  CoordListMonoid -> CoordList
runCoordListMonoid (CoordListMonoid -> CoordList)
-> ([CoordList] -> CoordListMonoid) -> [CoordList] -> CoordList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoordListMonoid] -> CoordListMonoid
forall a. Monoid a => [a] -> a
mconcat ([CoordListMonoid] -> CoordListMonoid)
-> ([CoordList] -> [CoordListMonoid])
-> [CoordList]
-> CoordListMonoid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoordList -> CoordListMonoid) -> [CoordList] -> [CoordListMonoid]
forall a b. (a -> b) -> [a] -> [b]
map CoordList -> CoordListMonoid
CoordListMonoid ([CoordList] -> CoordList)
-> ParsecT String () Identity [CoordList] -> Parser CoordList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CoordList -> ParsecT String () Identity [CoordList]
forall a. Parser a -> Parser [a]
listOf Parser CoordList
coordListEntry Parser CoordList -> String -> Parser CoordList
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>
  String
"list of points"
  where coordListEntry :: Parser CoordList
coordListEntry = do Int
x0 <- Parser Int
line
                            Int
y0 <- Parser Int
line
                            [Parser CoordList] -> Parser CoordList
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [do Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
                                       Int
x1 <- Parser Int
line
                                       Int
y1 <- Parser Int
line
                                       CoordList -> Parser CoordList
forall (m :: * -> *) a. Monad m => a -> m a
return (CoordList -> Parser CoordList) -> CoordList -> Parser CoordList
forall a b. (a -> b) -> a -> b
$ (Coord, Coord) -> CoordList
coordR ((Int
x0, Int
y0), (Int
x1, Int
y1)),
                                    CoordList -> Parser CoordList
forall (m :: * -> *) a. Monad m => a -> m a
return (CoordList -> Parser CoordList) -> CoordList -> Parser CoordList
forall a b. (a -> b) -> a -> b
$ Coord -> CoordList
coord1 (Int
x0, Int
y0)]
        coordR :: (Coord, Coord) -> CoordList
coordR (Coord, Coord)
rect = [Coord] -> [(Coord, Coord)] -> CoordList
coords' [] [(Coord, Coord)
rect]

coordPairListParser :: Parser [(Coord, Coord)]
coordPairListParser :: Parser [(Coord, Coord)]
coordPairListParser = Parser (Coord, Coord) -> Parser [(Coord, Coord)]
forall a. Parser a -> Parser [a]
listOf Parser (Coord, Coord)
coordPair Parser [(Coord, Coord)] -> String -> Parser [(Coord, Coord)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"list of point pairs"
  where coordPair :: Parser (Coord, Coord)
coordPair = do
          Int
x0 <- Parser Int
line
          Int
y0 <- Parser Int
line
          Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
          Int
x1 <- Parser Int
line
          Int
y1 <- Parser Int
line
          (Coord, Coord) -> Parser (Coord, Coord)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
x0, Int
y0), (Int
x1, Int
y1))

doubleParser :: Parser DoubleValue
doubleParser :: Parser DoubleValue
doubleParser =
  Parser DoubleValue -> Parser DoubleValue
forall a. Parser a -> Parser a
single (DoubleValue
Double1 DoubleValue
-> ParsecT String () Identity Char -> Parser DoubleValue
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'1' Parser DoubleValue -> Parser DoubleValue -> Parser DoubleValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          DoubleValue
Double2 DoubleValue
-> ParsecT String () Identity Char -> Parser DoubleValue
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'2') Parser DoubleValue -> String -> Parser DoubleValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>
  String
"double"

gameResultParser :: Parser GameResult
gameResultParser :: Parser GameResult
gameResultParser = Parser GameResult -> Parser GameResult
forall a. Parser a -> Parser a
single (SimpleText -> GameResult
forall a b. (Stringlike a, Stringlike b) => a -> b
convertStringlike (SimpleText -> GameResult)
-> ParsecT String () Identity SimpleText -> Parser GameResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ParsecT String () Identity SimpleText
simpleText Bool
False) Parser GameResult -> String -> Parser GameResult
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"game result"

labelListParser :: Parser [(Coord, SimpleText)]
labelListParser :: Parser [(Coord, SimpleText)]
labelListParser =
  Parser (Coord, SimpleText) -> Parser [(Coord, SimpleText)]
forall a. Parser a -> Parser [a]
listOf (Parser Coord
-> ParsecT String () Identity SimpleText
-> Parser (Coord, SimpleText)
forall a b. Parser a -> Parser b -> Parser (a, b)
compose Parser Coord
coord (ParsecT String () Identity SimpleText
 -> Parser (Coord, SimpleText))
-> ParsecT String () Identity SimpleText
-> Parser (Coord, SimpleText)
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT String () Identity SimpleText
simpleText Bool
True) Parser [(Coord, SimpleText)]
-> String -> Parser [(Coord, SimpleText)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"list of points and labels"

lineListParser :: Parser [Line]
lineListParser :: Parser [Line]
lineListParser = ((Coord, Coord) -> Line) -> [(Coord, Coord)] -> [Line]
forall a b. (a -> b) -> [a] -> [b]
map ((Coord -> Coord -> Line) -> (Coord, Coord) -> Line
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coord -> Coord -> Line
Line) ([(Coord, Coord)] -> [Line])
-> Parser [(Coord, Coord)] -> Parser [Line]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(Coord, Coord)]
coordPairListParser Parser [Line] -> String -> Parser [Line]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"list of lines"

moveParser :: Parser (Maybe Coord)
moveParser :: Parser (Maybe Coord)
moveParser =
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT String () Identity Char
-> Parser (Maybe Coord) -> Parser (Maybe Coord)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe Coord
forall a. Maybe a
Nothing Maybe Coord
-> ParsecT String () Identity Char -> Parser (Maybe Coord)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']' Parser (Maybe Coord)
-> Parser (Maybe Coord) -> Parser (Maybe Coord)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Coord -> Maybe Coord
forall a. a -> Maybe a
Just (Coord -> Maybe Coord) -> Parser Coord -> Parser (Maybe Coord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Coord
coord Parser (Maybe Coord)
-> ParsecT String () Identity Char -> Parser (Maybe Coord)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') Parser (Maybe Coord) -> String -> Parser (Maybe Coord)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>
  String
"move (point or pass)"

noneParser :: Parser ()
noneParser :: ParsecT String () Identity ()
noneParser = () () -> Parser String -> ParsecT String () Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"[]" ParsecT String () Identity ()
-> String -> ParsecT String () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"none"

-- This is what the SGF spec calls the Number type, i.e. a signed integer.
integralParser :: (Integral a, Read a) => Parser a
integralParser :: Parser a
integralParser = Parser a -> Parser a
forall a. Parser a -> Parser a
single Parser a
forall a. (Integral a, Read a) => Parser a
integral Parser a -> String -> Parser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"integer"

integral :: (Integral a, Read a) => Parser a
integral :: Parser a
integral = String -> a
forall a. Read a => String -> a
read (String -> a) -> Parser String -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
number

realParser :: Parser RealValue
realParser :: Parser RealValue
realParser = Parser RealValue -> Parser RealValue
forall a. Parser a -> Parser a
single Parser RealValue
real Parser RealValue -> String -> Parser RealValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"real"

real :: Parser RealValue
real :: Parser RealValue
real = do
  String
whole <- Parser String
number
  -- Try to read a fractional part of the number.
  -- If we fail, just return the whole part.
  RealValue -> Parser RealValue -> Parser RealValue
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Integer -> RealValue
forall a. Num a => Integer -> a
fromInteger (Integer -> RealValue) -> Integer -> RealValue
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read String
whole) (Parser RealValue -> Parser RealValue)
-> Parser RealValue -> Parser RealValue
forall a b. (a -> b) -> a -> b
$ Parser RealValue -> Parser RealValue
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser RealValue -> Parser RealValue)
-> Parser RealValue -> Parser RealValue
forall a b. (a -> b) -> a -> b
$ do
    String
fractional <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT String () Identity Char -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
    RealValue -> Parser RealValue
forall (m :: * -> *) a. Monad m => a -> m a
return (RealValue -> Parser RealValue) -> RealValue -> Parser RealValue
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> RealValue
BF.encode (String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ String
whole String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fractional) (-String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fractional)

rulesetParser :: Parser Ruleset
rulesetParser :: Parser Ruleset
rulesetParser =
  Parser Ruleset -> Parser Ruleset
forall a. Parser a -> Parser a
single (String -> Ruleset
toRuleset (String -> Ruleset)
-> (SimpleText -> String) -> SimpleText -> Ruleset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleText -> String
fromSimpleText (SimpleText -> Ruleset)
-> ParsecT String () Identity SimpleText -> Parser Ruleset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ParsecT String () Identity SimpleText
simpleText Bool
False) Parser Ruleset -> String -> Parser Ruleset
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"ruleset"

simpleTextPairParser :: Parser (SimpleText, SimpleText)
simpleTextPairParser :: Parser (SimpleText, SimpleText)
simpleTextPairParser = Parser (SimpleText, SimpleText) -> Parser (SimpleText, SimpleText)
forall a. Parser a -> Parser a
single (ParsecT String () Identity SimpleText
-> ParsecT String () Identity SimpleText
-> Parser (SimpleText, SimpleText)
forall a b. Parser a -> Parser b -> Parser (a, b)
compose ParsecT String () Identity SimpleText
composedText ParsecT String () Identity SimpleText
composedText) Parser (SimpleText, SimpleText)
-> String -> Parser (SimpleText, SimpleText)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"pair of simple texts"
  where composedText :: ParsecT String () Identity SimpleText
composedText = Bool -> ParsecT String () Identity SimpleText
simpleText Bool
True

-- | A parser for SGF SimpleText property values.
simpleTextParser :: Parser SimpleText
simpleTextParser :: ParsecT String () Identity SimpleText
simpleTextParser = ParsecT String () Identity SimpleText
-> ParsecT String () Identity SimpleText
forall a. Parser a -> Parser a
single (Bool -> ParsecT String () Identity SimpleText
simpleText Bool
False) ParsecT String () Identity SimpleText
-> String -> ParsecT String () Identity SimpleText
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"simple text"

simpleText :: Bool -> Parser SimpleText
simpleText :: Bool -> ParsecT String () Identity SimpleText
simpleText Bool
isComposed = String -> SimpleText
toSimpleText (String -> SimpleText)
-> Parser String -> ParsecT String () Identity SimpleText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser String
text Bool
isComposed

sizeParser :: Parser (Int, Int)
sizeParser :: Parser Coord
sizeParser =
  (do Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
      Int
width <- Parser Int
forall a. (Integral a, Read a) => Parser a
integral
      Int
height <- [Parser Int] -> Parser Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Int
width Int -> ParsecT String () Identity Char -> Parser Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']',
                        do Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
                           Int
height <- Parser Int
forall a. (Integral a, Read a) => Parser a
integral
                           Char
_ <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
                           -- TODO We should warn here rather than aborting.
                           Bool
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
width Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
height) (ParsecT String () Identity () -> ParsecT String () Identity ())
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$
                             String -> ParsecT String () Identity ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT String () Identity ())
-> String -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
width String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
height String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" square board " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                             String
" dimensions should be specified with a single number."
                           Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
height]
      Bool
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
boardSizeMax Bool -> Bool -> Bool
||
            Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
height Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
boardSizeMax) (ParsecT String () Identity () -> ParsecT String () Identity ())
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$
        String -> ParsecT String () Identity ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT String () Identity ())
-> String -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
width String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
height String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" board dimensions are invalid.  " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
"Each dimension must be between 1 and 52 inclusive."
      Coord -> Parser Coord
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
width, Int
height)) Parser Coord -> String -> Parser Coord
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>
  String
"board size (width or width:height)"

textParser :: Parser Text
textParser :: Parser Text
textParser = Parser Text -> Parser Text
forall a. Parser a -> Parser a
single (String -> Text
toText (String -> Text) -> Parser String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser String
text Bool
False) Parser Text -> String -> Parser Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"text"

-- | A parser for SGF text property values.  Its argument should be true if the
-- text is inside of a composed property value, so @\':\'@ should terminate the
-- value in addition to @']'@.
text :: Bool -> Parser String
text :: Bool -> Parser String
text Bool
isComposed = [Maybe Char] -> String
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Char] -> String)
-> ParsecT String () Identity [Maybe Char] -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity (Maybe Char)
-> ParsecT String () Identity [Maybe Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity (Maybe Char)
textChar'
  where textChar' :: ParsecT String () Identity (Maybe Char)
textChar' = String -> ParsecT String () Identity (Maybe Char)
textChar (if Bool
isComposed then String
":]\\" else String
"]\\")

textChar :: String -> Parser (Maybe Char)
textChar :: String -> ParsecT String () Identity (Maybe Char)
textChar String
specialChars =
  [ParsecT String () Identity (Maybe Char)]
-> ParsecT String () Identity (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n',
          Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' ' Maybe Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space,
          ParsecT String () Identity (Maybe Char)
-> ParsecT String () Identity (Maybe Char)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
-> ParsecT String () Identity (Maybe Char)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe Char
forall a. Maybe a
Nothing Maybe Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n' ParsecT String () Identity (Maybe Char)
-> ParsecT String () Identity (Maybe Char)
-> ParsecT String () Identity (Maybe Char)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                             Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)),
          Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
specialChars]

unknownPropertyParser :: Parser UnknownPropertyValue
unknownPropertyParser :: Parser UnknownPropertyValue
unknownPropertyParser =
  Parser UnknownPropertyValue -> Parser UnknownPropertyValue
forall a. Parser a -> Parser a
single (String -> UnknownPropertyValue
toUnknownPropertyValue (String -> UnknownPropertyValue)
-> Parser String -> Parser UnknownPropertyValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser String
text Bool
False) Parser UnknownPropertyValue
-> String -> Parser UnknownPropertyValue
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>
  String
"unknown property value"

variationModeParser :: Parser VariationMode
variationModeParser :: Parser VariationMode
variationModeParser = Parser VariationMode -> Parser VariationMode
forall a. Parser a -> Parser a
single Parser VariationMode
variationMode Parser VariationMode -> String -> Parser VariationMode
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"variation mode"

variationMode :: Parser VariationMode
variationMode :: Parser VariationMode
variationMode = do
  Int
value <- Parser Int
forall a. (Integral a, Read a) => Parser a
integral
  case Int -> Maybe VariationMode
toVariationMode Int
value of
    Just VariationMode
mode -> VariationMode -> Parser VariationMode
forall (m :: * -> *) a. Monad m => a -> m a
return VariationMode
mode
    Maybe VariationMode
Nothing -> String -> Parser VariationMode
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> Parser VariationMode) -> String -> Parser VariationMode
forall a b. (a -> b) -> a -> b
$ String
"variation mode " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
value