{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- TODO: check that every occurrence of "die" should really be a death, and not just a "fix-it-up-and-warn"
-- boilerplate {{{
-- TODO: check that every occurrence of "die" should really be a death, and not just a "fix-it-up-and-warn"
-- boilerplate {{{
module Data.SGF.Parse
    ( collection
    , clipDate
    , PropertyType(..)
    , properties
    , extraProperties
    , Property(..)
    , Warning(..)
    , ErrorType(..)
    , Error(..)
    ) where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.Fail
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Data.Bits
import Data.Char
import Data.Encoding
import Data.Function
import Data.List
import Data.List.Split
import qualified Data.Map as Map
import Data.Maybe
import Data.Ord
import Data.SGF.Parse.Encodings
import Data.SGF.Parse.Raw hiding (collection)
import qualified Data.SGF.Parse.Raw as Raw
import Data.SGF.Parse.Util
import Data.SGF.Types (Game(Game), GameNode(GameNode))
import Data.SGF.Types hiding
    ( Game(..)
    , GameInfo(..)
    , GameNode(..)
    , Move(..)
    , Setup(..)
    )
import qualified Data.SGF.Types as T
import qualified Data.Set as Set
import Data.Time.Calendar
import Data.Tree
import Data.Word
import Prelude hiding (round)
import Text.Parsec hiding (newline)
import Text.Parsec.Pos (newPos)

instance MonadFail (Either Error) where
    fail :: String -> Either Error a
    fail :: forall a. String -> Either Error a
fail String
msg = Error -> Either Error a
forall a b. a -> Either a b
Left (Maybe String -> Error
UnknownError (String -> Maybe String
forall a. a -> Maybe a
Just String
msg))

translate :: WriterT b (StateT s (Either Error)) a -> s -> ParsecT s u m (a, b)
translate WriterT b (StateT s (Either Error)) a
trans s
state =
    case StateT s (Either Error) (a, b) -> s -> Either Error ((a, b), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (WriterT b (StateT s (Either Error)) a
-> StateT s (Either Error) (a, b)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT b (StateT s (Either Error)) a
trans) s
state of
        Left (UnknownError Maybe String
Nothing) -> String -> ParsecT s u m (a, b)
forall a. String -> ParsecT s u m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""
        Left (UnknownError (Just String
e)) -> String -> ParsecT s u m (a, b)
forall a. String -> ParsecT s u m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
        Left Error
e -> SourcePos -> ParsecT s u m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (Error -> SourcePos
errorPosition Error
e) ParsecT s u m () -> ParsecT s u m (a, b) -> ParsecT s u m (a, b)
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT s u m (a, b)
forall a. String -> ParsecT s u m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Error -> String
forall a. Show a => a -> String
show Error
e)
        Right ((a
a, b
warnings), s
_) -> (a, b) -> ParsecT s u m (a, b)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
warnings)

-- TODO: delete "test"
test :: [a] -> Either ParseError (Collection, [Warning])
test = Parsec [Word8] () (Collection, [Warning])
-> ()
-> String
-> [Word8]
-> Either ParseError (Collection, [Warning])
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec [Word8] () (Collection, [Warning])
forall s (m :: * -> *) u.
Stream s m Word8 =>
ParsecT s u m (Collection, [Warning])
collection () String
"<interactive>" ([Word8] -> Either ParseError (Collection, [Warning]))
-> ([a] -> [Word8])
-> [a]
-> Either ParseError (Collection, [Warning])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Word8) -> [a] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map a -> Word8
forall a b. (Enum a, Enum b) => a -> b
enum

-- |
-- Parse a 'Word8' stream into an SGF collection.  A collection is a list of
-- games; the documentation for 'Game' has more details.  There are generally
-- two kinds of errors in SGF files: recoverable ones (which will be
-- accumulated in the ['Warning'] return) and unrecoverable ones (which will
-- result in parse errors).
collection :: Stream s m Word8 => ParsecT s u m (Collection, [Warning])
collection :: forall s (m :: * -> *) u.
Stream s m Word8 =>
ParsecT s u m (Collection, [Warning])
collection =
    ([[Warning]] -> [Warning])
-> (Collection, [[Warning]]) -> (Collection, [Warning])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [[Warning]] -> [Warning]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Collection, [[Warning]]) -> (Collection, [Warning]))
-> ([(Game, [Warning])] -> (Collection, [[Warning]]))
-> [(Game, [Warning])]
-> (Collection, [Warning])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Game, [Warning])] -> (Collection, [[Warning]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Game, [Warning])] -> (Collection, [Warning]))
-> ParsecT s u m [(Game, [Warning])]
-> ParsecT s u m (Collection, [Warning])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((State -> ParsecT s u m (Game, [Warning]))
-> [State] -> ParsecT s u m [(Game, [Warning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterT [Warning] (StateT State (Either Error)) Game
-> State -> ParsecT s u m (Game, [Warning])
forall {m :: * -> *} {b} {s} {a} {s} {u}.
Monad m =>
WriterT b (StateT s (Either Error)) a -> s -> ParsecT s u m (a, b)
translate WriterT [Warning] (StateT State (Either Error)) Game
gameTree) ([State] -> ParsecT s u m [(Game, [Warning])])
-> ParsecT s u m [State] -> ParsecT s u m [(Game, [Warning])]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT s u m [State]
forall s (m :: * -> *) u. Stream s m Word8 => ParsecT s u m [State]
Raw.collection)

gameTree :: WriterT [Warning] (StateT State (Either Error)) Game
gameTree = do
    Header
hea <- WriterT [Warning] (StateT State (Either Error)) Header
parseHeader
    Maybe (String, String)
app <- Header -> Translator (Maybe (String, String))
application Header
hea
    GameType
gam <- WriterT [Warning] (StateT State (Either Error)) GameType
forall {b}.
Enum b =>
WriterT [Warning] (StateT State (Either Error)) b
gameType
    Maybe (VariationType, Bool)
var <- Translator (Maybe (VariationType, Bool))
variationType
    Maybe (Integer, Integer)
siz <- GameType
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (Integer, Integer))
size GameType
gam
    (GameTree -> Game)
-> WriterT [Warning] (StateT State (Either Error)) GameTree
-> WriterT [Warning] (StateT State (Either Error)) Game
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (String, String)
-> Maybe (VariationType, Bool)
-> Maybe (Integer, Integer)
-> GameTree
-> Game
Game Maybe (String, String)
app Maybe (VariationType, Bool)
var Maybe (Integer, Integer)
siz) (Header
-> GameType
-> Maybe (Integer, Integer)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) GameTree
parse Header
hea GameType
gam Maybe (Integer, Integer)
siz Bool
False)
  where
    parse :: Header
-> GameType
-> Maybe (Integer, Integer)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) GameTree
parse Header
h GameType
g Maybe (Integer, Integer)
s =
        case GameType
g of
            GameType
Go -> (TreeGo -> GameTree)
-> WriterT [Warning] (StateT State (Either Error)) TreeGo
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeGo -> GameTree
TreeGo (WriterT [Warning] (StateT State (Either Error)) TreeGo
 -> WriterT [Warning] (StateT State (Either Error)) GameTree)
-> (Bool -> WriterT [Warning] (StateT State (Either Error)) TreeGo)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header
-> Maybe (Integer, Integer)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) TreeGo
nodeGo Header
h Maybe (Integer, Integer)
s
            GameType
Backgammon -> (TreeBackgammon -> GameTree)
-> WriterT [Warning] (StateT State (Either Error)) TreeBackgammon
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeBackgammon -> GameTree
TreeBackgammon (WriterT [Warning] (StateT State (Either Error)) TreeBackgammon
 -> WriterT [Warning] (StateT State (Either Error)) GameTree)
-> (Bool
    -> WriterT [Warning] (StateT State (Either Error)) TreeBackgammon)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) TreeBackgammon
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeBackgammon Header
h
            GameType
LinesOfAction -> (TreeLinesOfAction -> GameTree)
-> WriterT
     [Warning] (StateT State (Either Error)) TreeLinesOfAction
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeLinesOfAction -> GameTree
TreeLinesOfAction (WriterT [Warning] (StateT State (Either Error)) TreeLinesOfAction
 -> WriterT [Warning] (StateT State (Either Error)) GameTree)
-> (Bool
    -> WriterT
         [Warning] (StateT State (Either Error)) TreeLinesOfAction)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header
-> Bool
-> WriterT
     [Warning] (StateT State (Either Error)) TreeLinesOfAction
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeLinesOfAction Header
h
            GameType
Hex -> Header
-> Bool -> WriterT [Warning] (StateT State (Either Error)) GameTree
forall {f :: * -> *} {p} {p}. Monad f => p -> p -> f GameTree
gameHex Header
h
            GameType
Octi -> (TreeOcti -> GameTree)
-> WriterT [Warning] (StateT State (Either Error)) TreeOcti
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeOcti -> GameTree
TreeOcti (WriterT [Warning] (StateT State (Either Error)) TreeOcti
 -> WriterT [Warning] (StateT State (Either Error)) GameTree)
-> (Bool
    -> WriterT [Warning] (StateT State (Either Error)) TreeOcti)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header
-> Bool -> WriterT [Warning] (StateT State (Either Error)) TreeOcti
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeOcti Header
h
            GameType
other -> (TreeOther -> GameTree)
-> WriterT [Warning] (StateT State (Either Error)) TreeOther
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GameType -> TreeOther -> GameTree
TreeOther GameType
other) (WriterT [Warning] (StateT State (Either Error)) TreeOther
 -> WriterT [Warning] (StateT State (Either Error)) GameTree)
-> (Bool
    -> WriterT [Warning] (StateT State (Either Error)) TreeOther)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) GameTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) TreeOther
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeOther Header
h

-- }}}
warnAll :: (Property -> Warning)
-> t String -> WriterT [Warning] (StateT State (Either Error)) ()
warnAll Property -> Warning
w t String
ps =
    (String -> WriterT [Warning] (StateT State (Either Error)) ())
-> t String -> WriterT [Warning] (StateT State (Either Error)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
p -> WriterT [Warning] (StateT State (Either Error)) ()
-> (Property -> WriterT [Warning] (StateT State (Either Error)) ())
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> WriterT [Warning] (StateT State (Either Error)) ()
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ([Warning] -> WriterT [Warning] (StateT State (Either Error)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Warning] -> WriterT [Warning] (StateT State (Either Error)) ())
-> (Property -> [Warning])
-> Property
-> WriterT [Warning] (StateT State (Either Error)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Warning -> [Warning] -> [Warning]
forall a. a -> [a] -> [a]
: []) (Warning -> [Warning])
-> (Property -> Warning) -> Property -> [Warning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Warning
w) (Maybe Property
 -> WriterT [Warning] (StateT State (Either Error)) ())
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Property)
-> WriterT [Warning] (StateT State (Either Error)) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Property)
consume String
p) t String
ps

dieEarliest :: ErrorType
-> [String] -> WriterT [Warning] (StateT State (Either Error)) b
dieEarliest ErrorType
e [String]
ps =
    ErrorType
-> Property -> WriterT [Warning] (StateT State (Either Error)) b
forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
e (Property -> WriterT [Warning] (StateT State (Either Error)) b)
-> ([Maybe Property] -> Property)
-> [Maybe Property]
-> WriterT [Warning] (StateT State (Either Error)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Property] -> Property
forall a. HasCallStack => [a] -> a
head ([Property] -> Property)
-> ([Maybe Property] -> [Property]) -> [Maybe Property] -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Property -> Property -> Ordering) -> [Property] -> [Property]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Property -> SourcePos) -> Property -> Property -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Property -> SourcePos
position) ([Property] -> [Property])
-> ([Maybe Property] -> [Property])
-> [Maybe Property]
-> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Property] -> [Property]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Property]
 -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) [Maybe Property]
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    (String
 -> WriterT
      [Warning] (StateT State (Either Error)) (Maybe Property))
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Maybe Property]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Property)
consume [String]
ps

-- game header information {{{
getFormat :: WriterT [Warning] (StateT State (Either Error)) Integer
getFormat = do
    Maybe Property
prop <- String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Property)
consumeSingle String
"FF"
    Integer
ff <- WriterT [Warning] (StateT State (Either Error)) Integer
-> (Property
    -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer -> WriterT [Warning] (StateT State (Either Error)) Integer
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1) Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number Maybe Property
prop
    Bool
-> WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        (Integer
ff Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
4)
        (ErrorType
-> SourcePos -> WriterT [Warning] (StateT State (Either Error)) ()
forall a. ErrorType -> SourcePos -> Translator a
dieWithPos
             ErrorType
FormatUnsupported
             (SourcePos -> (Property -> SourcePos) -> Maybe Property -> SourcePos
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Int -> Int -> SourcePos
newPos String
"FF_missing" Int
1 Int
1) Property -> SourcePos
position Maybe Property
prop))
    Integer -> WriterT [Warning] (StateT State (Either Error)) Integer
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
ff

getEncoding :: WriterT [Warning] (StateT State (Either Error)) DynEncoding
getEncoding = do
    Maybe Property
ws <- String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Property)
consumeSingle String
"CA"
    case [DynEncoding]
-> (Property -> [DynEncoding]) -> Maybe Property -> [DynEncoding]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String -> DynEncoding
encodingFromString String
"latin1"] ([Word8] -> [DynEncoding]
guessEncoding ([Word8] -> [DynEncoding])
-> (Property -> [Word8]) -> Property -> [DynEncoding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word8]] -> [Word8]
forall a. HasCallStack => [a] -> a
head ([[Word8]] -> [Word8])
-> (Property -> [[Word8]]) -> Property -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> [[Word8]]
values) Maybe Property
ws of
        [DynEncoding
encoding] -> DynEncoding
-> WriterT [Warning] (StateT State (Either Error)) DynEncoding
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return DynEncoding
encoding
        [] -> ErrorType
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) DynEncoding
forall a. ErrorType -> Maybe Property -> Translator a
dieWithJust ErrorType
UnknownEncoding Maybe Property
ws
        [DynEncoding]
_ -> ErrorType
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) DynEncoding
forall a. ErrorType -> Maybe Property -> Translator a
dieWithJust ErrorType
AmbiguousEncoding Maybe Property
ws -- pretty much guaranteed not to happen

parseHeader :: WriterT [Warning] (StateT State (Either Error)) Header
parseHeader = (Integer -> DynEncoding -> Header)
-> WriterT [Warning] (StateT State (Either Error)) Integer
-> WriterT [Warning] (StateT State (Either Error)) DynEncoding
-> WriterT [Warning] (StateT State (Either Error)) Header
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Integer -> DynEncoding -> Header
Header WriterT [Warning] (StateT State (Either Error)) Integer
getFormat WriterT [Warning] (StateT State (Either Error)) DynEncoding
getEncoding

application :: Header -> Translator (Maybe (String, String))
application = (PTranslator (String, String)
 -> String -> Translator (Maybe (String, String)))
-> String
-> PTranslator (String, String)
-> Translator (Maybe (String, String))
forall a b c. (a -> b -> c) -> b -> a -> c
flip PTranslator (String, String)
-> String -> Translator (Maybe (String, String))
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap String
"AP" (PTranslator (String, String)
 -> Translator (Maybe (String, String)))
-> (Header -> PTranslator (String, String))
-> Header
-> Translator (Maybe (String, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PTranslator String
 -> PTranslator String -> PTranslator (String, String))
-> PTranslator String -> PTranslator (String, String)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join PTranslator String
-> PTranslator String -> PTranslator (String, String)
forall a b. PTranslator a -> PTranslator b -> PTranslator (a, b)
compose (PTranslator String -> PTranslator (String, String))
-> (Header -> PTranslator String)
-> Header
-> PTranslator (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> PTranslator String
simple

gameType :: WriterT [Warning] (StateT State (Either Error)) b
gameType = do
    Maybe Property
property <- String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Property)
consumeSingle String
"GM"
    Integer
gameType <- WriterT [Warning] (StateT State (Either Error)) Integer
-> (Property
    -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer -> WriterT [Warning] (StateT State (Either Error)) Integer
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1) Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number Maybe Property
property
    if GameType -> Integer
forall a b. (Enum a, Enum b) => a -> b
enum (GameType
forall a. Bounded a => a
minBound :: GameType) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
gameType Bool -> Bool -> Bool
&&
       Integer
gameType Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= GameType -> Integer
forall a b. (Enum a, Enum b) => a -> b
enum (GameType
forall a. Bounded a => a
maxBound :: GameType)
        then b -> WriterT [Warning] (StateT State (Either Error)) b
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> b
forall a b. (Enum a, Enum b) => a -> b
enum Integer
gameType)
        else ErrorType
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) b
forall a. ErrorType -> Maybe Property -> Translator a
dieWithJust ErrorType
OutOfBounds Maybe Property
property

variationType :: Translator (Maybe (VariationType, Bool))
variationType = PTranslator (VariationType, Bool)
-> String -> Translator (Maybe (VariationType, Bool))
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap (\Property
p -> Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number Property
p WriterT [Warning] (StateT State (Either Error)) Integer
-> (Integer
    -> WriterT
         [Warning] (StateT State (Either Error)) (VariationType, Bool))
-> WriterT
     [Warning] (StateT State (Either Error)) (VariationType, Bool)
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Property
-> Integer
-> WriterT
     [Warning] (StateT State (Either Error)) (VariationType, Bool)
forall {a}.
(Eq a, Num a) =>
Property
-> a
-> WriterT
     [Warning] (StateT State (Either Error)) (VariationType, Bool)
variationType' Property
p) String
"ST"
  where
    variationType' :: Property
-> a
-> WriterT
     [Warning] (StateT State (Either Error)) (VariationType, Bool)
variationType' Property
property a
0 = (VariationType, Bool)
-> WriterT
     [Warning] (StateT State (Either Error)) (VariationType, Bool)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (VariationType
T.Children, Bool
True)
    variationType' Property
property a
1 = (VariationType, Bool)
-> WriterT
     [Warning] (StateT State (Either Error)) (VariationType, Bool)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (VariationType
T.Siblings, Bool
True)
    variationType' Property
property a
2 = (VariationType, Bool)
-> WriterT
     [Warning] (StateT State (Either Error)) (VariationType, Bool)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (VariationType
T.Children, Bool
False)
    variationType' Property
property a
3 = (VariationType, Bool)
-> WriterT
     [Warning] (StateT State (Either Error)) (VariationType, Bool)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (VariationType
T.Siblings, Bool
False)
    variationType' Property
property a
_ = ErrorType -> PTranslator (VariationType, Bool)
forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
OutOfBounds Property
property

size :: GameType
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (Integer, Integer))
size GameType
gameType = do
    Maybe Property
property <- String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Property)
consumeSingle String
"SZ"
    case Maybe Property
property of
        Maybe Property
Nothing -> Maybe (Integer, Integer)
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (Integer, Integer))
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Integer, Integer)
 -> WriterT
      [Warning] (StateT State (Either Error)) (Maybe (Integer, Integer)))
-> Maybe (Integer, Integer)
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ GameType
-> [(GameType, (Integer, Integer))] -> Maybe (Integer, Integer)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GameType
gameType [(GameType, (Integer, Integer))]
forall {a} {b}. (Num a, Num b) => [(GameType, (a, b))]
defaultSize
        Just Property
p ->
            if Char -> Word8
forall a b. (Enum a, Enum b) => a -> b
enum Char
':' Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Word8]] -> [Word8]
forall a. HasCallStack => [a] -> a
head (Property -> [[Word8]]
values Property
p)
                then do
                    (Integer
m, Integer
n) <- ((Property
  -> WriterT [Warning] (StateT State (Either Error)) Integer)
 -> (Property
     -> WriterT [Warning] (StateT State (Either Error)) Integer)
 -> Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> (Property
    -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Property
 -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> (Property
    -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
forall a b. PTranslator a -> PTranslator b -> PTranslator (a, b)
compose Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number Property
p
                    Bool
-> WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n) (WriterT [Warning] (StateT State (Either Error)) ()
 -> WriterT [Warning] (StateT State (Either Error)) ())
-> (Property -> WriterT [Warning] (StateT State (Either Error)) ())
-> Property
-> WriterT [Warning] (StateT State (Either Error)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        [Warning] -> WriterT [Warning] (StateT State (Either Error)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Warning] -> WriterT [Warning] (StateT State (Either Error)) ())
-> (Property -> [Warning])
-> Property
-> WriterT [Warning] (StateT State (Either Error)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        Warning -> [Warning]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Warning -> [Warning])
-> (Property -> Warning) -> Property -> [Warning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Warning
SquareSizeSpecifiedAsRectangle (SourcePos -> Warning)
-> (Property -> SourcePos) -> Property -> Warning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> SourcePos
position (Property -> WriterT [Warning] (StateT State (Either Error)) ())
-> Property -> WriterT [Warning] (StateT State (Either Error)) ()
forall a b. (a -> b) -> a -> b
$
                        Property
p
                    GameType
-> Integer
-> Integer
-> Maybe Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (Integer, Integer))
forall {a} {b}.
(Ord a, Ord b, Num a, Num b) =>
GameType
-> a
-> b
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) (Maybe (a, b))
checkValidity GameType
gameType Integer
m Integer
n Maybe Property
property
                else do
                    Integer
m <- Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number Property
p
                    GameType
-> Integer
-> Integer
-> Maybe Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (Integer, Integer))
forall {a} {b}.
(Ord a, Ord b, Num a, Num b) =>
GameType
-> a
-> b
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) (Maybe (a, b))
checkValidity GameType
gameType Integer
m Integer
m Maybe Property
property
  where
    invalid :: GameType -> a -> a -> Bool
invalid GameType
t a
m a
n = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [GameType
t GameType -> GameType -> Bool
forall a. Eq a => a -> a -> Bool
== GameType
Go Bool -> Bool -> Bool
&& (a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
52 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
52), a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1, a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1]
    checkValidity :: GameType
-> a
-> b
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) (Maybe (a, b))
checkValidity GameType
t a
m b
n Maybe Property
p =
        Bool
-> WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GameType -> a -> b -> Bool
forall {a} {a}.
(Ord a, Ord a, Num a, Num a) =>
GameType -> a -> a -> Bool
invalid GameType
t a
m b
n) (ErrorType
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) ()
forall a. ErrorType -> Maybe Property -> Translator a
dieWithJust ErrorType
OutOfBounds Maybe Property
p) WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) (Maybe (a, b))
-> WriterT [Warning] (StateT State (Either Error)) (Maybe (a, b))
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (a, b)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe (a, b))
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
m, b
n))

-- }}}
-- game-info properties {{{
gameInfo :: Header
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
gameInfo Header
header =
    Header
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall {ruleSet}.
Header
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
consumeFreeformGameInfo Header
header WriterT
  [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
-> (GameInfo ruleSet ()
    -> WriterT
         [Warning] (StateT State (Either Error)) (GameInfo ruleSet ()))
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (String -> Rank)
-> (GameInfo ruleSet () -> Maybe Rank -> GameInfo ruleSet ())
-> String
-> Header
-> GameInfo ruleSet ()
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall {b} {t}.
(String -> b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
consumeUpdateGameInfo String -> Rank
rank (\GameInfo ruleSet ()
g Maybe Rank
v -> GameInfo ruleSet ()
g {T.rankBlack = v}) String
"BR" Header
header WriterT
  [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
-> (GameInfo ruleSet ()
    -> WriterT
         [Warning] (StateT State (Either Error)) (GameInfo ruleSet ()))
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (String -> Rank)
-> (GameInfo ruleSet () -> Maybe Rank -> GameInfo ruleSet ())
-> String
-> Header
-> GameInfo ruleSet ()
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall {b} {t}.
(String -> b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
consumeUpdateGameInfo String -> Rank
rank (\GameInfo ruleSet ()
g Maybe Rank
v -> GameInfo ruleSet ()
g {T.rankWhite = v}) String
"WR" Header
header WriterT
  [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
-> (GameInfo ruleSet ()
    -> WriterT
         [Warning] (StateT State (Either Error)) (GameInfo ruleSet ()))
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (String -> Round)
-> (GameInfo ruleSet () -> Maybe Round -> GameInfo ruleSet ())
-> String
-> Header
-> GameInfo ruleSet ()
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall {b} {t}.
(String -> b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
consumeUpdateGameInfo String -> Round
round (\GameInfo ruleSet ()
g Maybe Round
v -> GameInfo ruleSet ()
g {T.round = v}) String
"RO" Header
header WriterT
  [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
-> (GameInfo ruleSet ()
    -> WriterT
         [Warning] (StateT State (Either Error)) (GameInfo ruleSet ()))
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (String -> Maybe GameResult)
-> (GameInfo ruleSet () -> Maybe GameResult -> GameInfo ruleSet ())
-> String
-> Header
-> GameInfo ruleSet ()
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall {b} {t}.
(String -> Maybe b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
consumeUpdateGameInfoMaybe String -> Maybe GameResult
result (\GameInfo ruleSet ()
g Maybe GameResult
v -> GameInfo ruleSet ()
g {T.result = v}) String
"RE" Header
header WriterT
  [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
-> (GameInfo ruleSet ()
    -> WriterT
         [Warning] (StateT State (Either Error)) (GameInfo ruleSet ()))
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (String -> Maybe [PartialDate])
-> (GameInfo ruleSet ()
    -> Maybe [PartialDate] -> GameInfo ruleSet ())
-> String
-> Header
-> GameInfo ruleSet ()
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall {b} {t}.
(String -> Maybe b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
consumeUpdateGameInfoMaybe String -> Maybe [PartialDate]
date GameInfo ruleSet () -> Maybe [PartialDate] -> GameInfo ruleSet ()
forall {ruleSet} {extra}.
GameInfo ruleSet extra
-> Maybe [PartialDate] -> GameInfo ruleSet extra
dateUpdate String
"DT" Header
header WriterT
  [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
-> (GameInfo ruleSet ()
    -> WriterT
         [Warning] (StateT State (Either Error)) (GameInfo ruleSet ()))
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    GameInfo ruleSet ()
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall {m :: * -> *} {ruleSet} {extra}.
MonadWriter [Warning] m =>
GameInfo ruleSet extra -> m (GameInfo ruleSet extra)
warnClipDate WriterT
  [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
-> (GameInfo ruleSet ()
    -> WriterT
         [Warning] (StateT State (Either Error)) (GameInfo ruleSet ()))
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    GameInfo ruleSet ()
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall {ruleSet} {extra}.
GameInfo ruleSet extra
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet extra)
timeLimit

freeformGameInfo :: [(String, GameInfoType)]
freeformGameInfo =
    [ (String
"AN", GameInfoType
T.Annotator)
    , (String
"BT", Color -> GameInfoType
T.TeamName Color
Black)
    , (String
"CP", GameInfoType
T.Copyright)
    , (String
"EV", GameInfoType
T.Event)
    , (String
"GN", GameInfoType
T.GameName)
    , (String
"GC", GameInfoType
T.Context)
    , (String
"ON", GameInfoType
T.Opening)
    , (String
"OT", GameInfoType
T.Overtime)
    , (String
"PB", Color -> GameInfoType
T.PlayerName Color
Black)
    , (String
"PC", GameInfoType
T.Location)
    , (String
"PW", Color -> GameInfoType
T.PlayerName Color
White)
    , (String
"SO", GameInfoType
T.Source)
    , (String
"US", GameInfoType
T.User)
    , (String
"WT", Color -> GameInfoType
T.TeamName Color
White)
    ]

consumeFreeformGameInfo :: Header
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
consumeFreeformGameInfo Header
header = ([Maybe String] -> GameInfo ruleSet ())
-> WriterT [Warning] (StateT State (Either Error)) [Maybe String]
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe String] -> GameInfo ruleSet ()
forall {ruleSet}. [Maybe String] -> GameInfo ruleSet ()
gameInfo WriterT [Warning] (StateT State (Either Error)) [Maybe String]
tagValues
  where
    ([String]
tags, [GameInfoType]
types) = [(String, GameInfoType)] -> ([String], [GameInfoType])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, GameInfoType)]
freeformGameInfo
    tagValues :: WriterT [Warning] (StateT State (Either Error)) [Maybe String]
tagValues = (String
 -> WriterT [Warning] (StateT State (Either Error)) (Maybe String))
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PTranslator String
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe String)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap (Header -> PTranslator String
simple Header
header)) [String]
tags
    gameInfo :: [Maybe String] -> GameInfo ruleSet ()
gameInfo [Maybe String]
vals =
        (\Map GameInfoType String
m -> GameInfo ruleSet ()
forall ruleSet. GameInfo ruleSet ()
emptyGameInfo {T.freeform = m}) (Map GameInfoType String -> GameInfo ruleSet ())
-> ([Maybe (GameInfoType, String)] -> Map GameInfoType String)
-> [Maybe (GameInfoType, String)]
-> GameInfo ruleSet ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(GameInfoType, String)] -> Map GameInfoType String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(GameInfoType, String)] -> Map GameInfoType String)
-> ([Maybe (GameInfoType, String)] -> [(GameInfoType, String)])
-> [Maybe (GameInfoType, String)]
-> Map GameInfoType String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (GameInfoType, String)] -> [(GameInfoType, String)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (GameInfoType, String)] -> GameInfo ruleSet ())
-> [Maybe (GameInfoType, String)] -> GameInfo ruleSet ()
forall a b. (a -> b) -> a -> b
$
        (GameInfoType -> Maybe String -> Maybe (GameInfoType, String))
-> [GameInfoType]
-> [Maybe String]
-> [Maybe (GameInfoType, String)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((String -> (GameInfoType, String))
-> Maybe String -> Maybe (GameInfoType, String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> (GameInfoType, String))
 -> Maybe String -> Maybe (GameInfoType, String))
-> (GameInfoType -> String -> (GameInfoType, String))
-> GameInfoType
-> Maybe String
-> Maybe (GameInfoType, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,)) [GameInfoType]
types [Maybe String]
vals

consumeUpdateGameInfo :: (String -> b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
consumeUpdateGameInfo = (String -> Maybe b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
forall {b} {t}.
(String -> Maybe b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
consumeUpdateGameInfoMaybe ((String -> Maybe b)
 -> (t -> Maybe b -> t)
 -> String
 -> Header
 -> t
 -> WriterT [Warning] (StateT State (Either Error)) t)
-> ((String -> b) -> String -> Maybe b)
-> (String -> b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> (String -> b) -> String -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

consumeUpdateGameInfoMaybe :: (String -> Maybe b)
-> (t -> Maybe b -> t)
-> String
-> Header
-> t
-> WriterT [Warning] (StateT State (Either Error)) t
consumeUpdateGameInfoMaybe String -> Maybe b
fromString t -> Maybe b -> t
update String
property Header
header t
gameInfo = do
    Maybe Property
maybeProp <- String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Property)
consumeSingle String
property
    Maybe String
maybeString <- PTranslator String
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) (Maybe String)
forall a b. (a -> Translator b) -> Maybe a -> Translator (Maybe b)
transMap' (Header -> PTranslator String
simple Header
header) Maybe Property
maybeProp
    case (Maybe Property
maybeProp, Maybe String
maybeString Maybe String -> (String -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe b
fromString) of
        (Maybe Property
Nothing, Maybe b
_) -> t -> WriterT [Warning] (StateT State (Either Error)) t
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return t
gameInfo
        (Maybe Property
_, Maybe b
Nothing) -> ErrorType
-> Maybe Property
-> WriterT [Warning] (StateT State (Either Error)) t
forall a. ErrorType -> Maybe Property -> Translator a
dieWithJust ErrorType
BadlyFormattedValue Maybe Property
maybeProp
        (Maybe Property
_, Maybe b
v) -> t -> WriterT [Warning] (StateT State (Either Error)) t
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Maybe b -> t
update t
gameInfo Maybe b
v)

abbreviateList :: [([a], b)] -> [([a], b)]
abbreviateList [([a], b)]
xs = [([a], b)]
xs [([a], b)] -> (([a], b) -> [([a], b)]) -> [([a], b)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \([a]
n, b
v) -> [([a]
n, b
v), (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
1 [a]
n, b
v)]

-- TODO: can we unify this with the other implementation of reading a rational?
readRational :: String -> Maybe r
readRational String
s =
    (r -> Integer -> r -> r)
-> Maybe r -> Maybe Integer -> Maybe r -> Maybe r
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (\r
s Integer
n r
d -> r
s r -> r -> r
forall a. Num a => a -> a -> a
* (Integer -> r
forall a. Num a => Integer -> a
fromInteger Integer
n r -> r -> r
forall a. Num a => a -> a -> a
+ r
d)) Maybe r
forall {b}. Num b => Maybe b
maybeSign Maybe Integer
forall {b}. Read b => Maybe b
maybeNum Maybe r
forall {m :: * -> *} {b}.
(Monad m, Alternative m, Fractional b) =>
m b
maybeDen
  where
    (String
sign, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"+-") String
s
    (String
numerator, String
rest') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
rest
    denominator' :: String
denominator' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
rest' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"0"
    denominator :: a
denominator = Integer -> a
forall a. Num a => Integer -> a
fromInteger (String -> Integer
forall a. Read a => String -> a
read String
denominator') a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
10 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
denominator'
    maybeSign :: Maybe b
maybeSign = String -> [(String, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
sign [(String
"", b
1), (String
"+", b
1), (String
"-", -b
1)]
    maybeNum :: Maybe b
maybeNum = String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe String
numerator Maybe Char -> Maybe b -> Maybe b
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> b
forall a. Read a => String -> a
read String
numerator)
    maybeDen :: m b
maybeDen =
        Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
rest' String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"." Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
denominator') m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall {a}. Fractional a => a
denominator

rank :: String -> Rank
rank String
s = Rank -> Maybe Rank -> Rank
forall a. a -> Maybe a -> a
fromMaybe (String -> Rank
OtherRank String
s) Maybe Rank
maybeRanked
  where
    (String
rank, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s
    (String
scale, String
certainty) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlpha String
rest
    maybeRank :: Maybe b
maybeRank = String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe String
rank Maybe Char -> Maybe b -> Maybe b
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> b
forall a. Read a => String -> a
read String
rank)
    maybeScale :: Maybe RankScale
maybeScale = String -> [(String, RankScale)] -> Maybe RankScale
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
scale) [(String, RankScale)]
scales
    maybeCertainty :: Maybe (Maybe Certainty)
maybeCertainty = String -> [(String, Maybe Certainty)] -> Maybe (Maybe Certainty)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
certainty [(String, Maybe Certainty)]
certainties
    maybeRanked :: Maybe Rank
maybeRanked = (Integer -> RankScale -> Maybe Certainty -> Rank)
-> Maybe Integer
-> Maybe RankScale
-> Maybe (Maybe Certainty)
-> Maybe Rank
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 Integer -> RankScale -> Maybe Certainty -> Rank
Ranked Maybe Integer
forall {b}. Read b => Maybe b
maybeRank Maybe RankScale
maybeScale Maybe (Maybe Certainty)
maybeCertainty
    certainties :: [(String, Maybe Certainty)]
certainties = [(String
"", Maybe Certainty
forall a. Maybe a
Nothing), (String
"?", Certainty -> Maybe Certainty
forall a. a -> Maybe a
Just Certainty
Uncertain), (String
"*", Certainty -> Maybe Certainty
forall a. a -> Maybe a
Just Certainty
Certain)]
    scales :: [(String, RankScale)]
scales = [(String, RankScale)] -> [(String, RankScale)]
forall {a} {b}. [([a], b)] -> [([a], b)]
abbreviateList [(String
"kyu", RankScale
Kyu), (String
"dan", RankScale
Dan), (String
"pro", RankScale
Pro)]

result :: String -> Maybe GameResult
result (Char
c:Char
'+':String
score) = (Color -> WinType -> GameResult)
-> Maybe Color -> Maybe WinType -> Maybe GameResult
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Color -> WinType -> GameResult
Win Maybe Color
maybeColor Maybe WinType
maybeWinType
  where
    maybeColor :: Maybe Color
maybeColor = Char -> [(Char, Color)] -> Maybe Color
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Char -> Char
toLower Char
c) [(Char
'b', Color
Black), (Char
'w', Color
White)]
    maybeWinType :: Maybe WinType
maybeWinType =
        String -> [(String, WinType)] -> Maybe WinType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
score) [(String, WinType)]
winTypes Maybe WinType -> Maybe WinType -> Maybe WinType
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
        (Rational -> WinType) -> Maybe Rational -> Maybe WinType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> WinType
Score (String -> Maybe Rational
forall {r}. Fractional r => String -> Maybe r
readRational String
score)
    winTypes :: [(String, WinType)]
winTypes =
        [(String, WinType)] -> [(String, WinType)]
forall {a} {b}. [([a], b)] -> [([a], b)]
abbreviateList
            [ (String
"", WinType
OtherWinType)
            , (String
"forfeit", WinType
Forfeit)
            , (String
"time", WinType
Time)
            , (String
"resign", WinType
Resign)
            ]
result String
s =
    String -> [(String, GameResult)] -> Maybe GameResult
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup
        ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s)
        [(String
"0", GameResult
Draw), (String
"draw", GameResult
Draw), (String
"void", GameResult
Void), (String
"?", GameResult
Unknown)]

timeLimit :: GameInfo ruleSet extra
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet extra)
timeLimit GameInfo ruleSet extra
gameInfo =
    (Maybe Rational -> GameInfo ruleSet extra)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Rational)
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet extra)
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Rational
v -> GameInfo ruleSet extra
gameInfo {T.timeLimit = v}) (PTranslator Rational
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Rational)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Rational
real String
"TM")

date :: String -> Maybe [PartialDate]
date = [[String] -> Maybe PartialDate] -> [String] -> Maybe [PartialDate]
expect [] ([String] -> Maybe [PartialDate])
-> (String -> [String]) -> String -> Maybe [PartialDate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')
  where
    expect :: [[String] -> Maybe PartialDate] -> [String] -> Maybe [PartialDate]
expect [[String] -> Maybe PartialDate]
parsers [] = [PartialDate] -> Maybe [PartialDate]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    expect [[String] -> Maybe PartialDate]
parsers (String
pd:[String]
pds) = do
        PartialDate
parsed <-
            [Maybe PartialDate] -> Maybe PartialDate
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe PartialDate] -> Maybe PartialDate)
-> (String -> [Maybe PartialDate]) -> String -> Maybe PartialDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            [[String] -> Maybe PartialDate] -> [String] -> [Maybe PartialDate]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([[String] -> Maybe PartialDate
parseYMD, [String] -> Maybe PartialDate
parseYM, [String] -> Maybe PartialDate
parseY] [[String] -> Maybe PartialDate]
-> [[String] -> Maybe PartialDate]
-> [[String] -> Maybe PartialDate]
forall a. [a] -> [a] -> [a]
++ [[String] -> Maybe PartialDate]
parsers) ([String] -> [Maybe PartialDate])
-> (String -> [String]) -> String -> [Maybe PartialDate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') (String -> Maybe PartialDate) -> String -> Maybe PartialDate
forall a b. (a -> b) -> a -> b
$
            String
pd
        ([PartialDate] -> [PartialDate])
-> Maybe [PartialDate] -> Maybe [PartialDate]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (PartialDate
parsed PartialDate -> [PartialDate] -> [PartialDate]
forall a. a -> [a] -> [a]
:) (Maybe [PartialDate] -> Maybe [PartialDate])
-> (([String] -> Maybe [PartialDate]) -> Maybe [PartialDate])
-> ([String] -> Maybe [PartialDate])
-> Maybe [PartialDate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String] -> Maybe [PartialDate])
-> [String] -> Maybe [PartialDate]
forall a b. (a -> b) -> a -> b
$ [String]
pds) (([String] -> Maybe [PartialDate]) -> Maybe [PartialDate])
-> ([String] -> Maybe [PartialDate]) -> Maybe [PartialDate]
forall a b. (a -> b) -> a -> b
$
            case PartialDate
parsed of
                Year {} -> [[String] -> Maybe PartialDate] -> [String] -> Maybe [PartialDate]
expect []
                Month {year :: PartialDate -> Integer
year = Integer
y} -> [[String] -> Maybe PartialDate] -> [String] -> Maybe [PartialDate]
expect [Integer -> [String] -> Maybe PartialDate
parseMD Integer
y, Integer -> [String] -> Maybe PartialDate
parseM Integer
y]
                Day {year :: PartialDate -> Integer
year = Integer
y, month :: PartialDate -> Integer
month = Integer
m} -> [[String] -> Maybe PartialDate] -> [String] -> Maybe [PartialDate]
expect [Integer -> [String] -> Maybe PartialDate
parseMD Integer
y, Integer -> Integer -> [String] -> Maybe PartialDate
parseD Integer
y Integer
m]
    ensure :: (b -> Bool) -> b -> m b
ensure b -> Bool
p b
x = Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (b -> Bool
p b
x) m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
    hasLength :: t -> [a] -> Bool
hasLength t
n [a]
xs = t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
0 Bool -> Bool -> Bool
&& t -> [a] -> Bool
forall {t} {a}. (Eq t, Num t) => t -> [a] -> Bool
hasLength' t
n [a]
xs
      where
        hasLength' :: t -> [a] -> Bool
hasLength' t
n [] = t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
        hasLength' t
0 (a
x:[a]
xs) = Bool
False
        hasLength' t
n (a
x:[a]
xs) = t -> [a] -> Bool
hasLength' (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) [a]
xs
    ensureLength :: a -> [a] -> m [a]
ensureLength = ([a] -> Bool) -> [a] -> m [a]
forall {m :: * -> *} {b}.
(Monad m, Alternative m) =>
(b -> Bool) -> b -> m b
ensure (([a] -> Bool) -> [a] -> m [a])
-> (a -> [a] -> Bool) -> a -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> Bool
forall {t} {a}. (Ord t, Num t) => t -> [a] -> Bool
hasLength
    parseYMD :: [String] -> Maybe PartialDate
parseYMD [String]
ss =
        Integer -> [String] -> Maybe [String]
forall {m :: * -> *} {a} {a}.
(Monad m, Alternative m, Ord a, Num a) =>
a -> [a] -> m [a]
ensureLength Integer
3 [String]
ss Maybe [String]
-> ([String] -> Maybe PartialDate) -> Maybe PartialDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String
y, String
m, String
d] ->
            (Integer -> Integer -> Integer -> PartialDate)
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe PartialDate
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 Integer -> Integer -> Integer -> PartialDate
Day (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkY String
y) (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkMD String
m) (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkMD String
d)
    parseYM :: [String] -> Maybe PartialDate
parseYM [String]
ss =
        Integer -> [String] -> Maybe [String]
forall {m :: * -> *} {a} {a}.
(Monad m, Alternative m, Ord a, Num a) =>
a -> [a] -> m [a]
ensureLength Integer
2 [String]
ss Maybe [String]
-> ([String] -> Maybe PartialDate) -> Maybe PartialDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String
y, String
m] -> (Integer -> Integer -> PartialDate)
-> Maybe Integer -> Maybe Integer -> Maybe PartialDate
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Integer -> Integer -> PartialDate
Month (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkY String
y) (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkMD String
m)
    parseY :: [String] -> Maybe PartialDate
parseY [String]
ss = Integer -> [String] -> Maybe [String]
forall {m :: * -> *} {a} {a}.
(Monad m, Alternative m, Ord a, Num a) =>
a -> [a] -> m [a]
ensureLength Integer
1 [String]
ss Maybe [String]
-> ([String] -> Maybe PartialDate) -> Maybe PartialDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String
y] -> (Integer -> PartialDate) -> Maybe Integer -> Maybe PartialDate
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Integer -> PartialDate
Year (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkY String
y)
    parseMD :: Integer -> [String] -> Maybe PartialDate
parseMD Integer
y [String]
ss =
        Integer -> [String] -> Maybe [String]
forall {m :: * -> *} {a} {a}.
(Monad m, Alternative m, Ord a, Num a) =>
a -> [a] -> m [a]
ensureLength Integer
2 [String]
ss Maybe [String]
-> ([String] -> Maybe PartialDate) -> Maybe PartialDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String
m, String
d] -> (Integer -> Integer -> PartialDate)
-> Maybe Integer -> Maybe Integer -> Maybe PartialDate
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Integer -> Integer -> Integer -> PartialDate
Day Integer
y) (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkMD String
m) (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkMD String
d)
    parseM :: Integer -> [String] -> Maybe PartialDate
parseM Integer
y [String]
ss = Integer -> [String] -> Maybe [String]
forall {m :: * -> *} {a} {a}.
(Monad m, Alternative m, Ord a, Num a) =>
a -> [a] -> m [a]
ensureLength Integer
1 [String]
ss Maybe [String]
-> ([String] -> Maybe PartialDate) -> Maybe PartialDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String
m] -> (Integer -> PartialDate) -> Maybe Integer -> Maybe PartialDate
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Integer -> Integer -> PartialDate
Month Integer
y) (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkMD String
m)
    parseD :: Integer -> Integer -> [String] -> Maybe PartialDate
parseD Integer
y Integer
m [String]
ss = Integer -> [String] -> Maybe [String]
forall {m :: * -> *} {a} {a}.
(Monad m, Alternative m, Ord a, Num a) =>
a -> [a] -> m [a]
ensureLength Integer
1 [String]
ss Maybe [String]
-> ([String] -> Maybe PartialDate) -> Maybe PartialDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[String
d] -> (Integer -> PartialDate) -> Maybe Integer -> Maybe PartialDate
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Integer -> Integer -> Integer -> PartialDate
Day Integer
y Integer
m) (String -> Maybe Integer
forall {b}. Read b => String -> Maybe b
checkMD String
d)
    checkY :: String -> Maybe b
checkY String
y = Integer -> String -> Maybe String
forall {m :: * -> *} {a} {a}.
(Monad m, Alternative m, Ord a, Num a) =>
a -> [a] -> m [a]
ensureLength Integer
4 String
y Maybe String -> (String -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe b
forall {b}. Read b => String -> Maybe b
readM
    checkMD :: String -> Maybe b
checkMD String
md = Integer -> String -> Maybe String
forall {m :: * -> *} {a} {a}.
(Monad m, Alternative m, Ord a, Num a) =>
a -> [a] -> m [a]
ensureLength Integer
2 String
md Maybe String -> (String -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe b
forall {b}. Read b => String -> Maybe b
readM
    readM :: String -> Maybe a
readM = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> (String -> [a]) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, String) -> a) -> [(a, String)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, String) -> a
forall a b. (a, b) -> a
fst ([(a, String)] -> [a])
-> (String -> [(a, String)]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, String) -> Bool) -> [(a, String)] -> [(a, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> ((a, String) -> String) -> (a, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, String) -> String
forall a b. (a, b) -> b
snd) ([(a, String)] -> [(a, String)])
-> (String -> [(a, String)]) -> String -> [(a, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(a, String)]
forall a. Read a => ReadS a
reads

-- |
-- Clip to a valid, representable date.  Years are clipped to the 0000-9999
-- range; months are clipped to the 1-12 range, and days are clipped to the
-- 1-\<number of days in the given month\> range (accounting for leap years in
-- the case of February).
--
-- If a parsed date is changed by this function, a warning is emitted.
clipDate :: PartialDate -> PartialDate
clipDate :: PartialDate -> PartialDate
clipDate (y :: PartialDate
y@Year {}) = Integer -> PartialDate
Year (Integer -> PartialDate)
-> (PartialDate -> Integer) -> PartialDate -> PartialDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
9999 (Integer -> Integer)
-> (PartialDate -> Integer) -> PartialDate -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
0 (Integer -> Integer)
-> (PartialDate -> Integer) -> PartialDate -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialDate -> Integer
year (PartialDate -> PartialDate) -> PartialDate -> PartialDate
forall a b. (a -> b) -> a -> b
$ PartialDate
y
clipDate (Month {year :: PartialDate -> Integer
year = Integer
y, month :: PartialDate -> Integer
month = Integer
m}) =
    Month {year :: Integer
year = PartialDate -> Integer
year (PartialDate -> Integer)
-> (Integer -> PartialDate) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialDate -> PartialDate
clipDate (PartialDate -> PartialDate)
-> (Integer -> PartialDate) -> Integer -> PartialDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> PartialDate
Year (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
y, month :: Integer
month = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
12 (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
1 (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer
m}
clipDate (Day {year :: PartialDate -> Integer
year = Integer
y, month :: PartialDate -> Integer
month = Integer
m, day :: PartialDate -> Integer
day = Integer
d}) =
    let m' :: PartialDate
m' = PartialDate -> PartialDate
clipDate (Integer -> Integer -> PartialDate
Month Integer
y Integer
m)
     in Day
            { year :: Integer
year = PartialDate -> Integer
year PartialDate
m'
            , month :: Integer
month = PartialDate -> Integer
month PartialDate
m'
            , day :: Integer
day =
                  Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
1 (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min
                      (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                           (Integer -> Int -> Int
gregorianMonthLength
                                (PartialDate -> Integer
year PartialDate
m')
                                (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PartialDate -> Integer
month PartialDate
m')))) (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$
                  Integer
d
            }

warnClipDate :: GameInfo ruleSet extra -> m (GameInfo ruleSet extra)
warnClipDate gameInfo :: GameInfo ruleSet extra
gameInfo@(T.GameInfo {date :: forall ruleSet extra. GameInfo ruleSet extra -> Set PartialDate
T.date = Set PartialDate
d}) =
    let d' :: Set PartialDate
d' = (PartialDate -> PartialDate) -> Set PartialDate -> Set PartialDate
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map PartialDate -> PartialDate
clipDate Set PartialDate
d
     in do Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set PartialDate
d Set PartialDate -> Set PartialDate -> Bool
forall a. Eq a => a -> a -> Bool
/= Set PartialDate
d') ([Warning] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Set PartialDate -> Warning
InvalidDatesClipped Set PartialDate
d])
           GameInfo ruleSet extra -> m (GameInfo ruleSet extra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GameInfo ruleSet extra
gameInfo {T.date = d'}

dateUpdate :: GameInfo ruleSet extra
-> Maybe [PartialDate] -> GameInfo ruleSet extra
dateUpdate GameInfo ruleSet extra
g Maybe [PartialDate]
v = GameInfo ruleSet extra
g {T.date = maybe Set.empty Set.fromList v}

round :: String -> Round
round String
s =
    case String -> [String]
words String
s of
        [roundNumber :: String
roundNumber@(Char
_:String
_)]
            | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
roundNumber -> Integer -> Round
SimpleRound (String -> Integer
forall a. Read a => String -> a
read String
roundNumber)
        [roundNumber :: String
roundNumber@(Char
_:String
_), Char
'(':String
roundType]
            | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
roundNumber Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
roundType Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' ->
                Integer -> String -> Round
FormattedRound (String -> Integer
forall a. Read a => String -> a
read String
roundNumber) (String -> String
forall a. HasCallStack => [a] -> [a]
init String
roundType)
        [String]
_ -> String -> Round
OtherRound String
s

-- }}}
-- move properties {{{
move :: PTranslator move
-> WriterT [Warning] (StateT State (Either Error)) (Move move)
move PTranslator move
move = do
    [Bool]
color_ <- (String -> WriterT [Warning] (StateT State (Either Error)) Bool)
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> WriterT [Warning] (StateT State (Either Error)) Bool
has [String
"B", String
"W"]
    [Maybe Integer
number_, Maybe Integer
overtimeMovesBlack_, Maybe Integer
overtimeMovesWhite_] <-
        (String
 -> WriterT [Warning] (StateT State (Either Error)) (Maybe Integer))
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Maybe Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Property
 -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Integer)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number) [String
"MN", String
"OB", String
"OW"]
    [Maybe Rational
timeBlack_, Maybe Rational
timeWhite_] <- (String
 -> WriterT
      [Warning] (StateT State (Either Error)) (Maybe Rational))
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Maybe Rational]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PTranslator Rational
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Rational)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Rational
real) [String
"BL", String
"WL"]
    let partialMove :: Move move
partialMove =
            Move move
forall move. Move move
emptyMove
                { T.number = number_
                , T.timeBlack = timeBlack_
                , T.timeWhite = timeWhite_
                , T.overtimeMovesBlack = overtimeMovesBlack_
                , T.overtimeMovesWhite = overtimeMovesWhite_
                }
    case [Bool]
color_ of
        [Bool
False, Bool
False] ->
            (Property -> Warning)
-> [String] -> WriterT [Warning] (StateT State (Either Error)) ()
forall {t :: * -> *}.
Foldable t =>
(Property -> Warning)
-> t String -> WriterT [Warning] (StateT State (Either Error)) ()
warnAll Property -> Warning
MovelessAnnotationOmitted [String
"KO", String
"BM", String
"DO", String
"IT", String
"TE"] WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) (Move move)
-> WriterT [Warning] (StateT State (Either Error)) (Move move)
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            Move move
-> WriterT [Warning] (StateT State (Either Error)) (Move move)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Move move
forall move. Move move
partialMove
        [Bool
True, Bool
True] -> ErrorType
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) (Move move)
forall {b}.
ErrorType
-> [String] -> WriterT [Warning] (StateT State (Either Error)) b
dieEarliest ErrorType
ConcurrentBlackAndWhiteMove [String
"B", String
"W"]
        [Bool
black, Bool
white] ->
            let color :: Color
color =
                    if Bool
black
                        then Color
Black
                        else Color
White
             in do Just move
move <- ([Maybe move] -> Maybe move)
-> WriterT [Warning] (StateT State (Either Error)) [Maybe move]
-> WriterT [Warning] (StateT State (Either Error)) (Maybe move)
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe move] -> Maybe move
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (WriterT [Warning] (StateT State (Either Error)) [Maybe move]
 -> WriterT [Warning] (StateT State (Either Error)) (Maybe move))
-> ([String]
    -> WriterT [Warning] (StateT State (Either Error)) [Maybe move])
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) (Maybe move)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
 -> WriterT [Warning] (StateT State (Either Error)) (Maybe move))
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Maybe move]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PTranslator move
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe move)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator move
move) ([String]
 -> WriterT [Warning] (StateT State (Either Error)) (Maybe move))
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) (Maybe move)
forall a b. (a -> b) -> a -> b
$ [String
"B", String
"W"]
                   FuzzyBool
illegal <-
                       (Maybe () -> FuzzyBool)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe ())
-> WriterT [Warning] (StateT State (Either Error)) FuzzyBool
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                           (FuzzyBool -> (() -> FuzzyBool) -> Maybe () -> FuzzyBool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FuzzyBool
Possibly (FuzzyBool -> () -> FuzzyBool
forall a b. a -> b -> a
const FuzzyBool
Definitely))
                           ((Property -> WriterT [Warning] (StateT State (Either Error)) ())
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe ())
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap Property -> WriterT [Warning] (StateT State (Either Error)) ()
none String
"KO")
                   [Bool]
annotations <- (String -> WriterT [Warning] (StateT State (Either Error)) Bool)
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> WriterT [Warning] (StateT State (Either Error)) Bool
has [String
"BM", String
"DO", String
"IT", String
"TE"]
                   Maybe Quality
quality <-
                       case [Bool]
annotations of
                           [Bool
False, Bool
False, Bool
False, Bool
False] -> Maybe Quality
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Quality
forall a. Maybe a
Nothing
                           [Bool
True, Bool
False, Bool
False, Bool
False] ->
                               (Maybe Emphasis -> Maybe Quality)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Emphasis)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Emphasis -> Quality) -> Maybe Emphasis -> Maybe Quality
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Emphasis -> Quality
Bad) (PTranslator Emphasis
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Emphasis)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Emphasis
double String
"BM")
                           [Bool
False, Bool
False, Bool
False, Bool
True] ->
                               (Maybe Emphasis -> Maybe Quality)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Emphasis)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Emphasis -> Quality) -> Maybe Emphasis -> Maybe Quality
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Emphasis -> Quality
Good) (PTranslator Emphasis
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Emphasis)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Emphasis
double String
"TE")
                           [Bool
False, Bool
True, Bool
False, Bool
False] ->
                               (Property -> WriterT [Warning] (StateT State (Either Error)) ())
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe ())
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap Property -> WriterT [Warning] (StateT State (Either Error)) ()
none String
"DO" WriterT [Warning] (StateT State (Either Error)) (Maybe ())
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Quality
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Quality -> Maybe Quality
forall a. a -> Maybe a
Just Quality
Doubtful)
                           [Bool
False, Bool
False, Bool
True, Bool
False] ->
                               (Property -> WriterT [Warning] (StateT State (Either Error)) ())
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe ())
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap Property -> WriterT [Warning] (StateT State (Either Error)) ()
none String
"IT" WriterT [Warning] (StateT State (Either Error)) (Maybe ())
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Quality
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Quality -> Maybe Quality
forall a. a -> Maybe a
Just Quality
Interesting)
                           [Bool]
_ ->
                               ErrorType
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Quality)
forall {b}.
ErrorType
-> [String] -> WriterT [Warning] (StateT State (Either Error)) b
dieEarliest
                                   ErrorType
ConcurrentAnnotations
                                   [String
"BM", String
"DO", String
"IT", String
"TE"]
                   Move move
-> WriterT [Warning] (StateT State (Either Error)) (Move move)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return
                       Move Any
forall move. Move move
partialMove
                           { T.move = Just (color, move)
                           , T.illegal = illegal
                           , T.quality = quality
                           }

-- }}}
-- setup properties {{{
setupPoint :: (Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> WriterT
     [Warning] (StateT State (Either Error)) (Setup (Integer, Integer))
setupPoint Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point = do
    [[(Integer, Integer)]]
points <- (String
 -> WriterT
      [Warning] (StateT State (Either Error)) [(Integer, Integer)])
-> [String]
-> WriterT
     [Warning] (StateT State (Either Error)) [[(Integer, Integer)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PTranslator [(Integer, Integer)]
-> String
-> WriterT
     [Warning] (StateT State (Either Error)) [(Integer, Integer)]
forall a. PTranslator [a] -> String -> Translator [a]
transMapList ((Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator [(Integer, Integer)]
listOfPoint Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point)) [String
"AB", String
"AW", String
"AE"]
    let [Set (Integer, Integer)
addBlack, Set (Integer, Integer)
addWhite, Set (Integer, Integer)
remove] = ([(Integer, Integer)] -> Set (Integer, Integer))
-> [[(Integer, Integer)]] -> [Set (Integer, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map [(Integer, Integer)] -> Set (Integer, Integer)
forall a. Ord a => [a] -> Set a
Set.fromList [[(Integer, Integer)]]
points
        allPoints :: Set (Integer, Integer)
allPoints = Set (Integer, Integer)
addBlack Set (Integer, Integer)
-> Set (Integer, Integer) -> Set (Integer, Integer)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (Integer, Integer)
addWhite Set (Integer, Integer)
-> Set (Integer, Integer) -> Set (Integer, Integer)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (Integer, Integer)
remove
        duplicates :: [(Integer, Integer)]
duplicates = [[(Integer, Integer)]] -> [(Integer, Integer)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Integer, Integer)]]
points [(Integer, Integer)]
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a. Eq a => [a] -> [a] -> [a]
\\ Set (Integer, Integer) -> [(Integer, Integer)]
forall a. Set a -> [a]
Set.elems Set (Integer, Integer)
allPoints
        addWhite' :: Set (Integer, Integer)
addWhite' = Set (Integer, Integer)
addWhite Set (Integer, Integer)
-> Set (Integer, Integer) -> Set (Integer, Integer)
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set (Integer, Integer)
addBlack
        remove' :: Set (Integer, Integer)
remove' = Set (Integer, Integer)
remove Set (Integer, Integer)
-> Set (Integer, Integer) -> Set (Integer, Integer)
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ (Set (Integer, Integer)
addBlack Set (Integer, Integer)
-> Set (Integer, Integer) -> Set (Integer, Integer)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (Integer, Integer)
addWhite')
    Bool
-> WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Integer, Integer)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Integer, Integer)]
duplicates) ([Warning] -> WriterT [Warning] (StateT State (Either Error)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[(Integer, Integer)] -> Warning
DuplicateSetupOperationsOmitted [(Integer, Integer)]
duplicates])
    Set (Integer, Integer)
-> Set (Integer, Integer)
-> Set (Integer, Integer)
-> WriterT
     [Warning] (StateT State (Either Error)) (Setup (Integer, Integer))
forall {stone}.
Set stone
-> Set stone
-> Set (Integer, Integer)
-> WriterT [Warning] (StateT State (Either Error)) (Setup stone)
setupFinish Set (Integer, Integer)
addBlack Set (Integer, Integer)
addWhite' Set (Integer, Integer)
remove'

-- note: does not (cannot, in general) check the constraint that addBlack,
-- addWhite, and remove specify disjoint sets of points
-- TODO: what, really, cannot?  even if we allow ourselves a class constraint or something?
setupPointStone :: (Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator stone
-> WriterT [Warning] (StateT State (Either Error)) (Setup stone)
setupPointStone Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point PTranslator stone
stone = do
    [stone]
addBlack <- PTranslator [stone] -> String -> Translator [stone]
forall a. PTranslator [a] -> String -> Translator [a]
transMapList (PTranslator stone -> PTranslator [stone]
forall a. PTranslator a -> PTranslator [a]
listOf PTranslator stone
stone) String
"AB"
    [stone]
addWhite <- PTranslator [stone] -> String -> Translator [stone]
forall a. PTranslator [a] -> String -> Translator [a]
transMapList (PTranslator stone -> PTranslator [stone]
forall a. PTranslator a -> PTranslator [a]
listOf PTranslator stone
stone) String
"AW"
    [(Integer, Integer)]
remove <- PTranslator [(Integer, Integer)]
-> String
-> WriterT
     [Warning] (StateT State (Either Error)) [(Integer, Integer)]
forall a. PTranslator [a] -> String -> Translator [a]
transMapList ((Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator [(Integer, Integer)]
listOfPoint Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point) String
"AE"
    Set stone
-> Set stone
-> Set (Integer, Integer)
-> WriterT [Warning] (StateT State (Either Error)) (Setup stone)
forall {stone}.
Set stone
-> Set stone
-> Set (Integer, Integer)
-> WriterT [Warning] (StateT State (Either Error)) (Setup stone)
setupFinish
        ([stone] -> Set stone
forall a. Ord a => [a] -> Set a
Set.fromList [stone]
addBlack)
        ([stone] -> Set stone
forall a. Ord a => [a] -> Set a
Set.fromList [stone]
addWhite)
        ([(Integer, Integer)] -> Set (Integer, Integer)
forall a. Ord a => [a] -> Set a
Set.fromList [(Integer, Integer)]
remove)

setupFinish :: Set stone
-> Set stone
-> Set (Integer, Integer)
-> WriterT [Warning] (StateT State (Either Error)) (Setup stone)
setupFinish Set stone
addBlack Set stone
addWhite Set (Integer, Integer)
remove =
    (Maybe Color -> Setup stone)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Color)
-> WriterT [Warning] (StateT State (Either Error)) (Setup stone)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Set stone
-> Set stone
-> Set (Integer, Integer)
-> Maybe Color
-> Setup stone
forall stone.
Set stone
-> Set stone
-> Set (Integer, Integer)
-> Maybe Color
-> Setup stone
T.Setup Set stone
addBlack Set stone
addWhite Set (Integer, Integer)
remove) (PTranslator Color
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Color)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Color
color String
"PL")

-- }}}
-- none properties {{{
annotation :: Header
-> WriterT [Warning] (StateT State (Either Error)) (Annotation ())
annotation Header
header = do
    Maybe String
comment <- PTranslator String
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe String)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap (Header -> PTranslator String
text Header
header) String
"C"
    Maybe String
name <- PTranslator String
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe String)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap (Header -> PTranslator String
simple Header
header) String
"N"
    Maybe Emphasis
hotspot <- PTranslator Emphasis
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Emphasis)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Emphasis
double String
"HO"
    Maybe Rational
value <- PTranslator Rational
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Rational)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Rational
real String
"V"
    [Maybe Emphasis]
judgments' <- (String
 -> WriterT
      [Warning] (StateT State (Either Error)) (Maybe Emphasis))
-> [String]
-> WriterT [Warning] (StateT State (Either Error)) [Maybe Emphasis]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PTranslator Emphasis
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Emphasis)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Emphasis
double) [String
"GW", String
"GB", String
"DM", String
"UC"]
    let judgments :: [(Judgment, Emphasis)]
judgments = [(Judgment
j, Emphasis
e) | (Judgment
j, Just Emphasis
e) <- [Judgment] -> [Maybe Emphasis] -> [(Judgment, Maybe Emphasis)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Judgment
GoodForWhite ..] [Maybe Emphasis]
judgments']
    [Warning] -> WriterT [Warning] (StateT State (Either Error)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Warning] -> WriterT [Warning] (StateT State (Either Error)) ())
-> ([(Judgment, Emphasis)] -> [Warning])
-> [(Judgment, Emphasis)]
-> WriterT [Warning] (StateT State (Either Error)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Judgment, Emphasis) -> Warning)
-> [(Judgment, Emphasis)] -> [Warning]
forall a b. (a -> b) -> [a] -> [b]
map (Judgment, Emphasis) -> Warning
ExtraPositionalJudgmentOmitted ([(Judgment, Emphasis)] -> [Warning])
-> ([(Judgment, Emphasis)] -> [(Judgment, Emphasis)])
-> [(Judgment, Emphasis)]
-> [Warning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Judgment, Emphasis)] -> [(Judgment, Emphasis)]
forall a. Int -> [a] -> [a]
drop Int
1 ([(Judgment, Emphasis)]
 -> WriterT [Warning] (StateT State (Either Error)) ())
-> [(Judgment, Emphasis)]
-> WriterT [Warning] (StateT State (Either Error)) ()
forall a b. (a -> b) -> a -> b
$ [(Judgment, Emphasis)]
judgments
    Annotation ()
-> WriterT [Warning] (StateT State (Either Error)) (Annotation ())
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return
        Annotation ()
emptyAnnotation
            { T.comment = comment
            , T.name = name
            , T.hotspot = hotspot
            , T.value = value
            , T.judgment = listToMaybe judgments
            }

addMarks :: Map (Integer, Integer) Mark
-> (Mark, [(Integer, Integer)]) -> m (Map (Integer, Integer) Mark)
addMarks Map (Integer, Integer) Mark
marks (Mark
mark, [(Integer, Integer)]
points) = [Warning] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Warning]
warning m ()
-> m (Map (Integer, Integer) Mark)
-> m (Map (Integer, Integer) Mark)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Map (Integer, Integer) Mark -> m (Map (Integer, Integer) Mark)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map (Integer, Integer) Mark
result
  where
    ([(Integer, Integer)]
ignored, [(Integer, Integer)]
inserted) = ((Integer, Integer) -> Bool)
-> [(Integer, Integer)]
-> ([(Integer, Integer)], [(Integer, Integer)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Integer, Integer) -> Map (Integer, Integer) Mark -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (Integer, Integer) Mark
marks) [(Integer, Integer)]
points
    warning :: [Warning]
warning = ((Integer, Integer) -> Warning)
-> [(Integer, Integer)] -> [Warning]
forall a b. (a -> b) -> [a] -> [b]
map ((Mark, (Integer, Integer)) -> Warning
DuplicateMarkupOmitted ((Mark, (Integer, Integer)) -> Warning)
-> ((Integer, Integer) -> (Mark, (Integer, Integer)))
-> (Integer, Integer)
-> Warning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Mark
mark) [(Integer, Integer)]
ignored
    result :: Map (Integer, Integer) Mark
result = Map (Integer, Integer) Mark
marks Map (Integer, Integer) Mark
-> Map (Integer, Integer) Mark -> Map (Integer, Integer) Mark
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [((Integer, Integer), Mark)] -> Map (Integer, Integer) Mark
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Integer, Integer)
i, Mark
mark) | (Integer, Integer)
i <- [(Integer, Integer)]
inserted]

markup :: Header
-> (Property
    -> WriterT
         [Warning] (StateT State (Either Error)) (Integer, Integer))
-> WriterT [Warning] (StateT State (Either Error)) Markup
markup Header
header Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point = do
    [[(Integer, Integer)]]
markedPoints <-
        (String
 -> WriterT
      [Warning] (StateT State (Either Error)) [(Integer, Integer)])
-> [String]
-> WriterT
     [Warning] (StateT State (Either Error)) [[(Integer, Integer)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PTranslator [(Integer, Integer)]
-> String
-> WriterT
     [Warning] (StateT State (Either Error)) [(Integer, Integer)]
forall a. PTranslator [a] -> String -> Translator [a]
transMapList ((Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator [(Integer, Integer)]
listOfPoint Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point)) [String
"CR", String
"MA", String
"SL", String
"SQ", String
"TR"]
    Map (Integer, Integer) Mark
marks <- (Map (Integer, Integer) Mark
 -> (Mark, [(Integer, Integer)])
 -> WriterT
      [Warning]
      (StateT State (Either Error))
      (Map (Integer, Integer) Mark))
-> Map (Integer, Integer) Mark
-> [(Mark, [(Integer, Integer)])]
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Map (Integer, Integer) Mark)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map (Integer, Integer) Mark
-> (Mark, [(Integer, Integer)])
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Map (Integer, Integer) Mark)
forall {m :: * -> *}.
MonadWriter [Warning] m =>
Map (Integer, Integer) Mark
-> (Mark, [(Integer, Integer)]) -> m (Map (Integer, Integer) Mark)
addMarks Map (Integer, Integer) Mark
forall k a. Map k a
Map.empty ([(Mark, [(Integer, Integer)])]
 -> WriterT
      [Warning]
      (StateT State (Either Error))
      (Map (Integer, Integer) Mark))
-> ([[(Integer, Integer)]] -> [(Mark, [(Integer, Integer)])])
-> [[(Integer, Integer)]]
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Map (Integer, Integer) Mark)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mark] -> [[(Integer, Integer)]] -> [(Mark, [(Integer, Integer)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Mark
Circle ..] ([[(Integer, Integer)]]
 -> WriterT
      [Warning]
      (StateT State (Either Error))
      (Map (Integer, Integer) Mark))
-> [[(Integer, Integer)]]
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Map (Integer, Integer) Mark)
forall a b. (a -> b) -> a -> b
$ [[(Integer, Integer)]]
markedPoints
    [((Integer, Integer), String)]
labels <- PTranslator [((Integer, Integer), String)]
-> String -> Translator [((Integer, Integer), String)]
forall a. PTranslator [a] -> String -> Translator [a]
transMapList (PTranslator ((Integer, Integer), String)
-> PTranslator [((Integer, Integer), String)]
forall a. PTranslator a -> PTranslator [a]
listOf ((Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator String -> PTranslator ((Integer, Integer), String)
forall a b. PTranslator a -> PTranslator b -> PTranslator (a, b)
compose Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point (Header -> PTranslator String
simple Header
header))) String
"LB"
    [((Integer, Integer), (Integer, Integer))]
arrows <- String -> Translator [((Integer, Integer), (Integer, Integer))]
consumePointPairs String
"AR"
    [((Integer, Integer), (Integer, Integer))]
lines <- String -> Translator [((Integer, Integer), (Integer, Integer))]
consumePointPairs String
"LN"
    Maybe [(Integer, Integer)]
dim <- PTranslator [(Integer, Integer)]
-> String -> Translator (Maybe [(Integer, Integer)])
forall a. PTranslator a -> String -> Translator (Maybe a)
transMapMulti ((Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator [(Integer, Integer)]
listOfPoint Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point) String
"DD"
    Maybe [(Integer, Integer)]
visible <- PTranslator [(Integer, Integer)]
-> String -> Translator (Maybe [(Integer, Integer)])
forall a. PTranslator a -> String -> Translator (Maybe a)
transMapMulti ((Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator [(Integer, Integer)]
elistOfPoint Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point) String
"VW"
    Maybe Integer
numbering <- (Property
 -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Integer)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number String
"PM"
    Maybe Figure
figure <- PTranslator Figure -> String -> Translator (Maybe Figure)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap (Header -> PTranslator Figure
figurePTranslator Header
header) String
"FG"
    [Warning] -> WriterT [Warning] (StateT State (Either Error)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([Warning] -> WriterT [Warning] (StateT State (Either Error)) ())
-> ([((Integer, Integer), String)] -> [Warning])
-> [((Integer, Integer), String)]
-> WriterT [Warning] (StateT State (Either Error)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Integer, Integer), String) -> Warning)
-> [((Integer, Integer), String)] -> [Warning]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer, Integer), String) -> Warning
DuplicateLabelOmitted ([((Integer, Integer), String)]
 -> WriterT [Warning] (StateT State (Either Error)) ())
-> [((Integer, Integer), String)]
-> WriterT [Warning] (StateT State (Either Error)) ()
forall a b. (a -> b) -> a -> b
$ [((Integer, Integer), String)]
labels [((Integer, Integer), String)]
-> [((Integer, Integer), String)] -> [((Integer, Integer), String)]
forall a. Eq a => [a] -> [a] -> [a]
\\ (((Integer, Integer), String)
 -> ((Integer, Integer), String) -> Bool)
-> [((Integer, Integer), String)] -> [((Integer, Integer), String)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (((Integer, Integer) -> (Integer, Integer) -> Bool)
-> (((Integer, Integer), String) -> (Integer, Integer))
-> ((Integer, Integer), String)
-> ((Integer, Integer), String)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (Integer, Integer) -> (Integer, Integer) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Integer, Integer), String) -> (Integer, Integer)
forall a b. (a, b) -> a
fst) [((Integer, Integer), String)]
labels
    [Warning] -> WriterT [Warning] (StateT State (Either Error)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Integer -> Warning
UnknownNumberingIgnored Integer
n | Just Integer
n <- [Maybe Integer
numbering], Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
2]
  -- TODO: some kind of warning when omitting arrows and lines
    Markup -> WriterT [Warning] (StateT State (Either Error)) Markup
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return
        Markup
            { marks :: Map (Integer, Integer) Mark
T.marks = Map (Integer, Integer) Mark
marks
            , labels :: Map (Integer, Integer) String
T.labels = [((Integer, Integer), String)] -> Map (Integer, Integer) String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Integer, Integer), String)]
labels
            , arrows :: Set ((Integer, Integer), (Integer, Integer))
T.arrows = [((Integer, Integer), (Integer, Integer))]
-> Set ((Integer, Integer), (Integer, Integer))
forall {b}. Ord b => [(b, b)] -> Set (b, b)
prune [((Integer, Integer), (Integer, Integer))]
arrows
            , lines :: Set ((Integer, Integer), (Integer, Integer))
T.lines = [((Integer, Integer), (Integer, Integer))]
-> Set ((Integer, Integer), (Integer, Integer))
forall {b}. Ord b => [(b, b)] -> Set (b, b)
prune ([((Integer, Integer), (Integer, Integer))]
 -> Set ((Integer, Integer), (Integer, Integer)))
-> ([((Integer, Integer), (Integer, Integer))]
    -> [((Integer, Integer), (Integer, Integer))])
-> [((Integer, Integer), (Integer, Integer))]
-> Set ((Integer, Integer), (Integer, Integer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Integer, Integer), (Integer, Integer))
 -> ((Integer, Integer), (Integer, Integer)))
-> [((Integer, Integer), (Integer, Integer))]
-> [((Integer, Integer), (Integer, Integer))]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer, Integer), (Integer, Integer))
-> ((Integer, Integer), (Integer, Integer))
forall {b}. Ord b => (b, b) -> (b, b)
canonicalize ([((Integer, Integer), (Integer, Integer))]
 -> Set ((Integer, Integer), (Integer, Integer)))
-> [((Integer, Integer), (Integer, Integer))]
-> Set ((Integer, Integer), (Integer, Integer))
forall a b. (a -> b) -> a -> b
$ [((Integer, Integer), (Integer, Integer))]
lines
            , dim :: Maybe (Set (Integer, Integer))
T.dim = ([(Integer, Integer)] -> Set (Integer, Integer))
-> Maybe [(Integer, Integer)] -> Maybe (Set (Integer, Integer))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Integer, Integer)] -> Set (Integer, Integer)
forall a. Ord a => [a] -> Set a
Set.fromList Maybe [(Integer, Integer)]
dim
            , visible :: Maybe (Set (Integer, Integer))
T.visible = ([(Integer, Integer)] -> Set (Integer, Integer))
-> Maybe [(Integer, Integer)] -> Maybe (Set (Integer, Integer))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Integer, Integer)] -> Set (Integer, Integer)
forall a. Ord a => [a] -> Set a
Set.fromList Maybe [(Integer, Integer)]
visible
            , numbering :: Maybe Numbering
T.numbering =
                  Maybe Integer
numbering Maybe Integer -> (Integer -> Maybe Numbering) -> Maybe Numbering
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Integer -> [(Integer, Numbering)] -> Maybe Numbering)
-> [(Integer, Numbering)] -> Integer -> Maybe Numbering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> [(Integer, Numbering)] -> Maybe Numbering
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ([Integer] -> [Numbering] -> [(Integer, Numbering)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Numbering
Unnumbered ..])
            , figure :: Maybe Figure
T.figure = Maybe Figure
figure
            }
  where
    consumePointPairs :: String -> Translator [((Integer, Integer), (Integer, Integer))]
consumePointPairs = PTranslator [((Integer, Integer), (Integer, Integer))]
-> String -> Translator [((Integer, Integer), (Integer, Integer))]
forall a. PTranslator [a] -> String -> Translator [a]
transMapList (PTranslator ((Integer, Integer), (Integer, Integer))
-> PTranslator [((Integer, Integer), (Integer, Integer))]
forall a. PTranslator a -> PTranslator [a]
listOf (((Property
  -> WriterT
       [Warning] (StateT State (Either Error)) (Integer, Integer))
 -> (Property
     -> WriterT
          [Warning] (StateT State (Either Error)) (Integer, Integer))
 -> PTranslator ((Integer, Integer), (Integer, Integer)))
-> (Property
    -> WriterT
         [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator ((Integer, Integer), (Integer, Integer))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> (Property
    -> WriterT
         [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator ((Integer, Integer), (Integer, Integer))
forall a b. PTranslator a -> PTranslator b -> PTranslator (a, b)
compose Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
point))
    prune :: [(b, b)] -> Set (b, b)
prune = [(b, b)] -> Set (b, b)
forall a. Ord a => [a] -> Set a
Set.fromList ([(b, b)] -> Set (b, b))
-> ([(b, b)] -> [(b, b)]) -> [(b, b)] -> Set (b, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b) -> Bool) -> [(b, b)] -> [(b, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((b -> b -> Bool) -> (b, b) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(/=))
    canonicalize :: (b, b) -> (b, b)
canonicalize (b
x, b
y) = (b -> b -> b
forall a. Ord a => a -> a -> a
min b
x b
y, b -> b -> b
forall a. Ord a => a -> a -> a
max b
x b
y)

figurePTranslator :: Header -> PTranslator Figure
figurePTranslator Header
header (Property {values :: Property -> [[Word8]]
values = [[]]}) = Figure -> WriterT [Warning] (StateT State (Either Error)) Figure
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Figure
DefaultFigure
figurePTranslator Header
header Property
p = do
    (Integer
flags, String
name) <- (Property
 -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> PTranslator String -> PTranslator (Integer, String)
forall a b. PTranslator a -> PTranslator b -> PTranslator (a, b)
compose Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number (Header -> PTranslator String
simple Header
header) Property
p
    Figure -> WriterT [Warning] (StateT State (Either Error)) Figure
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Figure -> WriterT [Warning] (StateT State (Either Error)) Figure)
-> Figure -> WriterT [Warning] (StateT State (Either Error)) Figure
forall a b. (a -> b) -> a -> b
$
        if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
flags Int
16
            then String -> Figure
NamedDefaultFigure String
name
            else String -> (FigureFlag -> Bool) -> Figure
NamedFigure String
name (Bool -> Bool
not (Bool -> Bool) -> (FigureFlag -> Bool) -> FigureFlag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
flags (Int -> Bool) -> (FigureFlag -> Int) -> FigureFlag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FigureFlag -> Int
forall a. Enum a => a -> Int
fromEnum)

-- }}}
-- known properties list {{{
-- |
-- Types of properties, as given in the SGF specification.
data PropertyType
    = Move
    | Setup
    | Root
    | GameInfo
    -- |
    -- Technically, these properties have type \"none\" and
    -- /attribute/ \"inherit\", but the property index lists them as
    -- properties of type \"inherit\" with no attributes, so we
    -- follow that lead.
    | Inherit
    | None
    deriving (PropertyType -> PropertyType -> Bool
(PropertyType -> PropertyType -> Bool)
-> (PropertyType -> PropertyType -> Bool) -> Eq PropertyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyType -> PropertyType -> Bool
== :: PropertyType -> PropertyType -> Bool
$c/= :: PropertyType -> PropertyType -> Bool
/= :: PropertyType -> PropertyType -> Bool
Eq, Eq PropertyType
Eq PropertyType =>
(PropertyType -> PropertyType -> Ordering)
-> (PropertyType -> PropertyType -> Bool)
-> (PropertyType -> PropertyType -> Bool)
-> (PropertyType -> PropertyType -> Bool)
-> (PropertyType -> PropertyType -> Bool)
-> (PropertyType -> PropertyType -> PropertyType)
-> (PropertyType -> PropertyType -> PropertyType)
-> Ord PropertyType
PropertyType -> PropertyType -> Bool
PropertyType -> PropertyType -> Ordering
PropertyType -> PropertyType -> PropertyType
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
$ccompare :: PropertyType -> PropertyType -> Ordering
compare :: PropertyType -> PropertyType -> Ordering
$c< :: PropertyType -> PropertyType -> Bool
< :: PropertyType -> PropertyType -> Bool
$c<= :: PropertyType -> PropertyType -> Bool
<= :: PropertyType -> PropertyType -> Bool
$c> :: PropertyType -> PropertyType -> Bool
> :: PropertyType -> PropertyType -> Bool
$c>= :: PropertyType -> PropertyType -> Bool
>= :: PropertyType -> PropertyType -> Bool
$cmax :: PropertyType -> PropertyType -> PropertyType
max :: PropertyType -> PropertyType -> PropertyType
$cmin :: PropertyType -> PropertyType -> PropertyType
min :: PropertyType -> PropertyType -> PropertyType
Ord, Int -> PropertyType -> String -> String
[PropertyType] -> String -> String
PropertyType -> String
(Int -> PropertyType -> String -> String)
-> (PropertyType -> String)
-> ([PropertyType] -> String -> String)
-> Show PropertyType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PropertyType -> String -> String
showsPrec :: Int -> PropertyType -> String -> String
$cshow :: PropertyType -> String
show :: PropertyType -> String
$cshowList :: [PropertyType] -> String -> String
showList :: [PropertyType] -> String -> String
Show, ReadPrec [PropertyType]
ReadPrec PropertyType
Int -> ReadS PropertyType
ReadS [PropertyType]
(Int -> ReadS PropertyType)
-> ReadS [PropertyType]
-> ReadPrec PropertyType
-> ReadPrec [PropertyType]
-> Read PropertyType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PropertyType
readsPrec :: Int -> ReadS PropertyType
$creadList :: ReadS [PropertyType]
readList :: ReadS [PropertyType]
$creadPrec :: ReadPrec PropertyType
readPrec :: ReadPrec PropertyType
$creadListPrec :: ReadPrec [PropertyType]
readListPrec :: ReadPrec [PropertyType]
Read, Int -> PropertyType
PropertyType -> Int
PropertyType -> [PropertyType]
PropertyType -> PropertyType
PropertyType -> PropertyType -> [PropertyType]
PropertyType -> PropertyType -> PropertyType -> [PropertyType]
(PropertyType -> PropertyType)
-> (PropertyType -> PropertyType)
-> (Int -> PropertyType)
-> (PropertyType -> Int)
-> (PropertyType -> [PropertyType])
-> (PropertyType -> PropertyType -> [PropertyType])
-> (PropertyType -> PropertyType -> [PropertyType])
-> (PropertyType -> PropertyType -> PropertyType -> [PropertyType])
-> Enum PropertyType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PropertyType -> PropertyType
succ :: PropertyType -> PropertyType
$cpred :: PropertyType -> PropertyType
pred :: PropertyType -> PropertyType
$ctoEnum :: Int -> PropertyType
toEnum :: Int -> PropertyType
$cfromEnum :: PropertyType -> Int
fromEnum :: PropertyType -> Int
$cenumFrom :: PropertyType -> [PropertyType]
enumFrom :: PropertyType -> [PropertyType]
$cenumFromThen :: PropertyType -> PropertyType -> [PropertyType]
enumFromThen :: PropertyType -> PropertyType -> [PropertyType]
$cenumFromTo :: PropertyType -> PropertyType -> [PropertyType]
enumFromTo :: PropertyType -> PropertyType -> [PropertyType]
$cenumFromThenTo :: PropertyType -> PropertyType -> PropertyType -> [PropertyType]
enumFromThenTo :: PropertyType -> PropertyType -> PropertyType -> [PropertyType]
Enum, PropertyType
PropertyType -> PropertyType -> Bounded PropertyType
forall a. a -> a -> Bounded a
$cminBound :: PropertyType
minBound :: PropertyType
$cmaxBound :: PropertyType
maxBound :: PropertyType
Bounded)

-- |
-- All properties of each type listed in the SGF specification.
properties :: GameType -> PropertyType -> [String]
properties :: GameType -> PropertyType -> [String]
properties = ([String] -> [String] -> [String])
-> (PropertyType -> [String])
-> (PropertyType -> [String])
-> PropertyType
-> [String]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) PropertyType -> [String]
properties' ((PropertyType -> [String]) -> PropertyType -> [String])
-> (GameType -> PropertyType -> [String])
-> GameType
-> PropertyType
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameType -> PropertyType -> [String]
extraProperties
  where
    properties' :: PropertyType -> [String]
properties' PropertyType
Move =
        [String
"B", String
"KO", String
"MN", String
"W", String
"BM", String
"DO", String
"IT", String
"TE", String
"BL", String
"OB", String
"OW", String
"WL"]
    properties' PropertyType
Setup = [String
"AB", String
"AE", String
"AW", String
"PL"]
    properties' PropertyType
Root = [String
"AP", String
"CA", String
"FF", String
"GM", String
"ST", String
"SZ"]
    properties' PropertyType
GameInfo =
        [ String
"AN"
        , String
"BR"
        , String
"BT"
        , String
"CP"
        , String
"DT"
        , String
"EV"
        , String
"GN"
        , String
"GC"
        , String
"ON"
        , String
"OT"
        , String
"PB"
        , String
"PC"
        , String
"PW"
        , String
"RE"
        , String
"RO"
        , String
"RU"
        , String
"SO"
        , String
"TM"
        , String
"US"
        , String
"WR"
        , String
"WT"
        ]
    properties' PropertyType
Inherit = [String
"DD", String
"PM", String
"VW"]
    properties' PropertyType
None =
        [ String
"C"
        , String
"DM"
        , String
"GB"
        , String
"GW"
        , String
"HO"
        , String
"N"
        , String
"UC"
        , String
"V"
        , String
"AR"
        , String
"CR"
        , String
"LB"
        , String
"LN"
        , String
"MA"
        , String
"SL"
        , String
"SQ"
        , String
"TR"
        , String
"FG"
        ]

-- }}}
-- game-specific stuff {{{
defaultSize :: [(GameType, (a, b))]
defaultSize =
    [ (GameType
Go, (a
19, b
19))
    , (GameType
Chess, (a
8, b
8))
    , (GameType
LinesOfAction, (a
8, b
8))
    , (GameType
Hex, (a
11, b
11))
    , (GameType
Amazons, (a
10, b
10))
    , (GameType
Gess, (a
20, b
20))
    ]

ruleSetLookup :: [(String, b)] -> String -> Maybe b
ruleSetLookup [(String, b)]
rs = (String -> [(String, b)] -> Maybe b)
-> [(String, b)] -> String -> Maybe b
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [(String, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(String, b)]
rs (String -> Maybe b) -> (String -> String) -> String -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

ruleSetGo :: String -> Maybe RuleSetGo
ruleSetGo =
    [(String, RuleSetGo)] -> String -> Maybe RuleSetGo
forall {b}. [(String, b)] -> String -> Maybe b
ruleSetLookup
        [ (String
"aga", RuleSetGo
AGA)
        , (String
"goe", RuleSetGo
GOE)
        , (String
"chinese", RuleSetGo
Chinese)
        , (String
"japanese", RuleSetGo
Japanese)
        , (String
"nz", RuleSetGo
NewZealand)
        ]

ruleSetBackgammon :: String -> Maybe RuleSetBackgammon
ruleSetBackgammon =
    [(String, RuleSetBackgammon)] -> String -> Maybe RuleSetBackgammon
forall {b}. [(String, b)] -> String -> Maybe b
ruleSetLookup
        [ (String
"crawford", RuleSetBackgammon
Crawford)
        , (String
"crawford:crawfordgame", RuleSetBackgammon
CrawfordGame)
        , (String
"jacoby", RuleSetBackgammon
Jacoby)
        ]

ruleSetOcti :: String -> Maybe RuleSetOcti
ruleSetOcti String
s =
    case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
s of
        (String
major, Char
':':String
minors) ->
            (MajorVariation -> RuleSetOcti)
-> Maybe MajorVariation -> Maybe RuleSetOcti
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
                ((MajorVariation -> Set MinorVariation -> RuleSetOcti)
-> Set MinorVariation -> MajorVariation -> RuleSetOcti
forall a b c. (a -> b -> c) -> b -> a -> c
flip MajorVariation -> Set MinorVariation -> RuleSetOcti
OctiRuleSet (String -> Set MinorVariation
minorVariations String
minors))
                (String -> Maybe MajorVariation
majorVariation String
major)
        (String
majorOrMinors, String
"") ->
            (MajorVariation -> RuleSetOcti)
-> Maybe MajorVariation -> Maybe RuleSetOcti
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((MajorVariation -> Set MinorVariation -> RuleSetOcti)
-> Set MinorVariation -> MajorVariation -> RuleSetOcti
forall a b c. (a -> b -> c) -> b -> a -> c
flip MajorVariation -> Set MinorVariation -> RuleSetOcti
OctiRuleSet (Set MinorVariation
forall a. Set a
Set.empty)) (String -> Maybe MajorVariation
majorVariation String
majorOrMinors) Maybe RuleSetOcti -> Maybe RuleSetOcti -> Maybe RuleSetOcti
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
            RuleSetOcti -> Maybe RuleSetOcti
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (MajorVariation -> Set MinorVariation -> RuleSetOcti
OctiRuleSet MajorVariation
Full (String -> Set MinorVariation
minorVariations String
majorOrMinors))
  where
    majorVariation :: String -> Maybe MajorVariation
majorVariation =
        [(String, MajorVariation)] -> String -> Maybe MajorVariation
forall {b}. [(String, b)] -> String -> Maybe b
ruleSetLookup [(String
"full", MajorVariation
Full), (String
"fast", MajorVariation
Fast), (String
"kids", MajorVariation
Kids)]
    minorVariation :: String -> MinorVariation
minorVariation String
s =
        MinorVariation -> Maybe MinorVariation -> MinorVariation
forall a. a -> Maybe a -> a
fromMaybe (String -> MinorVariation
OtherMinorVariation String
s) (Maybe MinorVariation -> MinorVariation)
-> (String -> Maybe MinorVariation) -> String -> MinorVariation
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        [(String, MinorVariation)] -> String -> Maybe MinorVariation
forall {b}. [(String, b)] -> String -> Maybe b
ruleSetLookup [(String
"edgeless", MinorVariation
Edgeless), (String
"superprong", MinorVariation
Superprong)] (String -> MinorVariation) -> String -> MinorVariation
forall a b. (a -> b) -> a -> b
$
        String
s
    minorVariations :: String -> Set MinorVariation
minorVariations = [MinorVariation] -> Set MinorVariation
forall a. Ord a => [a] -> Set a
Set.fromList ([MinorVariation] -> Set MinorVariation)
-> (String -> [MinorVariation]) -> String -> Set MinorVariation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MinorVariation) -> [String] -> [MinorVariation]
forall a b. (a -> b) -> [a] -> [b]
map String -> MinorVariation
minorVariation ([String] -> [MinorVariation])
-> (String -> [String]) -> String -> [MinorVariation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')

ruleSet :: (String -> Maybe a)
-> Maybe a
-> Header
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (RuleSet a))
ruleSet String -> Maybe a
read Maybe a
maybeDefault Header
header = do
    Maybe String
maybeRulesetString <- PTranslator String
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe String)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap (Header -> PTranslator String
simple Header
header) String
"RU"
    Maybe (RuleSet a)
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (RuleSet a))
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (RuleSet a)
 -> WriterT
      [Warning] (StateT State (Either Error)) (Maybe (RuleSet a)))
-> Maybe (RuleSet a)
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (RuleSet a))
forall a b. (a -> b) -> a -> b
$
        case (Maybe String
maybeRulesetString, Maybe String
maybeRulesetString Maybe String -> (String -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe a
read) of
            (Maybe String
Nothing, Maybe a
_) -> (a -> RuleSet a) -> Maybe a -> Maybe (RuleSet a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> RuleSet a
forall a. a -> RuleSet a
Known Maybe a
maybeDefault
            (Just String
s, Maybe a
Nothing) -> RuleSet a -> Maybe (RuleSet a)
forall a. a -> Maybe a
Just (String -> RuleSet a
forall a. String -> RuleSet a
OtherRuleSet String
s)
            (Maybe String
_, Just a
rs) -> RuleSet a -> Maybe (RuleSet a)
forall a. a -> Maybe a
Just (a -> RuleSet a
forall a. a -> RuleSet a
Known a
rs)

ruleSetDefault :: Header
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (RuleSet a))
ruleSetDefault = (String -> Maybe a)
-> Maybe a
-> Header
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (RuleSet a))
forall {a}.
(String -> Maybe a)
-> Maybe a
-> Header
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (RuleSet a))
ruleSet (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) Maybe a
forall a. Maybe a
Nothing

-- |
-- Just the properties associated with specific games.
extraProperties :: GameType -> PropertyType -> [String]
extraProperties :: GameType -> PropertyType -> [String]
extraProperties GameType
Go PropertyType
GameInfo = [String
"HA", String
"KM"]
extraProperties GameType
Go PropertyType
None = [String
"TB", String
"TW"]
extraProperties GameType
Backgammon PropertyType
Setup = [String
"CO", String
"CV", String
"DI"]
extraProperties GameType
Backgammon PropertyType
GameInfo = [String
"MI", String
"RE", String
"RU"]
extraProperties GameType
LinesOfAction PropertyType
GameInfo = [String
"IP", String
"IY", String
"SU"]
extraProperties GameType
LinesOfAction PropertyType
None = [String
"AS", String
"SE"]
extraProperties GameType
Hex PropertyType
Root = [String
"IS"]
extraProperties GameType
Hex PropertyType
GameInfo = [String
"IP"]
extraProperties GameType
Amazons PropertyType
Setup = [String
"AA"]
extraProperties GameType
Octi PropertyType
Setup = [String
"RP"]
extraProperties GameType
Octi PropertyType
GameInfo = [String
"BO", String
"WO", String
"NP", String
"NR", String
"NS"]
extraProperties GameType
Octi PropertyType
None = [String
"AS", String
"CS", String
"MS", String
"SS", String
"TS"]
extraProperties GameType
_ PropertyType
_ = []

gameInfoGo :: WriterT [Warning] (StateT State (Either Error)) GameInfoGo
gameInfoGo = (Maybe Integer -> Maybe Rational -> GameInfoGo)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Integer)
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Rational)
-> WriterT [Warning] (StateT State (Either Error)) GameInfoGo
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe Integer -> Maybe Rational -> GameInfoGo
GameInfoGo ((Property
 -> WriterT [Warning] (StateT State (Either Error)) Integer)
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Integer)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap Property -> WriterT [Warning] (StateT State (Either Error)) Integer
number String
"HA") (PTranslator Rational
-> String
-> WriterT [Warning] (StateT State (Either Error)) (Maybe Rational)
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap PTranslator Rational
real String
"KM")

pointGo :: Property -> WriterT [Warning] (StateT State (Either Error)) (a, b)
pointGo (Property {values :: Property -> [[Word8]]
values = [[Word8
x, Word8
y]]})
    | Word8 -> Bool
forall {a}. (Ord a, Enum a) => a -> Bool
valid Word8
x Bool -> Bool -> Bool
&& Word8 -> Bool
forall {a}. (Ord a, Enum a) => a -> Bool
valid Word8
y = (a, b) -> WriterT [Warning] (StateT State (Either Error)) (a, b)
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> a
forall {a} {a}. (Num a, Enum a, Enum a, Ord a) => a -> a
translate Word8
x, Word8 -> b
forall {a} {a}. (Num a, Enum a, Enum a, Ord a) => a -> a
translate Word8
y)
  where
    valid :: a -> Bool
valid a
x =
        (Char -> a
forall a b. (Enum a, Enum b) => a -> b
enum Char
'a' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> a
forall a b. (Enum a, Enum b) => a -> b
enum Char
'z') Bool -> Bool -> Bool
|| (Char -> a
forall a b. (Enum a, Enum b) => a -> b
enum Char
'A' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> a
forall a b. (Enum a, Enum b) => a -> b
enum Char
'Z')
    translate :: a -> a
translate a
x =
        a -> a
forall a b. (Enum a, Enum b) => a -> b
enum a
x a -> a -> a
forall a. Num a => a -> a -> a
-
        Char -> a
forall a b. (Enum a, Enum b) => a -> b
enum
            (if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> a
forall a b. (Enum a, Enum b) => a -> b
enum Char
'a'
                 then Char
'A'
                 else Char
'a')
pointGo Property
p = ErrorType
-> Property
-> WriterT [Warning] (StateT State (Either Error)) (a, b)
forall a. ErrorType -> Property -> Translator a
dieWith ErrorType
BadlyFormattedValue Property
p

moveGo :: Maybe (Integer, Integer)
-> Property
-> WriterT [Warning] (StateT State (Either Error)) MoveGo
moveGo Maybe (Integer, Integer)
_ (Property {values :: Property -> [[Word8]]
values = [[]]}) = MoveGo -> WriterT [Warning] (StateT State (Either Error)) MoveGo
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return MoveGo
Pass
moveGo (Just (Integer
w, Integer
h)) Property
p =
    Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
forall {a} {b}.
(Num a, Num b, Enum a, Enum b) =>
Property -> WriterT [Warning] (StateT State (Either Error)) (a, b)
pointGo Property
p WriterT [Warning] (StateT State (Either Error)) (Integer, Integer)
-> ((Integer, Integer)
    -> WriterT [Warning] (StateT State (Either Error)) MoveGo)
-> WriterT [Warning] (StateT State (Either Error)) MoveGo
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \v :: (Integer, Integer)
v@(Integer
x, Integer
y) ->
        MoveGo -> WriterT [Warning] (StateT State (Either Error)) MoveGo
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MoveGo -> WriterT [Warning] (StateT State (Either Error)) MoveGo)
-> MoveGo -> WriterT [Warning] (StateT State (Either Error)) MoveGo
forall a b. (a -> b) -> a -> b
$
        if Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
w Bool -> Bool -> Bool
|| Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
h
            then MoveGo
Pass
            else (Integer, Integer) -> MoveGo
Play (Integer, Integer)
v
moveGo Maybe (Integer, Integer)
_ Property
p = ((Integer, Integer) -> MoveGo)
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
-> WriterT [Warning] (StateT State (Either Error)) MoveGo
forall a b.
(a -> b)
-> WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Integer) -> MoveGo
Play (Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
forall {a} {b}.
(Num a, Num b, Enum a, Enum b) =>
Property -> WriterT [Warning] (StateT State (Either Error)) (a, b)
pointGo Property
p)

annotationGo :: WriterT
  [Warning]
  (StateT State (Either Error))
  (Map Color (Set (Integer, Integer)))
annotationGo = do
    [Maybe [(Integer, Integer)]]
territories <- (String -> Translator (Maybe [(Integer, Integer)]))
-> [String]
-> WriterT
     [Warning]
     (StateT State (Either Error))
     [Maybe [(Integer, Integer)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (PTranslator [(Integer, Integer)]
-> String -> Translator (Maybe [(Integer, Integer)])
forall a. PTranslator a -> String -> Translator (Maybe a)
transMap ((Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> PTranslator [(Integer, Integer)]
elistOfPoint Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
forall {a} {b}.
(Num a, Num b, Enum a, Enum b) =>
Property -> WriterT [Warning] (StateT State (Either Error)) (a, b)
pointGo)) [String
"TB", String
"TW"]
    Map Color (Set (Integer, Integer))
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Map Color (Set (Integer, Integer)))
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Color (Set (Integer, Integer))
 -> WriterT
      [Warning]
      (StateT State (Either Error))
      (Map Color (Set (Integer, Integer))))
-> ([(Color, Set (Integer, Integer))]
    -> Map Color (Set (Integer, Integer)))
-> [(Color, Set (Integer, Integer))]
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Map Color (Set (Integer, Integer)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Color, Set (Integer, Integer))]
-> Map Color (Set (Integer, Integer))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Color, Set (Integer, Integer))]
 -> WriterT
      [Warning]
      (StateT State (Either Error))
      (Map Color (Set (Integer, Integer))))
-> [(Color, Set (Integer, Integer))]
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Map Color (Set (Integer, Integer)))
forall a b. (a -> b) -> a -> b
$
        [(Color
c, [(Integer, Integer)] -> Set (Integer, Integer)
forall a. Ord a => [a] -> Set a
Set.fromList [(Integer, Integer)]
t) | (Color
c, Just [(Integer, Integer)]
t) <- [Color]
-> [Maybe [(Integer, Integer)]]
-> [(Color, Maybe [(Integer, Integer)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Color
Black, Color
White] [Maybe [(Integer, Integer)]]
territories]

gameHex :: p -> p -> f GameTree
gameHex p
header p
seenGameInfo = (TreeHex -> GameTree) -> f TreeHex -> f GameTree
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(ViewerSetting, Bool)] -> TreeHex -> GameTree
TreeHex []) (p -> p -> f TreeHex
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeHex p
header p
seenGameInfo)

nodeGo :: Header
-> Maybe (Integer, Integer)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) TreeGo
nodeGo Header
header Maybe (Integer, Integer)
size Bool
seenGameInfo = do
    [Bool
hasGameInfo, Bool
hasRoot, Bool
hasSetup, Bool
hasMove] <-
        (PropertyType
 -> WriterT [Warning] (StateT State (Either Error)) Bool)
-> [PropertyType]
-> WriterT [Warning] (StateT State (Either Error)) [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([String] -> WriterT [Warning] (StateT State (Either Error)) Bool
hasAny ([String] -> WriterT [Warning] (StateT State (Either Error)) Bool)
-> (PropertyType -> [String])
-> PropertyType
-> WriterT [Warning] (StateT State (Either Error)) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameType -> PropertyType -> [String]
properties GameType
Go) [PropertyType
GameInfo, PropertyType
Root, PropertyType
Setup, PropertyType
Move]
    let setGameInfo :: Bool
setGameInfo = Bool
hasGameInfo Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
seenGameInfo
        duplicateGameInfo :: Bool
duplicateGameInfo = Bool
hasGameInfo Bool -> Bool -> Bool
&& Bool
seenGameInfo
    Bool
-> WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasSetup Bool -> Bool -> Bool
&& Bool
hasMove) WriterT [Warning] (StateT State (Either Error)) ()
forall {b}. WriterT [Warning] (StateT State (Either Error)) b
dieSetupAndMove
    Bool
-> WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
duplicateGameInfo WriterT [Warning] (StateT State (Either Error)) ()
warnGameInfo
    Bool
-> WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasRoot WriterT [Warning] (StateT State (Either Error)) ()
warnRoot
    Maybe (GameInfo Any ())
mGameInfo <- (GameInfo Any () -> Maybe (GameInfo Any ()))
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo Any ())
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (GameInfo Any ()))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\GameInfo Any ()
x -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
setGameInfo Maybe () -> Maybe (GameInfo Any ()) -> Maybe (GameInfo Any ())
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GameInfo Any () -> Maybe (GameInfo Any ())
forall a. a -> Maybe a
Just GameInfo Any ()
x) (Header
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo Any ())
forall {ruleSet}.
Header
-> WriterT
     [Warning] (StateT State (Either Error)) (GameInfo ruleSet ())
gameInfo Header
header)
    GameInfoGo
otherGameInfo <- WriterT [Warning] (StateT State (Either Error)) GameInfoGo
gameInfoGo
    Maybe (RuleSet RuleSetGo)
ruleSet_ <- (String -> Maybe RuleSetGo)
-> Maybe RuleSetGo
-> Header
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (RuleSet RuleSetGo))
forall {a}.
(String -> Maybe a)
-> Maybe a
-> Header
-> WriterT
     [Warning] (StateT State (Either Error)) (Maybe (RuleSet a))
ruleSet String -> Maybe RuleSetGo
ruleSetGo Maybe RuleSetGo
forall a. Maybe a
Nothing Header
header
    Either (Setup (Integer, Integer)) (Move MoveGo)
action_ <-
        if Bool
hasMove
            then (Move MoveGo -> Either (Setup (Integer, Integer)) (Move MoveGo))
-> WriterT [Warning] (StateT State (Either Error)) (Move MoveGo)
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Either (Setup (Integer, Integer)) (Move MoveGo))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Move MoveGo -> Either (Setup (Integer, Integer)) (Move MoveGo)
forall a b. b -> Either a b
Right (WriterT [Warning] (StateT State (Either Error)) (Move MoveGo)
 -> WriterT
      [Warning]
      (StateT State (Either Error))
      (Either (Setup (Integer, Integer)) (Move MoveGo)))
-> WriterT [Warning] (StateT State (Either Error)) (Move MoveGo)
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Either (Setup (Integer, Integer)) (Move MoveGo))
forall a b. (a -> b) -> a -> b
$ (Property
 -> WriterT [Warning] (StateT State (Either Error)) MoveGo)
-> WriterT [Warning] (StateT State (Either Error)) (Move MoveGo)
forall {move}.
PTranslator move
-> WriterT [Warning] (StateT State (Either Error)) (Move move)
move (Maybe (Integer, Integer)
-> Property
-> WriterT [Warning] (StateT State (Either Error)) MoveGo
moveGo Maybe (Integer, Integer)
size)
            else (Setup (Integer, Integer)
 -> Either (Setup (Integer, Integer)) (Move MoveGo))
-> WriterT
     [Warning] (StateT State (Either Error)) (Setup (Integer, Integer))
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Either (Setup (Integer, Integer)) (Move MoveGo))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Setup (Integer, Integer)
-> Either (Setup (Integer, Integer)) (Move MoveGo)
forall a b. a -> Either a b
Left (WriterT
   [Warning] (StateT State (Either Error)) (Setup (Integer, Integer))
 -> WriterT
      [Warning]
      (StateT State (Either Error))
      (Either (Setup (Integer, Integer)) (Move MoveGo)))
-> WriterT
     [Warning] (StateT State (Either Error)) (Setup (Integer, Integer))
-> WriterT
     [Warning]
     (StateT State (Either Error))
     (Either (Setup (Integer, Integer)) (Move MoveGo))
forall a b. (a -> b) -> a -> b
$ (Property
 -> WriterT
      [Warning] (StateT State (Either Error)) (Integer, Integer))
-> WriterT
     [Warning] (StateT State (Either Error)) (Setup (Integer, Integer))
setupPoint Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
forall {a} {b}.
(Num a, Num b, Enum a, Enum b) =>
Property -> WriterT [Warning] (StateT State (Either Error)) (a, b)
pointGo
    Annotation ()
annotation_ <- Header
-> WriterT [Warning] (StateT State (Either Error)) (Annotation ())
annotation Header
header
    Map Color (Set (Integer, Integer))
otherAnnotation <- WriterT
  [Warning]
  (StateT State (Either Error))
  (Map Color (Set (Integer, Integer)))
annotationGo
    Markup
markup_ <- Header
-> (Property
    -> WriterT
         [Warning] (StateT State (Either Error)) (Integer, Integer))
-> WriterT [Warning] (StateT State (Either Error)) Markup
markup Header
header Property
-> WriterT
     [Warning] (StateT State (Either Error)) (Integer, Integer)
forall {a} {b}.
(Num a, Num b, Enum a, Enum b) =>
Property -> WriterT [Warning] (StateT State (Either Error)) (a, b)
pointGo
    Map String [[Word8]]
unknown_ <- Translator (Map String [[Word8]])
unknownProperties
    [TreeGo]
children <-
        (State -> [State])
-> WriterT [Warning] (StateT State (Either Error)) [State]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets State -> [State]
forall a. Tree a -> [Tree a]
subForest WriterT [Warning] (StateT State (Either Error)) [State]
-> ([State]
    -> WriterT [Warning] (StateT State (Either Error)) [TreeGo])
-> WriterT [Warning] (StateT State (Either Error)) [TreeGo]
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> (a -> WriterT [Warning] (StateT State (Either Error)) b)
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        (State -> WriterT [Warning] (StateT State (Either Error)) TreeGo)
-> [State]
-> WriterT [Warning] (StateT State (Either Error)) [TreeGo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\State
s -> State -> WriterT [Warning] (StateT State (Either Error)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put State
s WriterT [Warning] (StateT State (Either Error)) ()
-> WriterT [Warning] (StateT State (Either Error)) TreeGo
-> WriterT [Warning] (StateT State (Either Error)) TreeGo
forall a b.
WriterT [Warning] (StateT State (Either Error)) a
-> WriterT [Warning] (StateT State (Either Error)) b
-> WriterT [Warning] (StateT State (Either Error)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Header
-> Maybe (Integer, Integer)
-> Bool
-> WriterT [Warning] (StateT State (Either Error)) TreeGo
nodeGo Header
header Maybe (Integer, Integer)
size (Bool
seenGameInfo Bool -> Bool -> Bool
|| Bool
hasGameInfo))
    TreeGo -> WriterT [Warning] (StateT State (Either Error)) TreeGo
forall a. a -> WriterT [Warning] (StateT State (Either Error)) a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (GameNode
  MoveGo
  (Integer, Integer)
  RuleSetGo
  GameInfoGo
  (Map Color (Set (Integer, Integer)))
-> [TreeGo] -> TreeGo
forall a. a -> [Tree a] -> Tree a
Node
             (Maybe (GameInfo RuleSetGo GameInfoGo)
-> Either (Setup (Integer, Integer)) (Move MoveGo)
-> Annotation (Map Color (Set (Integer, Integer)))
-> Markup
-> Map String [[Word8]]
-> GameNode
     MoveGo
     (Integer, Integer)
     RuleSetGo
     GameInfoGo
     (Map Color (Set (Integer, Integer)))
forall move stone ruleSet extraGameInfo extraAnnotation.
Maybe (GameInfo ruleSet extraGameInfo)
-> Either (Setup stone) (Move move)
-> Annotation extraAnnotation
-> Markup
-> Map String [[Word8]]
-> GameNode move stone ruleSet extraGameInfo extraAnnotation
GameNode
                  ((GameInfo Any () -> GameInfo RuleSetGo GameInfoGo)
-> Maybe (GameInfo Any ()) -> Maybe (GameInfo RuleSetGo GameInfoGo)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                       (\GameInfo Any ()
gi ->
                            GameInfo Any ()
gi
                                { T.ruleSet = ruleSet_
                                , T.otherGameInfo = otherGameInfo
                                })
                       Maybe (GameInfo Any ())
mGameInfo)
                  Either (Setup (Integer, Integer)) (Move MoveGo)
action_
                  Annotation ()
annotation_ {T.otherAnnotation = otherAnnotation}
                  Markup
markup_
                  Map String [[Word8]]
unknown_)
             [TreeGo]
children)
  where
    dieSetupAndMove :: WriterT [Warning] (StateT State (Either Error)) b
dieSetupAndMove =
        ErrorType
-> [String] -> WriterT [Warning] (StateT State (Either Error)) b
forall {b}.
ErrorType
-> [String] -> WriterT [Warning] (StateT State (Either Error)) b
dieEarliest ErrorType
ConcurrentMoveAndSetup (GameType -> PropertyType -> [String]
properties GameType
Go (PropertyType -> [String]) -> [PropertyType] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [PropertyType
Setup, PropertyType
Move])
    warnGameInfo :: WriterT [Warning] (StateT State (Either Error)) ()
warnGameInfo = (Property -> Warning)
-> [String] -> WriterT [Warning] (StateT State (Either Error)) ()
forall {t :: * -> *}.
Foldable t =>
(Property -> Warning)
-> t String -> WriterT [Warning] (StateT State (Either Error)) ()
warnAll Property -> Warning
ExtraGameInfoOmitted (GameType -> PropertyType -> [String]
properties GameType
Go PropertyType
GameInfo)
    warnRoot :: WriterT [Warning] (StateT State (Either Error)) ()
warnRoot = (Property -> Warning)
-> [String] -> WriterT [Warning] (StateT State (Either Error)) ()
forall {t :: * -> *}.
Foldable t =>
(Property -> Warning)
-> t String -> WriterT [Warning] (StateT State (Either Error)) ()
warnAll Property -> Warning
NestedRootPropertyOmitted (GameType -> PropertyType -> [String]
properties GameType
Go PropertyType
Root)

nodeBackgammon :: p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeBackgammon = p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeOther -- TODO

nodeLinesOfAction :: p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeLinesOfAction = p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeOther -- TODO

nodeHex :: p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeHex = p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeOther -- TODO

nodeOcti :: p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeOcti = p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
forall {m :: * -> *} {p} {p} {move} {stone} {ruleSet}
       {extraGameInfo}.
Monad m =>
p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeOther -- TODO

nodeOther :: p -> p -> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
nodeOther p
header p
seenGameInfo = Tree (GameNode move stone ruleSet extraGameInfo ())
-> m (Tree (GameNode move stone ruleSet extraGameInfo ()))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GameNode move stone ruleSet extraGameInfo ()
-> [Tree (GameNode move stone ruleSet extraGameInfo ())]
-> Tree (GameNode move stone ruleSet extraGameInfo ())
forall a. a -> [Tree a] -> Tree a
Node GameNode move stone ruleSet extraGameInfo ()
forall move stone ruleSet extraGameInfo.
GameNode move stone ruleSet extraGameInfo ()
emptyGameNode []) -- TODO
-- }}}