module BishBosh.Attribute.LogicalColour(
ByLogicalColour,
LogicalColour(..),
range,
nDistinctLogicalColours,
listArrayByLogicalColour,
isBlack
) where
import qualified BishBosh.Property.ForsythEdwards as Property.ForsythEdwards
import qualified BishBosh.Property.Opposable as Property.Opposable
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.List.Extra
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified Text.XML.HXT.Arrow.Pickle.Schema
tag :: String
tag = "logicalColour"
data LogicalColour
= Black
| White
deriving (
Bounded,
Enum,
Eq,
Ord,
Read,
Show
)
instance Control.DeepSeq.NFData LogicalColour where
rnf _ = ()
instance Data.Array.IArray.Ix LogicalColour where
range (lower, upper) = Control.Exception.assert (lower == minBound && upper == maxBound) range
inRange (lower, upper) logicalColour = Control.Exception.assert (logicalColour >= lower && logicalColour <= upper) True
index (lower, upper) = Control.Exception.assert (lower == minBound && upper == maxBound) . fromEnum
range :: [LogicalColour]
range = [minBound, maxBound]
nDistinctLogicalColours :: Int
nDistinctLogicalColours = length range
instance HXT.XmlPickler LogicalColour where
xpickle = HXT.xpAttr tag . HXT.xpWrap (read, show) . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range
instance Property.Opposable.Opposable LogicalColour where
getOpposite Black = White
getOpposite _ = Black
instance Property.ForsythEdwards.ReadsFEN LogicalColour where
readsFEN s = case Data.List.Extra.trimStart s of
'b' : remainder -> [(Black, remainder)]
'w' : remainder -> [(White, remainder)]
_ -> []
instance Property.ForsythEdwards.ShowsFEN LogicalColour where
showsFEN logicalColour = showChar $ case logicalColour of
Black -> 'b'
White -> 'w'
isBlack :: LogicalColour -> Bool
{-# INLINE isBlack #-}
isBlack Black = True
isBlack _ = False
isWhite :: LogicalColour -> Bool
isWhite = not . isBlack
type ByLogicalColour = Data.Array.IArray.Array LogicalColour
listArrayByLogicalColour :: Data.Array.IArray.IArray a e => [e] -> a LogicalColour e
{-# INLINE listArrayByLogicalColour #-}
listArrayByLogicalColour = Data.Array.IArray.listArray (minBound, maxBound)