module BishBosh.Notation.MoveNotation(
ShowNotation(..),
ShowNotationFloat(..),
MoveNotation(),
tag,
pureCoordinate,
readsQualifiedMove,
showNotation,
showsMoveSyntax,
getNotation,
getOrigin,
showsNotationFloatToNDecimals,
isPureCoordinate
) where
import Control.Arrow((&&&))
import qualified BishBosh.Attribute.Rank as Attribute.Rank
import qualified BishBosh.Cartesian.Coordinates as Cartesian.Coordinates
import qualified BishBosh.Component.EitherQualifiedMove as Component.EitherQualifiedMove
import qualified BishBosh.Component.QualifiedMove as Component.QualifiedMove
import qualified BishBosh.Component.Turn as Component.Turn
import qualified BishBosh.Notation.ICCFNumeric as Notation.ICCFNumeric
import qualified BishBosh.Notation.Notation as Notation.Notation
import qualified BishBosh.Notation.PureCoordinate as Notation.PureCoordinate
import qualified BishBosh.Notation.Smith as Notation.Smith
import qualified BishBosh.Property.FixedMembership as Property.FixedMembership
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Type.Count as Type.Count
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified Text.XML.HXT.Arrow.Pickle.Schema
tag :: String
tag :: String
tag = String
"moveNotation"
data MoveNotation
= ICCFNumeric
| PureCoordinate
| Smith
deriving (MoveNotation -> MoveNotation -> Bool
(MoveNotation -> MoveNotation -> Bool)
-> (MoveNotation -> MoveNotation -> Bool) -> Eq MoveNotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoveNotation -> MoveNotation -> Bool
$c/= :: MoveNotation -> MoveNotation -> Bool
== :: MoveNotation -> MoveNotation -> Bool
$c== :: MoveNotation -> MoveNotation -> Bool
Eq, ReadPrec [MoveNotation]
ReadPrec MoveNotation
Int -> ReadS MoveNotation
ReadS [MoveNotation]
(Int -> ReadS MoveNotation)
-> ReadS [MoveNotation]
-> ReadPrec MoveNotation
-> ReadPrec [MoveNotation]
-> Read MoveNotation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MoveNotation]
$creadListPrec :: ReadPrec [MoveNotation]
readPrec :: ReadPrec MoveNotation
$creadPrec :: ReadPrec MoveNotation
readList :: ReadS [MoveNotation]
$creadList :: ReadS [MoveNotation]
readsPrec :: Int -> ReadS MoveNotation
$creadsPrec :: Int -> ReadS MoveNotation
Read, Int -> MoveNotation -> ShowS
[MoveNotation] -> ShowS
MoveNotation -> String
(Int -> MoveNotation -> ShowS)
-> (MoveNotation -> String)
-> ([MoveNotation] -> ShowS)
-> Show MoveNotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MoveNotation] -> ShowS
$cshowList :: [MoveNotation] -> ShowS
show :: MoveNotation -> String
$cshow :: MoveNotation -> String
showsPrec :: Int -> MoveNotation -> ShowS
$cshowsPrec :: Int -> MoveNotation -> ShowS
Show)
instance Control.DeepSeq.NFData MoveNotation where
rnf :: MoveNotation -> ()
rnf MoveNotation
_ = ()
instance Data.Default.Default MoveNotation where
def :: MoveNotation
def = MoveNotation
Smith
instance HXT.XmlPickler MoveNotation where
xpickle :: PU MoveNotation
xpickle = MoveNotation -> PU MoveNotation -> PU MoveNotation
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault MoveNotation
forall a. Default a => a
Data.Default.def (PU MoveNotation -> PU MoveNotation)
-> ([String] -> PU MoveNotation) -> [String] -> PU MoveNotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MoveNotation, MoveNotation -> String)
-> PU String -> PU MoveNotation
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> MoveNotation
forall a. Read a => String -> a
read, MoveNotation -> String
forall a. Show a => a -> String
show) (PU String -> PU MoveNotation)
-> ([String] -> PU String) -> [String] -> PU MoveNotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag (PU String -> PU String)
-> ([String] -> PU String) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> PU String
HXT.xpTextDT (Schema -> PU String)
-> ([String] -> Schema) -> [String] -> PU String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Schema
Text.XML.HXT.Arrow.Pickle.Schema.scEnum ([String] -> PU MoveNotation) -> [String] -> PU MoveNotation
forall a b. (a -> b) -> a -> b
$ (MoveNotation -> String) -> [MoveNotation] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MoveNotation -> String
forall a. Show a => a -> String
show [MoveNotation]
range
range :: [MoveNotation]
range :: [MoveNotation]
range = [MoveNotation
ICCFNumeric, MoveNotation
PureCoordinate, MoveNotation
Smith]
instance Property.FixedMembership.FixedMembership MoveNotation where
members :: [MoveNotation]
members = [MoveNotation]
range
pureCoordinate :: MoveNotation
pureCoordinate :: MoveNotation
pureCoordinate = MoveNotation
PureCoordinate
readsQualifiedMove :: MoveNotation -> ReadS Component.EitherQualifiedMove.EitherQualifiedMove
readsQualifiedMove :: MoveNotation -> ReadS EitherQualifiedMove
readsQualifiedMove MoveNotation
ICCFNumeric = ((ICCFNumeric, String) -> (EitherQualifiedMove, String))
-> [(ICCFNumeric, String)] -> [(EitherQualifiedMove, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((ICCFNumeric -> EitherQualifiedMove)
-> (ICCFNumeric, String) -> (EitherQualifiedMove, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((ICCFNumeric -> EitherQualifiedMove)
-> (ICCFNumeric, String) -> (EitherQualifiedMove, String))
-> (ICCFNumeric -> EitherQualifiedMove)
-> (ICCFNumeric, String)
-> (EitherQualifiedMove, String)
forall a b. (a -> b) -> a -> b
$ (Move -> Maybe Rank -> EitherQualifiedMove)
-> (Move, Maybe Rank) -> EitherQualifiedMove
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move -> Maybe Rank -> EitherQualifiedMove
Component.EitherQualifiedMove.mkPartiallyQualifiedMove ((Move, Maybe Rank) -> EitherQualifiedMove)
-> (ICCFNumeric -> (Move, Maybe Rank))
-> ICCFNumeric
-> EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ICCFNumeric -> Move
Notation.ICCFNumeric.getMove (ICCFNumeric -> Move)
-> (ICCFNumeric -> Maybe Rank) -> ICCFNumeric -> (Move, Maybe Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ICCFNumeric -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank)) ([(ICCFNumeric, String)] -> [(EitherQualifiedMove, String)])
-> (String -> [(ICCFNumeric, String)]) -> ReadS EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(ICCFNumeric, String)]
forall a. Read a => ReadS a
reads
readsQualifiedMove MoveNotation
PureCoordinate = ((PureCoordinate, String) -> (EitherQualifiedMove, String))
-> [(PureCoordinate, String)] -> [(EitherQualifiedMove, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PureCoordinate -> EitherQualifiedMove)
-> (PureCoordinate, String) -> (EitherQualifiedMove, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((PureCoordinate -> EitherQualifiedMove)
-> (PureCoordinate, String) -> (EitherQualifiedMove, String))
-> (PureCoordinate -> EitherQualifiedMove)
-> (PureCoordinate, String)
-> (EitherQualifiedMove, String)
forall a b. (a -> b) -> a -> b
$ (Move -> Maybe Rank -> EitherQualifiedMove)
-> (Move, Maybe Rank) -> EitherQualifiedMove
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move -> Maybe Rank -> EitherQualifiedMove
Component.EitherQualifiedMove.mkPartiallyQualifiedMove ((Move, Maybe Rank) -> EitherQualifiedMove)
-> (PureCoordinate -> (Move, Maybe Rank))
-> PureCoordinate
-> EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PureCoordinate -> Move
Notation.PureCoordinate.getMove (PureCoordinate -> Move)
-> (PureCoordinate -> Maybe Rank)
-> PureCoordinate
-> (Move, Maybe Rank)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PureCoordinate -> Maybe Rank
forall a. Promotable a => a -> Maybe Rank
Attribute.Rank.getMaybePromotionRank)) ([(PureCoordinate, String)] -> [(EitherQualifiedMove, String)])
-> (String -> [(PureCoordinate, String)])
-> ReadS EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(PureCoordinate, String)]
forall a. Read a => ReadS a
reads
readsQualifiedMove MoveNotation
Smith = ((Smith, String) -> (EitherQualifiedMove, String))
-> [(Smith, String)] -> [(EitherQualifiedMove, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Smith -> EitherQualifiedMove)
-> (Smith, String) -> (EitherQualifiedMove, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ((Smith -> EitherQualifiedMove)
-> (Smith, String) -> (EitherQualifiedMove, String))
-> (Smith -> EitherQualifiedMove)
-> (Smith, String)
-> (EitherQualifiedMove, String)
forall a b. (a -> b) -> a -> b
$ (Move -> MoveType -> EitherQualifiedMove)
-> (Move, MoveType) -> EitherQualifiedMove
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Move -> MoveType -> EitherQualifiedMove
Component.EitherQualifiedMove.mkFullyQualifiedMove ((Move, MoveType) -> EitherQualifiedMove)
-> (Smith -> (Move, MoveType)) -> Smith -> EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (QualifiedMove -> MoveType) -> QualifiedMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType) (QualifiedMove -> (Move, MoveType))
-> (Smith -> QualifiedMove) -> Smith -> (Move, MoveType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Smith -> QualifiedMove
Notation.Smith.getQualifiedMove) ([(Smith, String)] -> [(EitherQualifiedMove, String)])
-> (String -> [(Smith, String)]) -> ReadS EitherQualifiedMove
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Smith, String)]
forall a. Read a => ReadS a
reads
showsMoveSyntax :: MoveNotation -> ShowS
showsMoveSyntax :: MoveNotation -> ShowS
showsMoveSyntax MoveNotation
moveNotation = Char -> ShowS
showChar Char
'/' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (
case MoveNotation
moveNotation of
MoveNotation
ICCFNumeric -> String
Notation.ICCFNumeric.regexSyntax
MoveNotation
PureCoordinate -> String
Notation.PureCoordinate.regexSyntax
MoveNotation
Smith -> String
Notation.Smith.regexSyntax
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'/'
getNotation :: MoveNotation -> Notation.Notation.Notation
getNotation :: MoveNotation -> Notation
getNotation MoveNotation
ICCFNumeric = Notation
Notation.ICCFNumeric.notation
getNotation MoveNotation
PureCoordinate = Notation
Notation.PureCoordinate.notation
getNotation MoveNotation
Smith = Notation
Notation.Smith.notation
getOrigin :: MoveNotation -> Notation.Notation.CoordinatePairI
getOrigin :: MoveNotation -> CoordinatePairI
getOrigin = Notation -> CoordinatePairI
Notation.Notation.getOrigin (Notation -> CoordinatePairI)
-> (MoveNotation -> Notation) -> MoveNotation -> CoordinatePairI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveNotation -> Notation
getNotation
isPureCoordinate :: MoveNotation -> Bool
isPureCoordinate :: MoveNotation -> Bool
isPureCoordinate MoveNotation
PureCoordinate = Bool
True
isPureCoordinate MoveNotation
_ = Bool
False
class ShowNotation a where
showsNotation :: MoveNotation -> a -> ShowS
instance ShowNotation Component.QualifiedMove.QualifiedMove where
showsNotation :: MoveNotation -> QualifiedMove -> ShowS
showsNotation MoveNotation
moveNotation QualifiedMove
qualifiedMove = case MoveNotation
moveNotation of
MoveNotation
ICCFNumeric -> ICCFNumeric -> ShowS
forall a. Show a => a -> ShowS
shows (ICCFNumeric -> ShowS) -> ICCFNumeric -> ShowS
forall a b. (a -> b) -> a -> b
$ Move -> MoveType -> ICCFNumeric
forall promotable.
Promotable promotable =>
Move -> promotable -> ICCFNumeric
Notation.ICCFNumeric.mkICCFNumeric' Move
move MoveType
moveType
MoveNotation
PureCoordinate -> PureCoordinate -> ShowS
forall a. Show a => a -> ShowS
shows (PureCoordinate -> ShowS) -> PureCoordinate -> ShowS
forall a b. (a -> b) -> a -> b
$ Move -> MoveType -> PureCoordinate
forall promotable.
Promotable promotable =>
Move -> promotable -> PureCoordinate
Notation.PureCoordinate.mkPureCoordinate' Move
move MoveType
moveType
MoveNotation
Smith -> Smith -> ShowS
forall a. Show a => a -> ShowS
shows (Smith -> ShowS) -> Smith -> ShowS
forall a b. (a -> b) -> a -> b
$ QualifiedMove -> Smith
Notation.Smith.fromQualifiedMove QualifiedMove
qualifiedMove
where
(Move
move, MoveType
moveType) = QualifiedMove -> Move
Component.QualifiedMove.getMove (QualifiedMove -> Move)
-> (QualifiedMove -> MoveType) -> QualifiedMove -> (Move, MoveType)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QualifiedMove -> MoveType
Component.QualifiedMove.getMoveType (QualifiedMove -> (Move, MoveType))
-> QualifiedMove -> (Move, MoveType)
forall a b. (a -> b) -> a -> b
$ QualifiedMove
qualifiedMove
instance ShowNotation Component.Turn.Turn where
showsNotation :: MoveNotation -> Turn -> ShowS
showsNotation MoveNotation
moveNotation = MoveNotation -> QualifiedMove -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
showsNotation MoveNotation
moveNotation (QualifiedMove -> ShowS)
-> (Turn -> QualifiedMove) -> Turn -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Turn -> QualifiedMove
Component.Turn.getQualifiedMove
instance ShowNotation Cartesian.Coordinates.Coordinates where
showsNotation :: MoveNotation -> Coordinates -> ShowS
showsNotation = Notation -> Coordinates -> ShowS
Notation.Notation.showsCoordinates (Notation -> Coordinates -> ShowS)
-> (MoveNotation -> Notation)
-> MoveNotation
-> Coordinates
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveNotation -> Notation
getNotation
showNotation :: (ShowNotation a) => MoveNotation -> a -> String
showNotation :: MoveNotation -> a -> String
showNotation MoveNotation
moveNotation = (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") (ShowS -> String) -> (a -> ShowS) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MoveNotation -> a -> ShowS
forall a. ShowNotation a => MoveNotation -> a -> ShowS
showsNotation MoveNotation
moveNotation
class ShowNotationFloat a where
showsNotationFloat :: MoveNotation -> (Double -> ShowS) -> a -> ShowS
showsNotationFloatToNDecimals :: ShowNotationFloat a => MoveNotation -> Type.Count.NDecimalDigits -> a -> ShowS
showsNotationFloatToNDecimals :: MoveNotation -> Int -> a -> ShowS
showsNotationFloatToNDecimals MoveNotation
moveNotation = MoveNotation -> (Double -> ShowS) -> a -> ShowS
forall a.
ShowNotationFloat a =>
MoveNotation -> (Double -> ShowS) -> a -> ShowS
showsNotationFloat MoveNotation
moveNotation ((Double -> ShowS) -> a -> ShowS)
-> (Int -> Double -> ShowS) -> Int -> a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> ShowS
forall a. RealFloat a => Int -> a -> ShowS
Property.ShowFloat.showsFloatToN'