{-
Copyright (C) 2018 Dr. Alistair Ward
This file is part of BishBosh.
BishBosh is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
BishBosh is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with BishBosh. If not, see .
-}
{- |
[@AUTHOR@] Dr. Alistair Ward
[@DESCRIPTION@]
* Defines various context-free move-notations .
* Also defines some features required of a notation; e.g. that it has an origin, & implements (Read, Show).
-}
module BishBosh.Notation.MoveNotation(
-- * Type-classes
ShowNotation(..),
ShowNotationFloat(..),
-- * Types
-- ** Data-types
MoveNotation(),
-- * Constants
tag,
pureCoordinate,
-- range,
-- * Functions
readsQualifiedMove,
showNotation,
showsMoveSyntax,
getNotation,
getOrigin,
showsNotationFloatToNDecimals,
-- ** Predicates
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
-- | Used to qualify XML.
tag :: String
tag = "moveNotation"
{- |
* Identifies the sum-type of context-free move-notations which can be used.
* Neither /Standard Algebraic/ nor /Long Algebraic/ notations are included, because conversion to or from a /QualifiedMove/, requires /game/-context.
-}
data MoveNotation
= ICCFNumeric -- ^ .
| PureCoordinate -- ^ As used for communication with /xboard/ & as the basis of Standard Algebraic.
| Smith -- ^ .
deriving (Eq, Read, Show)
instance Control.DeepSeq.NFData MoveNotation where
rnf _ = ()
instance Data.Default.Default MoveNotation where
def = Smith
instance HXT.XmlPickler MoveNotation where
xpickle = HXT.xpDefault Data.Default.def . HXT.xpWrap (read, show) . HXT.xpAttr tag . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range -- CAVEAT: whether it'll be used as an XML-attribute or an XML-element isn't currently known.
-- | The constant complete range of values.
range :: [MoveNotation]
range = [ICCFNumeric, PureCoordinate, Smith]
instance Property.FixedMembership.FixedMembership MoveNotation where
members = range
-- | Constant.
pureCoordinate :: MoveNotation
pureCoordinate = PureCoordinate
-- | Reads a /move/ & /move-type/ from the specified 'MoveNotation'.
readsQualifiedMove :: MoveNotation -> ReadS Component.EitherQualifiedMove.EitherQualifiedMove
readsQualifiedMove ICCFNumeric = map (Control.Arrow.first $ uncurry Component.EitherQualifiedMove.mkPartiallyQualifiedMove . (Notation.ICCFNumeric.getMove &&& Attribute.Rank.getMaybePromotionRank)) . reads
readsQualifiedMove PureCoordinate = map (Control.Arrow.first $ uncurry Component.EitherQualifiedMove.mkPartiallyQualifiedMove . (Notation.PureCoordinate.getMove &&& Attribute.Rank.getMaybePromotionRank)) . reads
readsQualifiedMove Smith = map (Control.Arrow.first $ uncurry Component.EitherQualifiedMove.mkFullyQualifiedMove . (Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType) . Notation.Smith.getQualifiedMove) . reads
-- | Show the syntax required by a specific 'MoveNotation'.
showsMoveSyntax :: MoveNotation -> ShowS
showsMoveSyntax moveNotation = showChar '/' . showString (
case moveNotation of
ICCFNumeric -> Notation.ICCFNumeric.regexSyntax
PureCoordinate -> Notation.PureCoordinate.regexSyntax
Smith -> Notation.Smith.regexSyntax
) . showChar '/'
-- | Returns the notation-parameters.
getNotation :: MoveNotation -> Notation.Notation.Notation
getNotation ICCFNumeric = Notation.ICCFNumeric.notation
getNotation PureCoordinate = Notation.PureCoordinate.notation
getNotation Smith = Notation.Smith.notation
-- | Returns the origin of the specified coordinate-system.
getOrigin :: MoveNotation -> Notation.Notation.CoordinatePairI
getOrigin = Notation.Notation.getOrigin . getNotation
-- | Predicate.
isPureCoordinate :: MoveNotation -> Bool
isPureCoordinate PureCoordinate = True
isPureCoordinate _ = False
-- | An interface for types which can be rendered in a chess-notation.
class ShowNotation a where
showsNotation :: MoveNotation -> a -> ShowS
instance ShowNotation Component.QualifiedMove.QualifiedMove where
showsNotation moveNotation qualifiedMove = case moveNotation of
ICCFNumeric -> shows $ Notation.ICCFNumeric.mkICCFNumeric' move moveType
PureCoordinate -> shows $ Notation.PureCoordinate.mkPureCoordinate' move moveType
Smith -> shows $ Notation.Smith.fromQualifiedMove qualifiedMove
where
(move, moveType) = Component.QualifiedMove.getMove &&& Component.QualifiedMove.getMoveType $ qualifiedMove
instance ShowNotation Component.Turn.Turn where
showsNotation moveNotation = showsNotation moveNotation . Component.Turn.getQualifiedMove
instance ShowNotation Cartesian.Coordinates.Coordinates where
showsNotation = Notation.Notation.showsCoordinates . getNotation
-- | Show an arbitrary datum using the specified notation.
showNotation :: (ShowNotation a) => MoveNotation -> a -> String
showNotation moveNotation = ($ "") . showsNotation moveNotation
-- | An alternative to 'Property.ShowFloat.ShowFloat', which permits access to a specific move-notation.
class ShowNotationFloat a where
showsNotationFloat :: MoveNotation -> (Double -> ShowS) -> a -> ShowS
-- | Render the specified data in the specified notation, & to the specified number of decimal digits.
showsNotationFloatToNDecimals :: ShowNotationFloat a => MoveNotation -> Type.Count.NDecimalDigits -> a -> ShowS
showsNotationFloatToNDecimals moveNotation = showsNotationFloat moveNotation . Property.ShowFloat.showsFloatToN'