-- 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 #-}

-- | Constants and data types for property values used in SGF game trees.
module Game.Goatee.Lib.Types (
  -- * Constants
  supportedFormatVersions, defaultFormatVersion, supportedGameTypes,
  boardSizeDefault, boardSizeMin, boardSizeMax,
  -- * Board coordinates
  Coord, CoordList, coordListSingles, coordListRects, coord1, coords, coords',
  emptyCoordList, expandCoordList, buildCoordList,
  -- ** Star points and handicap stones
  starLines,
  isStarPoint,
  handicapStones,
  -- * Property values
  -- ** Text values
  Stringlike (..), convertStringlike,
  Text, fromText, toText,
  SimpleText, fromSimpleText, toSimpleText,
  -- ** Other values
  UnknownPropertyValue, fromUnknownPropertyValue, toUnknownPropertyValue,
  RealValue,
  DoubleValue (..),
  Color (..), cnot,
  VariationMode (..), VariationModeSource (..), defaultVariationMode,
  toVariationMode, fromVariationMode,
  ArrowList, LineList, Line (..), lineToPair, LabelList, Mark (..),
  GameResult (..),
  WinReason (..),
  Ruleset (..), RulesetType (..), fromRuleset, toRuleset,
  ) where

import Data.Char (isSpace)
import Data.Function (on)
import Data.List (delete, groupBy, partition, sort)
import Data.Maybe (fromMaybe)
import Game.Goatee.Common
import qualified Game.Goatee.Common.Bigfloat as BF

-- | The FF versions supported by Goatee.  Currently only 4.
supportedFormatVersions :: [Int]
supportedFormatVersions :: [Int]
supportedFormatVersions = [Int
4]
-- TODO Support FF versions 1-4.

-- | The default SGF version to use when @FF[]@ is not specified in a root node.
--
-- This value is actually INCORRECT: SGF defines it to be 1, but because we
-- don't support version 1 yet, for the sake of ignoring this issue (for now!)
-- in tests, we fix the default to be 4.
defaultFormatVersion :: Int
defaultFormatVersion :: Int
defaultFormatVersion = Int
4
-- TODO Fix the default version to be 1 as SGF mandates.

-- | SGF supports multiple game types.  This list contains the game types that
-- Goatee supports, which is only Go (1).
supportedGameTypes :: [Int]
supportedGameTypes :: [Int]
supportedGameTypes = [Int
1 {- Go -}]

-- | The default size of the board.  The FF[4] SGF spec says that the default Go
-- board is 19x19 square.
boardSizeDefault :: Int
boardSizeDefault :: Int
boardSizeDefault = Int
19

-- | The minimum board size allowed by FF[4], 1.
boardSizeMin :: Int
boardSizeMin :: Int
boardSizeMin = Int
1

-- | The maximum board size allowed by FF[4], 52.
boardSizeMax :: Int
boardSizeMax :: Int
boardSizeMax = Int
52

-- | A coordinate on a Go board.  @(0, 0)@ refers to the upper-left corner of
-- the board.  The first component is the horizontal position; the second
-- component is the vertical position.
type Coord = (Int, Int)

-- | A structure for compact representation of a list of coordinates.  Contains
-- a list of individual points, as well as a list of rectangles of points
-- denoted by an ordered pair of the upper-left point and the lower-right point.
-- The union of the single points and points contained within rectangles make up
-- all of the points a @CoordList@ represents.  There is no rule saying that
-- adjacent points have to be grouped into rectangles; it's perfectly valid
-- (although possibly inefficient) to never use rectangles.
--
-- For any @CoordList@, all of the following hold:
--
-- 1. Any point may be specified at most once, either in the singles list or in
-- a single rectangle.
--
-- 2. For a rectangle @((x0,y0), (x1,y1))@, @x0 <= x1@ and @y0 <= y1@ and
-- @(x0,y0) /= (x1,y1)@ (otherwise the point belongs in the singles list).
data CoordList = CoordList
  { CoordList -> [Coord]
coordListSingles :: [Coord]
  -- ^ Returns the single points in a 'CoordList'.
  , CoordList -> [(Coord, Coord)]
coordListRects :: [(Coord, Coord)]
    -- ^ Returns the rectangles in a 'CoordList'.
  } deriving (Int -> CoordList -> ShowS
[CoordList] -> ShowS
CoordList -> String
(Int -> CoordList -> ShowS)
-> (CoordList -> String)
-> ([CoordList] -> ShowS)
-> Show CoordList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoordList] -> ShowS
$cshowList :: [CoordList] -> ShowS
show :: CoordList -> String
$cshow :: CoordList -> String
showsPrec :: Int -> CoordList -> ShowS
$cshowsPrec :: Int -> CoordList -> ShowS
Show)

-- | Equality is based on unordered, set equality of the underlying points.
instance Eq CoordList where
  == :: CoordList -> CoordList -> Bool
(==) = [Coord] -> [Coord] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Coord] -> [Coord] -> Bool)
-> (CoordList -> [Coord]) -> CoordList -> CoordList -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [Coord] -> [Coord]
forall a. Ord a => [a] -> [a]
sort ([Coord] -> [Coord])
-> (CoordList -> [Coord]) -> CoordList -> [Coord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoordList -> [Coord]
expandCoordList

-- | Constructs a 'CoordList' containing a single point.
coord1 :: Coord -> CoordList
coord1 :: Coord -> CoordList
coord1 Coord
xy = CoordList :: [Coord] -> [(Coord, Coord)] -> CoordList
CoordList { coordListSingles :: [Coord]
coordListSingles = [Coord
xy]
                      , coordListRects :: [(Coord, Coord)]
coordListRects = []
                      }

-- | Constructs a 'CoordList' containing the given single points.  For rectangle
-- detection, use 'buildCoordList'.
coords :: [Coord] -> CoordList
coords :: [Coord] -> CoordList
coords [Coord]
singles = CoordList :: [Coord] -> [(Coord, Coord)] -> CoordList
CoordList { coordListSingles :: [Coord]
coordListSingles = [Coord]
singles
                           , coordListRects :: [(Coord, Coord)]
coordListRects = []
                           }

-- | Constructs a 'CoordList' containing the given single points and rectangles.
coords' :: [Coord] -> [(Coord, Coord)] -> CoordList
coords' :: [Coord] -> [(Coord, Coord)] -> CoordList
coords' [Coord]
singles [(Coord, Coord)]
rects = CoordList :: [Coord] -> [(Coord, Coord)] -> CoordList
CoordList { coordListSingles :: [Coord]
coordListSingles = [Coord]
singles
                                  , coordListRects :: [(Coord, Coord)]
coordListRects = [(Coord, Coord)]
rects
                                  }

-- | A 'CoordList' that contains no points.
emptyCoordList :: CoordList
emptyCoordList :: CoordList
emptyCoordList = CoordList :: [Coord] -> [(Coord, Coord)] -> CoordList
CoordList { coordListSingles :: [Coord]
coordListSingles = []
                           , coordListRects :: [(Coord, Coord)]
coordListRects = []
                           }

-- | Converts a compact 'CoordList' to a list of coordinates.
expandCoordList :: CoordList -> [Coord]
expandCoordList :: CoordList -> [Coord]
expandCoordList CoordList
cl = CoordList -> [Coord]
coordListSingles CoordList
cl [Coord] -> [Coord] -> [Coord]
forall a. [a] -> [a] -> [a]
++
                     ((Coord, Coord) -> [Coord] -> [Coord])
-> [Coord] -> [(Coord, Coord)] -> [Coord]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\r :: (Coord, Coord)
r@((Int
x0, Int
y0), (Int
x1, Int
y1)) [Coord]
rest ->
                             if Int
x0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x1 Bool -> Bool -> Bool
|| Int
y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y1
                             then String -> [Coord]
forall a. HasCallStack => String -> a
error (String
"Invalid coord. rectangle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Coord, Coord) -> String
forall a. Show a => a -> String
show (Coord, Coord)
r)
                             else [(Int
x, Int
y) | Int
x <- [Int
x0..Int
x1], Int
y <- [Int
y0..Int
y1]] [Coord] -> [Coord] -> [Coord]
forall a. [a] -> [a] -> [a]
++ [Coord]
rest)
                           []
                           (CoordList -> [(Coord, Coord)]
coordListRects CoordList
cl)

-- | Constructs a 'CoordList' from a list of 'Coord's, doing some
-- not-completely-stupid rectangle detection.  The order of data in the result
-- is unspecified.
buildCoordList :: [Coord] -> CoordList
-- This algorithm doesn't generate the smallest result.  For the following
-- input:
--
-- F F T T
-- T T T T
-- T T F F
--
-- It will return [ca:da][ab:db][ac:bc] rather than the shorter [ca:db][ab:bc].
buildCoordList :: [Coord] -> CoordList
buildCoordList = [(Coord, Coord)] -> CoordList
toCoordList ([(Coord, Coord)] -> CoordList)
-> ([Coord] -> [(Coord, Coord)]) -> [Coord] -> CoordList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Coord, Coord)] -> [[Coord]] -> [(Coord, Coord)]
generateRects Int
0 [] ([[Coord]] -> [(Coord, Coord)])
-> ([Coord] -> [[Coord]]) -> [Coord] -> [(Coord, Coord)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Bool]] -> [[Coord]]
buildTruePairs ([[Bool]] -> [[Coord]])
-> ([Coord] -> [[Bool]]) -> [Coord] -> [[Coord]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coord] -> [[Bool]]
toGrid
  where -- | Constructs a row-major grid of booleans where an coordinate is true
        -- iff it is in the given list.
        toGrid :: [Coord] -> [[Bool]]
        toGrid :: [Coord] -> [[Bool]]
toGrid [] = []
        toGrid [Coord]
coords = let x1 :: Int
x1 = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Coord -> Int) -> [Coord] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Coord -> Int
forall a b. (a, b) -> a
fst [Coord]
coords
                            y1 :: Int
y1 = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Coord -> Int) -> [Coord] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Coord -> Int
forall a b. (a, b) -> b
snd [Coord]
coords
                        in [[(Int
x,Int
y) Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Coord]
coords | Int
x <- [Int
0..Int
x1]] | Int
y <- [Int
0..Int
y1]]

        -- | For each row, converts a list of booleans into a list of pairs
        -- where each pair represents a consecutive run of true values.  The
        -- pair indicates the indices of the first and last boolean in each run.
        buildTruePairs :: [[Bool]] -> [[(Int, Int)]]
        buildTruePairs :: [[Bool]] -> [[Coord]]
buildTruePairs = ([Bool] -> [Coord]) -> [[Bool]] -> [[Coord]]
forall a b. (a -> b) -> [a] -> [b]
map (([Bool] -> [Coord]) -> [[Bool]] -> [[Coord]])
-> ([Bool] -> [Coord]) -> [[Bool]] -> [[Coord]]
forall a b. (a -> b) -> a -> b
$
                         ([(Int, Bool)] -> [Coord]) -> [[(Int, Bool)]] -> [Coord]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [(Int, Bool)] -> [Coord]
extractTrueGroups ([[(Int, Bool)]] -> [Coord])
-> ([Bool] -> [[(Int, Bool)]]) -> [Bool] -> [Coord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         ((Int, Bool) -> (Int, Bool) -> Bool)
-> [(Int, Bool)] -> [[(Int, Bool)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Bool -> Bool -> Bool)
-> ((Int, Bool) -> Bool) -> (Int, Bool) -> (Int, Bool) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd) ([(Int, Bool)] -> [[(Int, Bool)]])
-> ([Bool] -> [(Int, Bool)]) -> [Bool] -> [[(Int, Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         [Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]

        -- | Given a run of indexed booleans with the same boolean value within
        -- a row, returns @[(startIndex, endIndex)]@ if the value is true, and
        -- @[]@ if the value is false.
        extractTrueGroups :: [(Int, Bool)] -> [(Int, Int)]
        extractTrueGroups :: [(Int, Bool)] -> [Coord]
extractTrueGroups list :: [(Int, Bool)]
list@((Int
start, Bool
True):[(Int, Bool)]
_) = [(Int
start, (Int, Bool) -> Int
forall a b. (a, b) -> a
fst ([(Int, Bool)] -> (Int, Bool)
forall a. [a] -> a
last [(Int, Bool)]
list))]
        extractTrueGroups [(Int, Bool)]
_ = []

        -- | Converts the lists of true pairs for all rows into a list of
        -- @(Coord, Coord)@ rectangles.  We repeatedly grab the first span in
        -- the first row, and see how many leading rows contain that exact span.
        -- Then we build a (maybe multi-row) rectangle for the span, remove the
        -- span from all leading rows, and repeat.  When the first row becomes
        -- empty, we drop it and increment a counter that keeps track of our
        -- first row's y-position.
        generateRects :: Int -> [(Coord, Coord)] -> [[(Int, Int)]] -> [(Coord, Coord)]
        generateRects :: Int -> [(Coord, Coord)] -> [[Coord]] -> [(Coord, Coord)]
generateRects Int
_ [(Coord, Coord)]
acc [] = [(Coord, Coord)]
acc
        generateRects Int
topRowOffset [(Coord, Coord)]
acc ([]:[[Coord]]
rows) = Int -> [(Coord, Coord)] -> [[Coord]] -> [(Coord, Coord)]
generateRects (Int
topRowOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(Coord, Coord)]
acc [[Coord]]
rows
        generateRects Int
topRowOffset [(Coord, Coord)]
acc rows :: [[Coord]]
rows@((Coord
span:[Coord]
_):[[Coord]]
_) =
          let rowsWithSpan :: [[Coord]]
rowsWithSpan = Coord -> [[Coord]] -> [[Coord]]
matchRowsWithSpan Coord
span [[Coord]]
rows
              rowsWithSpanCount :: Int
rowsWithSpanCount = [[Coord]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Coord]]
rowsWithSpan
          in Int -> [(Coord, Coord)] -> [[Coord]] -> [(Coord, Coord)]
generateRects Int
topRowOffset
                           (((Coord -> Int
forall a b. (a, b) -> a
fst Coord
span, Int
topRowOffset),
                             (Coord -> Int
forall a b. (a, b) -> b
snd Coord
span, Int
topRowOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rowsWithSpanCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Coord, Coord) -> [(Coord, Coord)] -> [(Coord, Coord)]
forall a. a -> [a] -> [a]
: [(Coord, Coord)]
acc)
                           ([[Coord]]
rowsWithSpan [[Coord]] -> [[Coord]] -> [[Coord]]
forall a. [a] -> [a] -> [a]
++ Int -> [[Coord]] -> [[Coord]]
forall a. Int -> [a] -> [a]
drop Int
rowsWithSpanCount [[Coord]]
rows)

        -- | Determines how many leading rows contain the given span.  A list of
        -- all the matching rows is returned, with the span deleted from each.
        matchRowsWithSpan :: (Int, Int) -> [[(Int, Int)]] -> [[(Int, Int)]]
        matchRowsWithSpan :: Coord -> [[Coord]] -> [[Coord]]
matchRowsWithSpan Coord
span ([Coord]
row:[[Coord]]
rows)
          | Coord
span Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Coord]
row = Coord -> [Coord] -> [Coord]
forall a. Eq a => a -> [a] -> [a]
delete Coord
span [Coord]
row [Coord] -> [[Coord]] -> [[Coord]]
forall a. a -> [a] -> [a]
: Coord -> [[Coord]] -> [[Coord]]
matchRowsWithSpan Coord
span [[Coord]]
rows
          | Bool
otherwise = []
        matchRowsWithSpan Coord
_ [] = []

        -- | Builds a 'CoordList' from simple @(Coord, Coord)@ rectangles.
        toCoordList :: [(Coord, Coord)] -> CoordList
        toCoordList :: [(Coord, Coord)] -> CoordList
toCoordList [(Coord, Coord)]
rects =
          let ([(Coord, Coord)]
singles, [(Coord, Coord)]
properRects) = ((Coord, Coord) -> Bool)
-> [(Coord, Coord)] -> ([(Coord, Coord)], [(Coord, Coord)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Coord -> Coord -> Bool) -> (Coord, Coord) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
(==)) [(Coord, Coord)]
rects
          in [Coord] -> [(Coord, Coord)] -> CoordList
coords' (((Coord, Coord) -> Coord) -> [(Coord, Coord)] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map (Coord, Coord) -> Coord
forall a b. (a, b) -> a
fst [(Coord, Coord)]
singles) [(Coord, Coord)]
properRects

-- | @starLines width height@ returns 'Just' a list of row/column indices that
-- have star points on a board of the given size, or 'Nothing' if the board size
-- does not have star points defined.
starLines :: Int -> Int -> Maybe [Int]
starLines :: Int -> Int -> Maybe [Int]
starLines Int
19 Int
19 = [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int
3, Int
9, Int
15]
starLines Int
13 Int
13 = [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int
3, Int
6, Int
9]
starLines Int
9 Int
9 = [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int
2, Int
4, Int
6]
starLines Int
_ Int
_ = Maybe [Int]
forall a. Maybe a
Nothing

-- | @isStarPoint width height x y@ determines whether @(x, y)@ is a known star
-- point on a board of the given width and height.
isStarPoint :: Int -> Int -> Int -> Int -> Bool
isStarPoint :: Int -> Int -> Int -> Int -> Bool
isStarPoint Int
width Int
height Int
x Int
y =
  Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> ([Int] -> Bool) -> [Int] -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
x ([Int] -> Bool -> Bool) -> ([Int] -> Bool) -> [Int] -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
y) ([Int] -> Bool) -> Maybe [Int] -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Maybe [Int]
starLines Int
width Int
height

-- | @handicapStoneIndices !! k@ the positions of the handicap stones for @k@
-- handicap stones, betweeen 0 and 9.  In the pairs, 0 indicates the first star
-- point along an axis, 1 indicates the second, and 2 indicates the third, in
-- the normal 'Coord' ordering.
handicapStoneIndices :: [[(Int, Int)]]
handicapStoneIndices :: [[Coord]]
handicapStoneIndices =
  [ []
  , []  -- No single handicap stone for Black; black goes first instead.
  , [(Int
2,Int
0), (Int
0,Int
2)]
  , (Int
2,Int
2) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: [[Coord]]
handicapStoneIndices [[Coord]] -> Int -> [Coord]
forall a. [a] -> Int -> a
!! Int
2
  , (Int
0,Int
0) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: [[Coord]]
handicapStoneIndices [[Coord]] -> Int -> [Coord]
forall a. [a] -> Int -> a
!! Int
3
  , (Int
1,Int
1) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: [[Coord]]
handicapStoneIndices [[Coord]] -> Int -> [Coord]
forall a. [a] -> Int -> a
!! Int
4
  , (Int
0,Int
1) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: (Int
2,Int
1) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: [[Coord]]
handicapStoneIndices [[Coord]] -> Int -> [Coord]
forall a. [a] -> Int -> a
!! Int
4
  , (Int
1,Int
1) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: [[Coord]]
handicapStoneIndices [[Coord]] -> Int -> [Coord]
forall a. [a] -> Int -> a
!! Int
6
  , (Int
1,Int
0) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: (Int
1,Int
2) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: [[Coord]]
handicapStoneIndices [[Coord]] -> Int -> [Coord]
forall a. [a] -> Int -> a
!! Int
6
  , (Int
1,Int
1) Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: [[Coord]]
handicapStoneIndices [[Coord]] -> Int -> [Coord]
forall a. [a] -> Int -> a
!! Int
8
  ]

-- | @handicapStones width height handicap@ returns a list of points where
-- handicap stones should be placed for the given handicap, if handicap points
-- are defined for the given board size, otherwise 'Nothing'.
handicapStones :: Int -> Int -> Int -> Maybe [Coord]
handicapStones :: Int -> Int -> Int -> Maybe [Coord]
handicapStones Int
width Int
height Int
handicap =
  if Int
handicap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
handicap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [[Coord]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Coord]]
handicapStoneIndices
  then Maybe [Coord]
forall a. Maybe a
Nothing
  else do [Int]
positions <- Int -> Int -> Maybe [Int]
starLines Int
width Int
height
          [Coord] -> Maybe [Coord]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Coord] -> Maybe [Coord]) -> [Coord] -> Maybe [Coord]
forall a b. (a -> b) -> a -> b
$ (Coord -> Coord) -> [Coord] -> [Coord]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int) -> Coord -> Coord
forall a b. (a -> b) -> (a, a) -> (b, b)
mapTuple ([Int]
positions [Int] -> Int -> Int
forall a. [a] -> Int -> a
!!)) ([[Coord]]
handicapStoneIndices [[Coord]] -> Int -> [Coord]
forall a. [a] -> Int -> a
!! Int
handicap)

-- | A class for SGF data types that are coercable to and from strings.
--
-- The construction of an SGF value with 'stringToSgf' may process the input,
-- such that the resulting stringlike value does not represent the same string
-- as the input.  In other words, the following does *not* necessarily hold:
--
-- > sgfToString . stringToSgf = id   (does not necessarily hold!)
--
-- The following does hold, however, for a single stringlike type:
--
-- > stringToSgf . sgfToString = id
--
-- The 'String' instance is defined with @sgfToString = stringToSgf =
-- id@.  For other types, the string returned by 'sgfToString' is in a
-- raw, user-editable format: characters that need to be escaped in
-- serialized SGF aren't escaped, but the returned value is otherwise
-- similar to SGF format.
class Stringlike a where
  -- | Extracts the string value from an SGF value.
  sgfToString :: a -> String

  -- | Creates an SGF value from a string value.
  stringToSgf :: String -> a

instance Stringlike String where
  sgfToString :: ShowS
sgfToString = ShowS
forall a. a -> a
id
  stringToSgf :: ShowS
stringToSgf = ShowS
forall a. a -> a
id

-- | Converts between 'Stringlike' types via a string.
--
-- > convertStringlike = stringToSgf . sgfToString
convertStringlike :: (Stringlike a, Stringlike b) => a -> b
convertStringlike :: a -> b
convertStringlike = String -> b
forall a. Stringlike a => String -> a
stringToSgf (String -> b) -> (a -> String) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Stringlike a => a -> String
sgfToString

-- | An SGF text value.
newtype Text = Text
  { Text -> String
fromText :: String
    -- ^ Converts an SGF 'Text' to a string.
  } deriving (Text -> Text -> Bool
(Text -> Text -> Bool) -> (Text -> Text -> Bool) -> Eq Text
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Text -> Text -> Bool
$c/= :: Text -> Text -> Bool
== :: Text -> Text -> Bool
$c== :: Text -> Text -> Bool
Eq, Int -> Text -> ShowS
[Text] -> ShowS
Text -> String
(Int -> Text -> ShowS)
-> (Text -> String) -> ([Text] -> ShowS) -> Show Text
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Text] -> ShowS
$cshowList :: [Text] -> ShowS
show :: Text -> String
$cshow :: Text -> String
showsPrec :: Int -> Text -> ShowS
$cshowsPrec :: Int -> Text -> ShowS
Show)

instance Stringlike Text where
  sgfToString :: Text -> String
sgfToString = Text -> String
fromText
  stringToSgf :: String -> Text
stringToSgf = String -> Text
toText

-- | Converts a string to an SGF 'Text'.
toText :: String -> Text
toText :: String -> Text
toText = String -> Text
Text

-- | An SGF SimpleText value.
newtype SimpleText = SimpleText
  { SimpleText -> String
fromSimpleText :: String
    -- ^ Converts an SGF 'SimpleText' to a string.
  } deriving (SimpleText -> SimpleText -> Bool
(SimpleText -> SimpleText -> Bool)
-> (SimpleText -> SimpleText -> Bool) -> Eq SimpleText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleText -> SimpleText -> Bool
$c/= :: SimpleText -> SimpleText -> Bool
== :: SimpleText -> SimpleText -> Bool
$c== :: SimpleText -> SimpleText -> Bool
Eq, Int -> SimpleText -> ShowS
[SimpleText] -> ShowS
SimpleText -> String
(Int -> SimpleText -> ShowS)
-> (SimpleText -> String)
-> ([SimpleText] -> ShowS)
-> Show SimpleText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleText] -> ShowS
$cshowList :: [SimpleText] -> ShowS
show :: SimpleText -> String
$cshow :: SimpleText -> String
showsPrec :: Int -> SimpleText -> ShowS
$cshowsPrec :: Int -> SimpleText -> ShowS
Show)

instance Stringlike SimpleText where
  sgfToString :: SimpleText -> String
sgfToString = SimpleText -> String
fromSimpleText
  stringToSgf :: String -> SimpleText
stringToSgf = String -> SimpleText
toSimpleText

sanitizeSimpleText :: String -> String
sanitizeSimpleText :: ShowS
sanitizeSimpleText = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char -> Bool
isSpace Char
c then Char
' ' else Char
c)

-- | Converts a string to an SGF 'SimpleText', replacing all whitespaces
-- (including newlines) with spaces.
toSimpleText :: String -> SimpleText
toSimpleText :: String -> SimpleText
toSimpleText = String -> SimpleText
SimpleText (String -> SimpleText) -> ShowS -> String -> SimpleText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sanitizeSimpleText

-- | The value type for an 'UnknownProperty'.  Currently represented as a
-- string.
data UnknownPropertyValue = UnknownPropertyValue
  { UnknownPropertyValue -> String
fromUnknownPropertyValue :: String
    -- ^ Returns the string contained within the 'UnknownProperty' this value is
    -- from.
  } deriving (UnknownPropertyValue -> UnknownPropertyValue -> Bool
(UnknownPropertyValue -> UnknownPropertyValue -> Bool)
-> (UnknownPropertyValue -> UnknownPropertyValue -> Bool)
-> Eq UnknownPropertyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnknownPropertyValue -> UnknownPropertyValue -> Bool
$c/= :: UnknownPropertyValue -> UnknownPropertyValue -> Bool
== :: UnknownPropertyValue -> UnknownPropertyValue -> Bool
$c== :: UnknownPropertyValue -> UnknownPropertyValue -> Bool
Eq, Int -> UnknownPropertyValue -> ShowS
[UnknownPropertyValue] -> ShowS
UnknownPropertyValue -> String
(Int -> UnknownPropertyValue -> ShowS)
-> (UnknownPropertyValue -> String)
-> ([UnknownPropertyValue] -> ShowS)
-> Show UnknownPropertyValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnknownPropertyValue] -> ShowS
$cshowList :: [UnknownPropertyValue] -> ShowS
show :: UnknownPropertyValue -> String
$cshow :: UnknownPropertyValue -> String
showsPrec :: Int -> UnknownPropertyValue -> ShowS
$cshowsPrec :: Int -> UnknownPropertyValue -> ShowS
Show)

instance Stringlike UnknownPropertyValue where
  sgfToString :: UnknownPropertyValue -> String
sgfToString = UnknownPropertyValue -> String
fromUnknownPropertyValue
  stringToSgf :: String -> UnknownPropertyValue
stringToSgf = String -> UnknownPropertyValue
toUnknownPropertyValue

-- | Constructs a value for a 'UnknownProperty'.
toUnknownPropertyValue :: String -> UnknownPropertyValue
toUnknownPropertyValue :: String -> UnknownPropertyValue
toUnknownPropertyValue = String -> UnknownPropertyValue
UnknownPropertyValue

-- | An SGF real value is a decimal number of unspecified precision.
type RealValue = BF.Bigfloat

-- | An SGF double value: either 1 or 2, nothing else.
data DoubleValue = Double1
                 | Double2
                 deriving (DoubleValue
DoubleValue -> DoubleValue -> Bounded DoubleValue
forall a. a -> a -> Bounded a
maxBound :: DoubleValue
$cmaxBound :: DoubleValue
minBound :: DoubleValue
$cminBound :: DoubleValue
Bounded, Int -> DoubleValue
DoubleValue -> Int
DoubleValue -> [DoubleValue]
DoubleValue -> DoubleValue
DoubleValue -> DoubleValue -> [DoubleValue]
DoubleValue -> DoubleValue -> DoubleValue -> [DoubleValue]
(DoubleValue -> DoubleValue)
-> (DoubleValue -> DoubleValue)
-> (Int -> DoubleValue)
-> (DoubleValue -> Int)
-> (DoubleValue -> [DoubleValue])
-> (DoubleValue -> DoubleValue -> [DoubleValue])
-> (DoubleValue -> DoubleValue -> [DoubleValue])
-> (DoubleValue -> DoubleValue -> DoubleValue -> [DoubleValue])
-> Enum DoubleValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DoubleValue -> DoubleValue -> DoubleValue -> [DoubleValue]
$cenumFromThenTo :: DoubleValue -> DoubleValue -> DoubleValue -> [DoubleValue]
enumFromTo :: DoubleValue -> DoubleValue -> [DoubleValue]
$cenumFromTo :: DoubleValue -> DoubleValue -> [DoubleValue]
enumFromThen :: DoubleValue -> DoubleValue -> [DoubleValue]
$cenumFromThen :: DoubleValue -> DoubleValue -> [DoubleValue]
enumFrom :: DoubleValue -> [DoubleValue]
$cenumFrom :: DoubleValue -> [DoubleValue]
fromEnum :: DoubleValue -> Int
$cfromEnum :: DoubleValue -> Int
toEnum :: Int -> DoubleValue
$ctoEnum :: Int -> DoubleValue
pred :: DoubleValue -> DoubleValue
$cpred :: DoubleValue -> DoubleValue
succ :: DoubleValue -> DoubleValue
$csucc :: DoubleValue -> DoubleValue
Enum, DoubleValue -> DoubleValue -> Bool
(DoubleValue -> DoubleValue -> Bool)
-> (DoubleValue -> DoubleValue -> Bool) -> Eq DoubleValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DoubleValue -> DoubleValue -> Bool
$c/= :: DoubleValue -> DoubleValue -> Bool
== :: DoubleValue -> DoubleValue -> Bool
$c== :: DoubleValue -> DoubleValue -> Bool
Eq, Eq DoubleValue
Eq DoubleValue
-> (DoubleValue -> DoubleValue -> Ordering)
-> (DoubleValue -> DoubleValue -> Bool)
-> (DoubleValue -> DoubleValue -> Bool)
-> (DoubleValue -> DoubleValue -> Bool)
-> (DoubleValue -> DoubleValue -> Bool)
-> (DoubleValue -> DoubleValue -> DoubleValue)
-> (DoubleValue -> DoubleValue -> DoubleValue)
-> Ord DoubleValue
DoubleValue -> DoubleValue -> Bool
DoubleValue -> DoubleValue -> Ordering
DoubleValue -> DoubleValue -> DoubleValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DoubleValue -> DoubleValue -> DoubleValue
$cmin :: DoubleValue -> DoubleValue -> DoubleValue
max :: DoubleValue -> DoubleValue -> DoubleValue
$cmax :: DoubleValue -> DoubleValue -> DoubleValue
>= :: DoubleValue -> DoubleValue -> Bool
$c>= :: DoubleValue -> DoubleValue -> Bool
> :: DoubleValue -> DoubleValue -> Bool
$c> :: DoubleValue -> DoubleValue -> Bool
<= :: DoubleValue -> DoubleValue -> Bool
$c<= :: DoubleValue -> DoubleValue -> Bool
< :: DoubleValue -> DoubleValue -> Bool
$c< :: DoubleValue -> DoubleValue -> Bool
compare :: DoubleValue -> DoubleValue -> Ordering
$ccompare :: DoubleValue -> DoubleValue -> Ordering
$cp1Ord :: Eq DoubleValue
Ord, Int -> DoubleValue -> ShowS
[DoubleValue] -> ShowS
DoubleValue -> String
(Int -> DoubleValue -> ShowS)
-> (DoubleValue -> String)
-> ([DoubleValue] -> ShowS)
-> Show DoubleValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DoubleValue] -> ShowS
$cshowList :: [DoubleValue] -> ShowS
show :: DoubleValue -> String
$cshow :: DoubleValue -> String
showsPrec :: Int -> DoubleValue -> ShowS
$cshowsPrec :: Int -> DoubleValue -> ShowS
Show)

-- | Stone color: black or white.
data Color = Black
           | White
           deriving (Color
Color -> Color -> Bounded Color
forall a. a -> a -> Bounded a
maxBound :: Color
$cmaxBound :: Color
minBound :: Color
$cminBound :: Color
Bounded, Int -> Color
Color -> Int
Color -> [Color]
Color -> Color
Color -> Color -> [Color]
Color -> Color -> Color -> [Color]
(Color -> Color)
-> (Color -> Color)
-> (Int -> Color)
-> (Color -> Int)
-> (Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> [Color])
-> (Color -> Color -> Color -> [Color])
-> Enum Color
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Color -> Color -> Color -> [Color]
$cenumFromThenTo :: Color -> Color -> Color -> [Color]
enumFromTo :: Color -> Color -> [Color]
$cenumFromTo :: Color -> Color -> [Color]
enumFromThen :: Color -> Color -> [Color]
$cenumFromThen :: Color -> Color -> [Color]
enumFrom :: Color -> [Color]
$cenumFrom :: Color -> [Color]
fromEnum :: Color -> Int
$cfromEnum :: Color -> Int
toEnum :: Int -> Color
$ctoEnum :: Int -> Color
pred :: Color -> Color
$cpred :: Color -> Color
succ :: Color -> Color
$csucc :: Color -> Color
Enum, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show)

-- | Returns the logical negation of a stone color, yang for yin and
-- yin for yang.
cnot :: Color -> Color
cnot :: Color -> Color
cnot Color
Black = Color
White
cnot Color
White = Color
Black

-- | SGF flags that control how move variations are to be presented while
-- displaying the game.
data VariationMode = VariationMode
  { VariationMode -> VariationModeSource
variationModeSource :: VariationModeSource
    -- ^ Which moves to display as variations.
  , VariationMode -> Bool
variationModeBoardMarkup :: Bool
    -- ^ Whether to overlay variations on the board.
  } deriving (VariationMode -> VariationMode -> Bool
(VariationMode -> VariationMode -> Bool)
-> (VariationMode -> VariationMode -> Bool) -> Eq VariationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariationMode -> VariationMode -> Bool
$c/= :: VariationMode -> VariationMode -> Bool
== :: VariationMode -> VariationMode -> Bool
$c== :: VariationMode -> VariationMode -> Bool
Eq, Int -> VariationMode -> ShowS
[VariationMode] -> ShowS
VariationMode -> String
(Int -> VariationMode -> ShowS)
-> (VariationMode -> String)
-> ([VariationMode] -> ShowS)
-> Show VariationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariationMode] -> ShowS
$cshowList :: [VariationMode] -> ShowS
show :: VariationMode -> String
$cshow :: VariationMode -> String
showsPrec :: Int -> VariationMode -> ShowS
$cshowsPrec :: Int -> VariationMode -> ShowS
Show)

-- | An enumeration that describes which variations are shown.
data VariationModeSource =
  ShowChildVariations
  -- ^ Show children of the current move.
  | ShowCurrentVariations
    -- ^ Show alternatives to the current move.
  deriving (VariationModeSource
VariationModeSource
-> VariationModeSource -> Bounded VariationModeSource
forall a. a -> a -> Bounded a
maxBound :: VariationModeSource
$cmaxBound :: VariationModeSource
minBound :: VariationModeSource
$cminBound :: VariationModeSource
Bounded, Int -> VariationModeSource
VariationModeSource -> Int
VariationModeSource -> [VariationModeSource]
VariationModeSource -> VariationModeSource
VariationModeSource -> VariationModeSource -> [VariationModeSource]
VariationModeSource
-> VariationModeSource
-> VariationModeSource
-> [VariationModeSource]
(VariationModeSource -> VariationModeSource)
-> (VariationModeSource -> VariationModeSource)
-> (Int -> VariationModeSource)
-> (VariationModeSource -> Int)
-> (VariationModeSource -> [VariationModeSource])
-> (VariationModeSource
    -> VariationModeSource -> [VariationModeSource])
-> (VariationModeSource
    -> VariationModeSource -> [VariationModeSource])
-> (VariationModeSource
    -> VariationModeSource
    -> VariationModeSource
    -> [VariationModeSource])
-> Enum VariationModeSource
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VariationModeSource
-> VariationModeSource
-> VariationModeSource
-> [VariationModeSource]
$cenumFromThenTo :: VariationModeSource
-> VariationModeSource
-> VariationModeSource
-> [VariationModeSource]
enumFromTo :: VariationModeSource -> VariationModeSource -> [VariationModeSource]
$cenumFromTo :: VariationModeSource -> VariationModeSource -> [VariationModeSource]
enumFromThen :: VariationModeSource -> VariationModeSource -> [VariationModeSource]
$cenumFromThen :: VariationModeSource -> VariationModeSource -> [VariationModeSource]
enumFrom :: VariationModeSource -> [VariationModeSource]
$cenumFrom :: VariationModeSource -> [VariationModeSource]
fromEnum :: VariationModeSource -> Int
$cfromEnum :: VariationModeSource -> Int
toEnum :: Int -> VariationModeSource
$ctoEnum :: Int -> VariationModeSource
pred :: VariationModeSource -> VariationModeSource
$cpred :: VariationModeSource -> VariationModeSource
succ :: VariationModeSource -> VariationModeSource
$csucc :: VariationModeSource -> VariationModeSource
Enum, VariationModeSource -> VariationModeSource -> Bool
(VariationModeSource -> VariationModeSource -> Bool)
-> (VariationModeSource -> VariationModeSource -> Bool)
-> Eq VariationModeSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariationModeSource -> VariationModeSource -> Bool
$c/= :: VariationModeSource -> VariationModeSource -> Bool
== :: VariationModeSource -> VariationModeSource -> Bool
$c== :: VariationModeSource -> VariationModeSource -> Bool
Eq, Eq VariationModeSource
Eq VariationModeSource
-> (VariationModeSource -> VariationModeSource -> Ordering)
-> (VariationModeSource -> VariationModeSource -> Bool)
-> (VariationModeSource -> VariationModeSource -> Bool)
-> (VariationModeSource -> VariationModeSource -> Bool)
-> (VariationModeSource -> VariationModeSource -> Bool)
-> (VariationModeSource
    -> VariationModeSource -> VariationModeSource)
-> (VariationModeSource
    -> VariationModeSource -> VariationModeSource)
-> Ord VariationModeSource
VariationModeSource -> VariationModeSource -> Bool
VariationModeSource -> VariationModeSource -> Ordering
VariationModeSource -> VariationModeSource -> VariationModeSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VariationModeSource -> VariationModeSource -> VariationModeSource
$cmin :: VariationModeSource -> VariationModeSource -> VariationModeSource
max :: VariationModeSource -> VariationModeSource -> VariationModeSource
$cmax :: VariationModeSource -> VariationModeSource -> VariationModeSource
>= :: VariationModeSource -> VariationModeSource -> Bool
$c>= :: VariationModeSource -> VariationModeSource -> Bool
> :: VariationModeSource -> VariationModeSource -> Bool
$c> :: VariationModeSource -> VariationModeSource -> Bool
<= :: VariationModeSource -> VariationModeSource -> Bool
$c<= :: VariationModeSource -> VariationModeSource -> Bool
< :: VariationModeSource -> VariationModeSource -> Bool
$c< :: VariationModeSource -> VariationModeSource -> Bool
compare :: VariationModeSource -> VariationModeSource -> Ordering
$ccompare :: VariationModeSource -> VariationModeSource -> Ordering
$cp1Ord :: Eq VariationModeSource
Ord, Int -> VariationModeSource -> ShowS
[VariationModeSource] -> ShowS
VariationModeSource -> String
(Int -> VariationModeSource -> ShowS)
-> (VariationModeSource -> String)
-> ([VariationModeSource] -> ShowS)
-> Show VariationModeSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariationModeSource] -> ShowS
$cshowList :: [VariationModeSource] -> ShowS
show :: VariationModeSource -> String
$cshow :: VariationModeSource -> String
showsPrec :: Int -> VariationModeSource -> ShowS
$cshowsPrec :: Int -> VariationModeSource -> ShowS
Show)

-- | The default variation mode as defined by the SGF spec is @VariationMode
-- ShowChildVariations True@.
defaultVariationMode :: VariationMode
defaultVariationMode :: VariationMode
defaultVariationMode = VariationModeSource -> Bool -> VariationMode
VariationMode VariationModeSource
ShowChildVariations Bool
True

-- | Parses a numeric variation mode, returning nothing if the number is
-- invalid.
toVariationMode :: Int -> Maybe VariationMode
toVariationMode :: Int -> Maybe VariationMode
toVariationMode Int
n = case Int
n of
  Int
0 -> VariationMode -> Maybe VariationMode
forall a. a -> Maybe a
Just (VariationMode -> Maybe VariationMode)
-> VariationMode -> Maybe VariationMode
forall a b. (a -> b) -> a -> b
$ VariationModeSource -> Bool -> VariationMode
VariationMode VariationModeSource
ShowChildVariations Bool
True
  Int
1 -> VariationMode -> Maybe VariationMode
forall a. a -> Maybe a
Just (VariationMode -> Maybe VariationMode)
-> VariationMode -> Maybe VariationMode
forall a b. (a -> b) -> a -> b
$ VariationModeSource -> Bool -> VariationMode
VariationMode VariationModeSource
ShowCurrentVariations Bool
True
  Int
2 -> VariationMode -> Maybe VariationMode
forall a. a -> Maybe a
Just (VariationMode -> Maybe VariationMode)
-> VariationMode -> Maybe VariationMode
forall a b. (a -> b) -> a -> b
$ VariationModeSource -> Bool -> VariationMode
VariationMode VariationModeSource
ShowChildVariations Bool
False
  Int
3 -> VariationMode -> Maybe VariationMode
forall a. a -> Maybe a
Just (VariationMode -> Maybe VariationMode)
-> VariationMode -> Maybe VariationMode
forall a b. (a -> b) -> a -> b
$ VariationModeSource -> Bool -> VariationMode
VariationMode VariationModeSource
ShowCurrentVariations Bool
False
  Int
_ -> Maybe VariationMode
forall a. Maybe a
Nothing

-- | Returns the integer value for a variation mode.
fromVariationMode :: VariationMode -> Int
fromVariationMode :: VariationMode -> Int
fromVariationMode VariationMode
mode = case VariationMode
mode of
  VariationMode VariationModeSource
ShowChildVariations Bool
True -> Int
0
  VariationMode VariationModeSource
ShowCurrentVariations Bool
True -> Int
1
  VariationMode VariationModeSource
ShowChildVariations Bool
False -> Int
2
  VariationMode VariationModeSource
ShowCurrentVariations Bool
False -> Int
3

-- | A list of arrows, each specified as @(startCoord, endCoord)@.
type ArrowList = [(Coord, Coord)]

-- | A list of lines, each specified as @(startCoord, endCoord)@.
type LineList = [Line]

-- | An undirected line between two coordinates.
data Line = Line Coord Coord
          deriving (Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

instance Eq Line where
  (Line Coord
a Coord
b) == :: Line -> Line -> Bool
== (Line Coord
c Coord
d) = Coord
a Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
c Bool -> Bool -> Bool
&& Coord
b Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
d Bool -> Bool -> Bool
|| Coord
a Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
d Bool -> Bool -> Bool
&& Coord
b Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
c

-- | Converts a 'Line' to a pair of 'Coord's representing the line's endpoints.
lineToPair :: Line -> (Coord, Coord)
lineToPair :: Line -> (Coord, Coord)
lineToPair (Line Coord
a Coord
b) = (Coord
a, Coord
b)

-- | A list of labels, each specified with a string and a coordinate about which
-- to center the string.
type LabelList = [(Coord, SimpleText)]

-- | The markings that SGF supports annotating coordinates with.
data Mark = MarkCircle | MarkSquare | MarkTriangle | MarkX | MarkSelected
          deriving (Mark
Mark -> Mark -> Bounded Mark
forall a. a -> a -> Bounded a
maxBound :: Mark
$cmaxBound :: Mark
minBound :: Mark
$cminBound :: Mark
Bounded, Int -> Mark
Mark -> Int
Mark -> [Mark]
Mark -> Mark
Mark -> Mark -> [Mark]
Mark -> Mark -> Mark -> [Mark]
(Mark -> Mark)
-> (Mark -> Mark)
-> (Int -> Mark)
-> (Mark -> Int)
-> (Mark -> [Mark])
-> (Mark -> Mark -> [Mark])
-> (Mark -> Mark -> [Mark])
-> (Mark -> Mark -> Mark -> [Mark])
-> Enum Mark
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mark -> Mark -> Mark -> [Mark]
$cenumFromThenTo :: Mark -> Mark -> Mark -> [Mark]
enumFromTo :: Mark -> Mark -> [Mark]
$cenumFromTo :: Mark -> Mark -> [Mark]
enumFromThen :: Mark -> Mark -> [Mark]
$cenumFromThen :: Mark -> Mark -> [Mark]
enumFrom :: Mark -> [Mark]
$cenumFrom :: Mark -> [Mark]
fromEnum :: Mark -> Int
$cfromEnum :: Mark -> Int
toEnum :: Int -> Mark
$ctoEnum :: Int -> Mark
pred :: Mark -> Mark
$cpred :: Mark -> Mark
succ :: Mark -> Mark
$csucc :: Mark -> Mark
Enum, Mark -> Mark -> Bool
(Mark -> Mark -> Bool) -> (Mark -> Mark -> Bool) -> Eq Mark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mark -> Mark -> Bool
$c/= :: Mark -> Mark -> Bool
== :: Mark -> Mark -> Bool
$c== :: Mark -> Mark -> Bool
Eq, Eq Mark
Eq Mark
-> (Mark -> Mark -> Ordering)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Bool)
-> (Mark -> Mark -> Mark)
-> (Mark -> Mark -> Mark)
-> Ord Mark
Mark -> Mark -> Bool
Mark -> Mark -> Ordering
Mark -> Mark -> Mark
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mark -> Mark -> Mark
$cmin :: Mark -> Mark -> Mark
max :: Mark -> Mark -> Mark
$cmax :: Mark -> Mark -> Mark
>= :: Mark -> Mark -> Bool
$c>= :: Mark -> Mark -> Bool
> :: Mark -> Mark -> Bool
$c> :: Mark -> Mark -> Bool
<= :: Mark -> Mark -> Bool
$c<= :: Mark -> Mark -> Bool
< :: Mark -> Mark -> Bool
$c< :: Mark -> Mark -> Bool
compare :: Mark -> Mark -> Ordering
$ccompare :: Mark -> Mark -> Ordering
$cp1Ord :: Eq Mark
Ord, Int -> Mark -> ShowS
[Mark] -> ShowS
Mark -> String
(Int -> Mark -> ShowS)
-> (Mark -> String) -> ([Mark] -> ShowS) -> Show Mark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mark] -> ShowS
$cshowList :: [Mark] -> ShowS
show :: Mark -> String
$cshow :: Mark -> String
showsPrec :: Int -> Mark -> ShowS
$cshowsPrec :: Int -> Mark -> ShowS
Show)

data GameResult = GameResultWin Color WinReason
                | GameResultDraw
                | GameResultVoid
                | GameResultUnknown
                | GameResultOther SimpleText
                deriving (GameResult -> GameResult -> Bool
(GameResult -> GameResult -> Bool)
-> (GameResult -> GameResult -> Bool) -> Eq GameResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GameResult -> GameResult -> Bool
$c/= :: GameResult -> GameResult -> Bool
== :: GameResult -> GameResult -> Bool
$c== :: GameResult -> GameResult -> Bool
Eq, Int -> GameResult -> ShowS
[GameResult] -> ShowS
GameResult -> String
(Int -> GameResult -> ShowS)
-> (GameResult -> String)
-> ([GameResult] -> ShowS)
-> Show GameResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GameResult] -> ShowS
$cshowList :: [GameResult] -> ShowS
show :: GameResult -> String
$cshow :: GameResult -> String
showsPrec :: Int -> GameResult -> ShowS
$cshowsPrec :: Int -> GameResult -> ShowS
Show)

instance Stringlike GameResult where
  sgfToString :: GameResult -> String
sgfToString GameResult
result = case GameResult
result of
    GameResultWin Color
color WinReason
reason ->
      (case Color
color of { Color
Black -> Char
'B'; Color
White -> Char
'W' }) Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
:
      (case WinReason
reason of
          WinByScore RealValue
diff -> RealValue -> String
forall a. Show a => a -> String
show RealValue
diff
          WinReason
WinByResignation -> String
"R"
          WinReason
WinByTime -> String
"T"
          WinReason
WinByForfeit -> String
"F")
    GameResult
GameResultDraw -> String
"0"
    GameResult
GameResultVoid -> String
"Void"
    GameResult
GameResultUnknown -> String
"?"
    GameResultOther SimpleText
text -> SimpleText -> String
forall a. Stringlike a => a -> String
sgfToString SimpleText
text

  stringToSgf :: String -> GameResult
stringToSgf String
str = case String
str of
    String
"0" -> GameResult
GameResultDraw
    String
"Draw" -> GameResult
GameResultDraw
    String
"Void" -> GameResult
GameResultVoid
    String
"?" -> GameResult
GameResultUnknown
    String
_ ->
      let result :: GameResult
result = case String
str of
            Char
'B':Char
'+':String
winReasonStr -> (WinReason -> GameResult) -> String -> GameResult
parseWin (Color -> WinReason -> GameResult
GameResultWin Color
Black) String
winReasonStr
            Char
'W':Char
'+':String
winReasonStr -> (WinReason -> GameResult) -> String -> GameResult
parseWin (Color -> WinReason -> GameResult
GameResultWin Color
White) String
winReasonStr
            String
_ -> GameResult
unknownResult
          parseWin :: (WinReason -> GameResult) -> String -> GameResult
parseWin WinReason -> GameResult
builder String
winReasonStr = case String
winReasonStr of
            String
"R" -> WinReason -> GameResult
builder WinReason
WinByResignation
            String
"Resign" -> WinReason -> GameResult
builder WinReason
WinByResignation
            String
"T" -> WinReason -> GameResult
builder WinReason
WinByTime
            String
"Time" -> WinReason -> GameResult
builder WinReason
WinByTime
            String
"F" -> WinReason -> GameResult
builder WinReason
WinByForfeit
            String
"Forfeit" -> WinReason -> GameResult
builder WinReason
WinByForfeit
            String
_ -> case ReadS RealValue
forall a. Read a => ReadS a
reads String
winReasonStr of
              (RealValue
score, String
""):[(RealValue, String)]
_ -> WinReason -> GameResult
builder (WinReason -> GameResult) -> WinReason -> GameResult
forall a b. (a -> b) -> a -> b
$ RealValue -> WinReason
WinByScore RealValue
score
              [(RealValue, String)]
_ -> GameResult
unknownResult
          unknownResult :: GameResult
unknownResult = SimpleText -> GameResult
GameResultOther (SimpleText -> GameResult) -> SimpleText -> GameResult
forall a b. (a -> b) -> a -> b
$ String -> SimpleText
toSimpleText String
str
      in GameResult
result

data WinReason = WinByScore RealValue
               | WinByResignation
               | WinByTime
               | WinByForfeit
               deriving (WinReason -> WinReason -> Bool
(WinReason -> WinReason -> Bool)
-> (WinReason -> WinReason -> Bool) -> Eq WinReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WinReason -> WinReason -> Bool
$c/= :: WinReason -> WinReason -> Bool
== :: WinReason -> WinReason -> Bool
$c== :: WinReason -> WinReason -> Bool
Eq, Int -> WinReason -> ShowS
[WinReason] -> ShowS
WinReason -> String
(Int -> WinReason -> ShowS)
-> (WinReason -> String)
-> ([WinReason] -> ShowS)
-> Show WinReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WinReason] -> ShowS
$cshowList :: [WinReason] -> ShowS
show :: WinReason -> String
$cshow :: WinReason -> String
showsPrec :: Int -> WinReason -> ShowS
$cshowsPrec :: Int -> WinReason -> ShowS
Show)

-- | A ruleset used for a Go game.  Can be one of the rulesets defined by the
-- SGF specification, or a custom string.
data Ruleset = KnownRuleset RulesetType
             | UnknownRuleset String
             deriving (Ruleset -> Ruleset -> Bool
(Ruleset -> Ruleset -> Bool)
-> (Ruleset -> Ruleset -> Bool) -> Eq Ruleset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ruleset -> Ruleset -> Bool
$c/= :: Ruleset -> Ruleset -> Bool
== :: Ruleset -> Ruleset -> Bool
$c== :: Ruleset -> Ruleset -> Bool
Eq, Int -> Ruleset -> ShowS
[Ruleset] -> ShowS
Ruleset -> String
(Int -> Ruleset -> ShowS)
-> (Ruleset -> String) -> ([Ruleset] -> ShowS) -> Show Ruleset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ruleset] -> ShowS
$cshowList :: [Ruleset] -> ShowS
show :: Ruleset -> String
$cshow :: Ruleset -> String
showsPrec :: Int -> Ruleset -> ShowS
$cshowsPrec :: Int -> Ruleset -> ShowS
Show)

instance Stringlike Ruleset where
  sgfToString :: Ruleset -> String
sgfToString = Ruleset -> String
fromRuleset
  stringToSgf :: String -> Ruleset
stringToSgf = String -> Ruleset
toRuleset

-- | The rulesets defined by the SGF specification, for use with 'Ruleset'.
data RulesetType = RulesetAga
                 | RulesetIng
                 | RulesetJapanese
                 | RulesetNewZealand
                 deriving (RulesetType
RulesetType -> RulesetType -> Bounded RulesetType
forall a. a -> a -> Bounded a
maxBound :: RulesetType
$cmaxBound :: RulesetType
minBound :: RulesetType
$cminBound :: RulesetType
Bounded, Int -> RulesetType
RulesetType -> Int
RulesetType -> [RulesetType]
RulesetType -> RulesetType
RulesetType -> RulesetType -> [RulesetType]
RulesetType -> RulesetType -> RulesetType -> [RulesetType]
(RulesetType -> RulesetType)
-> (RulesetType -> RulesetType)
-> (Int -> RulesetType)
-> (RulesetType -> Int)
-> (RulesetType -> [RulesetType])
-> (RulesetType -> RulesetType -> [RulesetType])
-> (RulesetType -> RulesetType -> [RulesetType])
-> (RulesetType -> RulesetType -> RulesetType -> [RulesetType])
-> Enum RulesetType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RulesetType -> RulesetType -> RulesetType -> [RulesetType]
$cenumFromThenTo :: RulesetType -> RulesetType -> RulesetType -> [RulesetType]
enumFromTo :: RulesetType -> RulesetType -> [RulesetType]
$cenumFromTo :: RulesetType -> RulesetType -> [RulesetType]
enumFromThen :: RulesetType -> RulesetType -> [RulesetType]
$cenumFromThen :: RulesetType -> RulesetType -> [RulesetType]
enumFrom :: RulesetType -> [RulesetType]
$cenumFrom :: RulesetType -> [RulesetType]
fromEnum :: RulesetType -> Int
$cfromEnum :: RulesetType -> Int
toEnum :: Int -> RulesetType
$ctoEnum :: Int -> RulesetType
pred :: RulesetType -> RulesetType
$cpred :: RulesetType -> RulesetType
succ :: RulesetType -> RulesetType
$csucc :: RulesetType -> RulesetType
Enum, RulesetType -> RulesetType -> Bool
(RulesetType -> RulesetType -> Bool)
-> (RulesetType -> RulesetType -> Bool) -> Eq RulesetType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RulesetType -> RulesetType -> Bool
$c/= :: RulesetType -> RulesetType -> Bool
== :: RulesetType -> RulesetType -> Bool
$c== :: RulesetType -> RulesetType -> Bool
Eq, Eq RulesetType
Eq RulesetType
-> (RulesetType -> RulesetType -> Ordering)
-> (RulesetType -> RulesetType -> Bool)
-> (RulesetType -> RulesetType -> Bool)
-> (RulesetType -> RulesetType -> Bool)
-> (RulesetType -> RulesetType -> Bool)
-> (RulesetType -> RulesetType -> RulesetType)
-> (RulesetType -> RulesetType -> RulesetType)
-> Ord RulesetType
RulesetType -> RulesetType -> Bool
RulesetType -> RulesetType -> Ordering
RulesetType -> RulesetType -> RulesetType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RulesetType -> RulesetType -> RulesetType
$cmin :: RulesetType -> RulesetType -> RulesetType
max :: RulesetType -> RulesetType -> RulesetType
$cmax :: RulesetType -> RulesetType -> RulesetType
>= :: RulesetType -> RulesetType -> Bool
$c>= :: RulesetType -> RulesetType -> Bool
> :: RulesetType -> RulesetType -> Bool
$c> :: RulesetType -> RulesetType -> Bool
<= :: RulesetType -> RulesetType -> Bool
$c<= :: RulesetType -> RulesetType -> Bool
< :: RulesetType -> RulesetType -> Bool
$c< :: RulesetType -> RulesetType -> Bool
compare :: RulesetType -> RulesetType -> Ordering
$ccompare :: RulesetType -> RulesetType -> Ordering
$cp1Ord :: Eq RulesetType
Ord, Int -> RulesetType -> ShowS
[RulesetType] -> ShowS
RulesetType -> String
(Int -> RulesetType -> ShowS)
-> (RulesetType -> String)
-> ([RulesetType] -> ShowS)
-> Show RulesetType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RulesetType] -> ShowS
$cshowList :: [RulesetType] -> ShowS
show :: RulesetType -> String
$cshow :: RulesetType -> String
showsPrec :: Int -> RulesetType -> ShowS
$cshowsPrec :: Int -> RulesetType -> ShowS
Show)

-- | Returns the string representation for a ruleset.
fromRuleset :: Ruleset -> String
fromRuleset :: Ruleset -> String
fromRuleset Ruleset
ruleset = case Ruleset
ruleset of
  KnownRuleset RulesetType
RulesetAga -> String
"AGA"
  KnownRuleset RulesetType
RulesetIng -> String
"Goe"
  KnownRuleset RulesetType
RulesetJapanese -> String
"Japanese"
  KnownRuleset RulesetType
RulesetNewZealand -> String
"NZ"
  UnknownRuleset String
str -> String
str

-- | Parses a string representation of a ruleset.
toRuleset :: String -> Ruleset
toRuleset :: String -> Ruleset
toRuleset String
str = case String
str of
  String
"AGA" -> RulesetType -> Ruleset
KnownRuleset RulesetType
RulesetAga
  String
"Goe" -> RulesetType -> Ruleset
KnownRuleset RulesetType
RulesetIng
  String
"Japanese" -> RulesetType -> Ruleset
KnownRuleset RulesetType
RulesetJapanese
  String
"NZ" -> RulesetType -> Ruleset
KnownRuleset RulesetType
RulesetNewZealand
  String
_ -> String -> Ruleset
UnknownRuleset String
str