{-
	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 <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Defines the value for each type of piece, of occupying different squares.

	* This metric includes aspects of both control of the centre, & material advantage,
	in that a side's score can increase either by occupying more valuable squares or simply by having more pieces.

	* N.B.: the evaluation of fitness by "material" COULD be entirely built into these tables, so that the average value for a @Queen@ is ~9 times that for a @Pawn@,
	but under these circumstances a non-zero material value for a @King@ must be arbitrarily chosen.

	* N.B. The normal & end-game phases are typically represented by independent instances.
-}

module BishBosh.Input.PieceSquareTable(
-- * Types
-- ** Data-types
	PieceSquareTable(
--		MkPieceSquareTable,
--		getReflectOnY,
		getByRank
	),
-- * Constants
	tag,
	reflectOnYTag,
-- * Functions
--	mirror,
--	unmirror,
	findUndefinedRanks,
	dereference,
-- ** Constructors
	mkPieceSquareTable
) where

import			BishBosh.Data.Bool()	-- HXT.XmlPickler.
import			Control.Arrow((***))
import qualified	BishBosh.Attribute.Rank		as Attribute.Rank
import qualified	BishBosh.Cartesian.Abscissa	as Cartesian.Abscissa
import qualified	BishBosh.Cartesian.Coordinates	as Cartesian.Coordinates
import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Data.Num		as Data.Num
import qualified	BishBosh.Property.ShowFloat	as Property.ShowFloat
import qualified	BishBosh.Text.ShowList		as Text.ShowList
import qualified	Control.Arrow
import qualified	Control.Exception
import qualified	Data.Array.IArray
import qualified	Data.Default
import qualified	Data.Map
import qualified	Data.Set
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

-- | Used to qualify XML.
tag :: String
tag :: String
tag		= String
"pieceSquareTable"

-- | Used to qualify XML.
reflectOnYTag :: String
reflectOnYTag :: String
reflectOnYTag	= String
"reflectOnY"

-- | Defines the value for each type of piece, of occupying each square.
data PieceSquareTable x y pieceSquareValue	= MkPieceSquareTable {
	PieceSquareTable x y pieceSquareValue -> Bool
getReflectOnY	:: Bool,	-- ^ Whether values for the RHS of the board should be inferred by reflection about the y-axis.
	PieceSquareTable x y pieceSquareValue
-> Map Rank (ByCoordinates x y pieceSquareValue)
getByRank	:: Data.Map.Map Attribute.Rank.Rank (
		Cartesian.Coordinates.ByCoordinates x y pieceSquareValue
	)				-- ^ N.B.: on the assumption that the values for Black pieces are the reflection of those for White, merely the /rank/ of each /piece/ need be defined.
} deriving (PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Bool
(PieceSquareTable x y pieceSquareValue
 -> PieceSquareTable x y pieceSquareValue -> Bool)
-> (PieceSquareTable x y pieceSquareValue
    -> PieceSquareTable x y pieceSquareValue -> Bool)
-> Eq (PieceSquareTable x y pieceSquareValue)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Eq pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Bool
/= :: PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Bool
$c/= :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Eq pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Bool
== :: PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Bool
$c== :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Eq pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue
-> PieceSquareTable x y pieceSquareValue -> Bool
Eq, Int -> PieceSquareTable x y pieceSquareValue -> ShowS
[PieceSquareTable x y pieceSquareValue] -> ShowS
PieceSquareTable x y pieceSquareValue -> String
(Int -> PieceSquareTable x y pieceSquareValue -> ShowS)
-> (PieceSquareTable x y pieceSquareValue -> String)
-> ([PieceSquareTable x y pieceSquareValue] -> ShowS)
-> Show (PieceSquareTable x y pieceSquareValue)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
Int -> PieceSquareTable x y pieceSquareValue -> ShowS
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
[PieceSquareTable x y pieceSquareValue] -> ShowS
forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue -> String
showList :: [PieceSquareTable x y pieceSquareValue] -> ShowS
$cshowList :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
[PieceSquareTable x y pieceSquareValue] -> ShowS
show :: PieceSquareTable x y pieceSquareValue -> String
$cshow :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
PieceSquareTable x y pieceSquareValue -> String
showsPrec :: Int -> PieceSquareTable x y pieceSquareValue -> ShowS
$cshowsPrec :: forall x y pieceSquareValue.
(Enum x, Enum y, Ord x, Ord y, Show x, Show y,
 Show pieceSquareValue) =>
Int -> PieceSquareTable x y pieceSquareValue -> ShowS
Show)

instance (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y,
	Real	pieceSquareValue,
	Show	pieceSquareValue
 ) => Property.ShowFloat.ShowFloat (PieceSquareTable x y pieceSquareValue) where
	showsFloat :: (Double -> ShowS) -> PieceSquareTable x y pieceSquareValue -> ShowS
showsFloat Double -> ShowS
fromDouble MkPieceSquareTable {
		getReflectOnY :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Bool
getReflectOnY	= Bool
reflectOnY,
		getByRank :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue
-> Map Rank (ByCoordinates x y pieceSquareValue)
getByRank	= Map Rank (ByCoordinates x y pieceSquareValue)
byRank
	} = ShowS -> [(String, ShowS)] -> ShowS
Text.ShowList.showsAssociationList ShowS
Text.ShowList.showsSeparator ([(String, ShowS)] -> ShowS) -> [(String, ShowS)] -> ShowS
forall a b. (a -> b) -> a -> b
$ (
		String
reflectOnYTag,
		Bool -> ShowS
forall a. Show a => a -> ShowS
shows Bool
reflectOnY
	 ) (String, ShowS) -> [(String, ShowS)] -> [(String, ShowS)]
forall a. a -> [a] -> [a]
: ((Rank, ByCoordinates x y pieceSquareValue) -> (String, ShowS))
-> [(Rank, ByCoordinates x y pieceSquareValue)]
-> [(String, ShowS)]
forall a b. (a -> b) -> [a] -> [b]
map (
		Rank -> String
forall a. Show a => a -> String
show {-rank-} (Rank -> String)
-> (ByCoordinates x y pieceSquareValue -> ShowS)
-> (Rank, ByCoordinates x y pieceSquareValue)
-> (String, ShowS)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (pieceSquareValue -> ShowS) -> [pieceSquareValue] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
Text.ShowList.showsFormattedList' (
			Double -> ShowS
fromDouble (Double -> ShowS)
-> (pieceSquareValue -> Double) -> pieceSquareValue -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pieceSquareValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
		) ([pieceSquareValue] -> ShowS)
-> (ByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> ByCoordinates x y pieceSquareValue
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			if Bool
reflectOnY
				then [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
unmirror
				else [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> a
id
		) ([pieceSquareValue] -> [pieceSquareValue])
-> (ByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> ByCoordinates x y pieceSquareValue
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByCoordinates x y pieceSquareValue -> [pieceSquareValue]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems
	 ) (
		Map Rank (ByCoordinates x y pieceSquareValue)
-> [(Rank, ByCoordinates x y pieceSquareValue)]
forall k a. Map k a -> [(k, a)]
Data.Map.assocs Map Rank (ByCoordinates x y pieceSquareValue)
byRank
	 )

instance Data.Default.Default (PieceSquareTable x y pieceSquareValue) where
	def :: PieceSquareTable x y pieceSquareValue
def = MkPieceSquareTable :: forall x y pieceSquareValue.
Bool
-> Map Rank (ByCoordinates x y pieceSquareValue)
-> PieceSquareTable x y pieceSquareValue
MkPieceSquareTable {
		getReflectOnY :: Bool
getReflectOnY	= Bool
True,
		getByRank :: Map Rank (ByCoordinates x y pieceSquareValue)
getByRank	= Map Rank (ByCoordinates x y pieceSquareValue)
forall k a. Map k a
Data.Map.empty
	}

instance (
	Enum		x,
	Enum		y,
	Fractional	pieceSquareValue,
	Ord		pieceSquareValue,
	Ord		x,
	Ord		y,
	Real		pieceSquareValue,
	Show		pieceSquareValue
 ) => HXT.XmlPickler (PieceSquareTable x y pieceSquareValue) where
	xpickle :: PU (PieceSquareTable x y pieceSquareValue)
xpickle	= ((Bool, [(Rank, [pieceSquareValue])])
 -> PieceSquareTable x y pieceSquareValue,
 PieceSquareTable x y pieceSquareValue
 -> (Bool, [(Rank, [pieceSquareValue])]))
-> PU (Bool, [(Rank, [pieceSquareValue])])
-> PU (PieceSquareTable x y pieceSquareValue)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
		(Bool
 -> [(Rank, [pieceSquareValue])]
 -> PieceSquareTable x y pieceSquareValue)
-> (Bool, [(Rank, [pieceSquareValue])])
-> PieceSquareTable x y pieceSquareValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool
-> [(Rank, [pieceSquareValue])]
-> PieceSquareTable x y pieceSquareValue
forall x y pieceSquareValue.
(Enum x, Enum y, Num pieceSquareValue, Ord pieceSquareValue, Ord x,
 Ord y, Show pieceSquareValue) =>
Bool
-> [(Rank, [pieceSquareValue])]
-> PieceSquareTable x y pieceSquareValue
mkPieceSquareTable,
		\MkPieceSquareTable {
			getReflectOnY :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Bool
getReflectOnY	= Bool
reflectOnY,
			getByRank :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue
-> Map Rank (ByCoordinates x y pieceSquareValue)
getByRank	= Map Rank (ByCoordinates x y pieceSquareValue)
byRank
		} -> (
			Bool
reflectOnY,
			Map Rank [pieceSquareValue] -> [(Rank, [pieceSquareValue])]
forall k a. Map k a -> [(k, a)]
Data.Map.assocs (Map Rank [pieceSquareValue] -> [(Rank, [pieceSquareValue])])
-> Map Rank [pieceSquareValue] -> [(Rank, [pieceSquareValue])]
forall a b. (a -> b) -> a -> b
$ (ByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> Map Rank (ByCoordinates x y pieceSquareValue)
-> Map Rank [pieceSquareValue]
forall a b k. (a -> b) -> Map k a -> Map k b
Data.Map.map (
				(
					if Bool
reflectOnY
						then [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
unmirror
						else [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> a
id
				) ([pieceSquareValue] -> [pieceSquareValue])
-> (ByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> ByCoordinates x y pieceSquareValue
-> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByCoordinates x y pieceSquareValue -> [pieceSquareValue]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems
			) Map Rank (ByCoordinates x y pieceSquareValue)
byRank
		) -- Pair.
	 ) (PU (Bool, [(Rank, [pieceSquareValue])])
 -> PU (PieceSquareTable x y pieceSquareValue))
-> PU (Bool, [(Rank, [pieceSquareValue])])
-> PU (PieceSquareTable x y pieceSquareValue)
forall a b. (a -> b) -> a -> b
$ (
		PieceSquareTable Any Any Any -> Bool
forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue -> Bool
getReflectOnY PieceSquareTable Any Any Any
forall a. Default a => a
Data.Default.def Bool -> PU Bool -> PU Bool
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU Bool -> PU Bool
forall a. String -> PU a -> PU a
HXT.xpAttr String
reflectOnYTag PU Bool
forall a. XmlPickler a => PU a
HXT.xpickle {-Bool-}
	 ) PU Bool
-> PU [(Rank, [pieceSquareValue])]
-> PU (Bool, [(Rank, [pieceSquareValue])])
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` PU (Rank, [pieceSquareValue]) -> PU [(Rank, [pieceSquareValue])]
forall a. PU a -> PU [a]
HXT.xpList1 (
		String
-> PU (Rank, [pieceSquareValue]) -> PU (Rank, [pieceSquareValue])
forall a. String -> PU a -> PU a
HXT.xpElem String
"byRank" (PU (Rank, [pieceSquareValue]) -> PU (Rank, [pieceSquareValue]))
-> PU (Rank, [pieceSquareValue]) -> PU (Rank, [pieceSquareValue])
forall a b. (a -> b) -> a -> b
$ PU Rank
forall a. XmlPickler a => PU a
HXT.xpickle {-rank-} PU Rank -> PU [pieceSquareValue] -> PU (Rank, [pieceSquareValue])
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` (String -> [pieceSquareValue], [pieceSquareValue] -> String)
-> PU String -> PU [pieceSquareValue]
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
			\String
s -> [
				Double -> pieceSquareValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double
pieceSquareValue :: Double) |
					String
word			<- String -> [String]
words String
s,
					(Double
pieceSquareValue, String
"")	<- ReadS Double
forall a. Read a => ReadS a
reads String
word
			], -- List-comprehension.
			[String] -> String
unwords ([String] -> String)
-> ([pieceSquareValue] -> [String]) -> [pieceSquareValue] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (pieceSquareValue -> String) -> [pieceSquareValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> String
forall a. Show a => a -> String
show (Double -> String)
-> (pieceSquareValue -> Double) -> pieceSquareValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\pieceSquareValue
pieceSquareValue -> pieceSquareValue -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac pieceSquareValue
pieceSquareValue :: Double))
		 ) (String -> PU String
HXT.xpTextAttr String
"byCoordinates")
	 )

-- | Generates a mirror-symmetric RHS, to build a complete description.
mirror :: Show pieceSquareValue => [pieceSquareValue] -> [pieceSquareValue]
mirror :: [pieceSquareValue] -> [pieceSquareValue]
mirror (pieceSquareValue
a : pieceSquareValue
b : pieceSquareValue
c : pieceSquareValue
d : [pieceSquareValue]
remainder)	= pieceSquareValue
a pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
b pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
c pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
d pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
d pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
c pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
b pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
a pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
mirror [pieceSquareValue]
remainder
mirror []				= []
mirror [pieceSquareValue]
pieceSquareValues		= Exception -> [pieceSquareValue]
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> [pieceSquareValue])
-> (String -> Exception) -> String -> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PieceSquareTable.mirror:\tthe number of piece-square values must be a multiple of " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> [pieceSquareValue]) -> String -> [pieceSquareValue]
forall a b. (a -> b) -> a -> b
$ [pieceSquareValue] -> ShowS
forall a. Show a => a -> ShowS
shows [pieceSquareValue]
pieceSquareValues String
"."

-- | Removes the mirror-symmetric RHS, for a concise description.
unmirror :: Show pieceSquareValue => [pieceSquareValue] -> [pieceSquareValue]
unmirror :: [pieceSquareValue] -> [pieceSquareValue]
unmirror (pieceSquareValue
a : pieceSquareValue
b : pieceSquareValue
c : pieceSquareValue
d : [pieceSquareValue]
remainder)	= pieceSquareValue
a pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
b pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
c pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: pieceSquareValue
d pieceSquareValue -> [pieceSquareValue] -> [pieceSquareValue]
forall a. a -> [a] -> [a]
: [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
unmirror (Int -> [pieceSquareValue] -> [pieceSquareValue]
forall a. Int -> [a] -> [a]
drop (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [pieceSquareValue]
remainder)
unmirror []				= []
unmirror [pieceSquareValue]
pieceSquareValues		= Exception -> [pieceSquareValue]
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> [pieceSquareValue])
-> (String -> Exception) -> String -> [pieceSquareValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PieceSquareTable.unmirror:\tthe number of piece-square values must be a multiple of " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int
Cartesian.Abscissa.xLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; " (String -> [pieceSquareValue]) -> String -> [pieceSquareValue]
forall a b. (a -> b) -> a -> b
$ [pieceSquareValue] -> ShowS
forall a. Show a => a -> ShowS
shows [pieceSquareValue]
pieceSquareValues String
"."

-- | Smart constructor.
mkPieceSquareTable :: (
	Enum	x,
	Enum	y,
	Num	pieceSquareValue,
	Ord	pieceSquareValue,
	Ord	x,
	Ord	y,
	Show	pieceSquareValue
 )
	=> Bool	-- ^ Whether values for the RHS of the board are inferred by reflection about the y-axis.
	-> [(Attribute.Rank.Rank, [pieceSquareValue])]
	-> PieceSquareTable x y pieceSquareValue
mkPieceSquareTable :: Bool
-> [(Rank, [pieceSquareValue])]
-> PieceSquareTable x y pieceSquareValue
mkPieceSquareTable Bool
reflectOnY [(Rank, [pieceSquareValue])]
assocs
	| ((Rank, [pieceSquareValue]) -> Bool)
-> [(Rank, [pieceSquareValue])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
		(Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nValuesRequired) (Int -> Bool)
-> ((Rank, [pieceSquareValue]) -> Int)
-> (Rank, [pieceSquareValue])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [pieceSquareValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([pieceSquareValue] -> Int)
-> ((Rank, [pieceSquareValue]) -> [pieceSquareValue])
-> (Rank, [pieceSquareValue])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, [pieceSquareValue]) -> [pieceSquareValue]
forall a b. (a, b) -> b
snd {-pieceSquareValues-}
	) [(Rank, [pieceSquareValue])]
assocs	= Exception -> PieceSquareTable x y pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable x y pieceSquareValue)
-> (String -> Exception)
-> String
-> PieceSquareTable x y pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PieceSquareTable.mkPieceSquareTable:\texactly " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
nValuesRequired ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" values must be defined for each type of piece; " (String -> PieceSquareTable x y pieceSquareValue)
-> String -> PieceSquareTable x y pieceSquareValue
forall a b. (a -> b) -> a -> b
$ [(Rank, [pieceSquareValue])] -> ShowS
forall a. Show a => a -> ShowS
shows [(Rank, [pieceSquareValue])]
assocs String
"."
	| ((Rank, [pieceSquareValue]) -> Bool)
-> [(Rank, [pieceSquareValue])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
		(pieceSquareValue -> Bool) -> [pieceSquareValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
			Bool -> Bool
not (Bool -> Bool)
-> (pieceSquareValue -> Bool) -> pieceSquareValue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pieceSquareValue -> Bool
forall n. (Num n, Ord n) => n -> Bool
Data.Num.inClosedUnitInterval
		) ([pieceSquareValue] -> Bool)
-> ((Rank, [pieceSquareValue]) -> [pieceSquareValue])
-> (Rank, [pieceSquareValue])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rank, [pieceSquareValue]) -> [pieceSquareValue]
forall a b. (a, b) -> b
snd {-list-}
	) [(Rank, [pieceSquareValue])]
assocs	= Exception -> PieceSquareTable x y pieceSquareValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> PieceSquareTable x y pieceSquareValue)
-> (String -> Exception)
-> String
-> PieceSquareTable x y pieceSquareValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.PieceSquareTable.mkPieceSquareTable:\tall values must be within the closed unit-interval [0,1]; " (String -> PieceSquareTable x y pieceSquareValue)
-> String -> PieceSquareTable x y pieceSquareValue
forall a b. (a -> b) -> a -> b
$ [(Rank, [pieceSquareValue])] -> ShowS
forall a. Show a => a -> ShowS
shows [(Rank, [pieceSquareValue])]
assocs String
"."
	| Bool
otherwise	= MkPieceSquareTable :: forall x y pieceSquareValue.
Bool
-> Map Rank (ByCoordinates x y pieceSquareValue)
-> PieceSquareTable x y pieceSquareValue
MkPieceSquareTable {
		getReflectOnY :: Bool
getReflectOnY	= Bool
reflectOnY,
		getByRank :: Map Rank (ByCoordinates x y pieceSquareValue)
getByRank	= [(Rank, ByCoordinates x y pieceSquareValue)]
-> Map Rank (ByCoordinates x y pieceSquareValue)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList ([(Rank, ByCoordinates x y pieceSquareValue)]
 -> Map Rank (ByCoordinates x y pieceSquareValue))
-> ([(Rank, [pieceSquareValue])]
    -> [(Rank, ByCoordinates x y pieceSquareValue)])
-> [(Rank, [pieceSquareValue])]
-> Map Rank (ByCoordinates x y pieceSquareValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rank, [pieceSquareValue])
 -> (Rank, ByCoordinates x y pieceSquareValue))
-> [(Rank, [pieceSquareValue])]
-> [(Rank, ByCoordinates x y pieceSquareValue)]
forall a b. (a -> b) -> [a] -> [b]
map (([pieceSquareValue] -> ByCoordinates x y pieceSquareValue)
-> (Rank, [pieceSquareValue])
-> (Rank, ByCoordinates x y pieceSquareValue)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [pieceSquareValue] -> ByCoordinates x y pieceSquareValue
forall (a :: * -> * -> *) e x y.
(IArray a e, Enum x, Enum y, Ord x, Ord y) =>
[e] -> a (Coordinates x y) e
Cartesian.Coordinates.listArrayByCoordinates) ([(Rank, [pieceSquareValue])]
 -> Map Rank (ByCoordinates x y pieceSquareValue))
-> [(Rank, [pieceSquareValue])]
-> Map Rank (ByCoordinates x y pieceSquareValue)
forall a b. (a -> b) -> a -> b
$ (
			if Bool
reflectOnY
				then ((Rank, [pieceSquareValue]) -> (Rank, [pieceSquareValue]))
-> [(Rank, [pieceSquareValue])] -> [(Rank, [pieceSquareValue])]
forall a b. (a -> b) -> [a] -> [b]
map (((Rank, [pieceSquareValue]) -> (Rank, [pieceSquareValue]))
 -> [(Rank, [pieceSquareValue])] -> [(Rank, [pieceSquareValue])])
-> ((Rank, [pieceSquareValue]) -> (Rank, [pieceSquareValue]))
-> [(Rank, [pieceSquareValue])]
-> [(Rank, [pieceSquareValue])]
forall a b. (a -> b) -> a -> b
$ ([pieceSquareValue] -> [pieceSquareValue])
-> (Rank, [pieceSquareValue]) -> (Rank, [pieceSquareValue])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second [pieceSquareValue] -> [pieceSquareValue]
forall pieceSquareValue.
Show pieceSquareValue =>
[pieceSquareValue] -> [pieceSquareValue]
mirror
				else [(Rank, [pieceSquareValue])] -> [(Rank, [pieceSquareValue])]
forall a. a -> a
id
		) [(Rank, [pieceSquareValue])]
assocs
	}
	where
		nValuesRequired :: Int
nValuesRequired	= (
			if Bool
reflectOnY
				then (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
				else Int -> Int
forall a. a -> a
id
		 ) Int
Cartesian.Coordinates.nSquares

-- | Identify any /rank/ lacking a definition.
findUndefinedRanks :: PieceSquareTable x y pieceSquareValue -> Data.Set.Set Attribute.Rank.Rank
findUndefinedRanks :: PieceSquareTable x y pieceSquareValue -> Set Rank
findUndefinedRanks MkPieceSquareTable { getByRank :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue
-> Map Rank (ByCoordinates x y pieceSquareValue)
getByRank = Map Rank (ByCoordinates x y pieceSquareValue)
byRank }	= [Rank] -> Set Rank
forall a. Eq a => [a] -> Set a
Data.Set.fromAscList [Rank]
Attribute.Rank.range Set Rank -> Set Rank -> Set Rank
forall a. Ord a => Set a -> Set a -> Set a
`Data.Set.difference` Map Rank (ByCoordinates x y pieceSquareValue) -> Set Rank
forall k a. Map k a -> Set k
Data.Map.keysSet Map Rank (ByCoordinates x y pieceSquareValue)
byRank

-- | Lookup the value for the specified /rank/.
dereference :: (
	Enum	x,
	Enum	y,
	Ord	x,
	Ord	y
 ) => Attribute.Rank.Rank -> PieceSquareTable x y pieceSquareValue -> Maybe [pieceSquareValue]
dereference :: Rank
-> PieceSquareTable x y pieceSquareValue
-> Maybe [pieceSquareValue]
dereference Rank
rank MkPieceSquareTable { getByRank :: forall x y pieceSquareValue.
PieceSquareTable x y pieceSquareValue
-> Map Rank (ByCoordinates x y pieceSquareValue)
getByRank = Map Rank (ByCoordinates x y pieceSquareValue)
byRank}	= ByCoordinates x y pieceSquareValue -> [pieceSquareValue]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Data.Array.IArray.elems (ByCoordinates x y pieceSquareValue -> [pieceSquareValue])
-> Maybe (ByCoordinates x y pieceSquareValue)
-> Maybe [pieceSquareValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Rank
-> Map Rank (ByCoordinates x y pieceSquareValue)
-> Maybe (ByCoordinates x y pieceSquareValue)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup Rank
rank Map Rank (ByCoordinates x y pieceSquareValue)
byRank