{-# LANGUAGE MultiParamTypeClasses #-}
{-
	Copyright (C) 2021 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@]	Permits discovery within a board.
-}

module BishBosh.StateProperty.Seeker(
-- * Types
-- ** Type-synonyms
--	NPiecesByFile,
	NPiecesByFileByLogicalColour,
-- * Type-classes
	Seeker(..),
-- * Functions
	accumulatePawnsByFile,
	findAllPieces,
	summariseNPawnsByLogicalColour,
	findInvalidity
) where

import			Control.Arrow((&&&), (***))
import			Data.Array.IArray((!))
import qualified	BishBosh.Attribute.Rank			as Attribute.Rank
import qualified	BishBosh.Cartesian.Coordinates		as Cartesian.Coordinates
import qualified	BishBosh.Cartesian.Ordinate		as Cartesian.Ordinate
import qualified	BishBosh.Colour.LogicalColour		as Colour.LogicalColour
import qualified	BishBosh.Component.Piece		as Component.Piece
import qualified	BishBosh.Property.Empty			as Property.Empty
import qualified	BishBosh.Property.SelfValidating	as Property.SelfValidating
import qualified	BishBosh.Type.Count			as Type.Count
import qualified	BishBosh.Type.Length			as Type.Length
import qualified	Control.Arrow
import qualified	Data.Array.IArray
import qualified	Data.Foldable
import qualified	Data.List
import qualified	Data.Map.Strict				as Map

-- | The number of /piece/s in each file, for each /logical colour/.
type NPiecesByFile	= Map.Map Type.Length.X Type.Count.NPieces

-- | Add a Pawn's file to the map.
accumulatePawnsByFile :: Type.Length.X -> NPiecesByFile -> NPiecesByFile
{-# INLINE accumulatePawnsByFile #-}
accumulatePawnsByFile :: X -> NPiecesByFile -> NPiecesByFile
accumulatePawnsByFile	= (X -> X -> NPiecesByFile -> NPiecesByFile)
-> X -> X -> NPiecesByFile -> NPiecesByFile
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((X -> X -> X) -> X -> X -> NPiecesByFile -> NPiecesByFile
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((X -> X -> X) -> X -> X -> NPiecesByFile -> NPiecesByFile)
-> (X -> X -> X) -> X -> X -> NPiecesByFile -> NPiecesByFile
forall a b. (a -> b) -> a -> b
$ (X -> X) -> X -> X -> X
forall a b. a -> b -> a
const X -> X
forall a. Enum a => a -> a
succ) X
1

-- | The number of /piece/s in each file, for each /logical colour/.
type NPiecesByFileByLogicalColour	= Colour.LogicalColour.ArrayByLogicalColour NPiecesByFile

-- | An interface which may be implemented by data which can search the board.
class Seeker seeker where
	-- | Locate any @Knight@s capable of taking a /piece/ at the specified /coordinates/.
	findProximateKnights
		:: seeker
		-> Colour.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the @Knight@ for which to search.
		-> Cartesian.Coordinates.Coordinates	-- ^ The destination to which the @Knight@ is required to be capable of jumping.
		-> [Cartesian.Coordinates.Coordinates]

	-- | Locate any /piece/s satisfying the specified predicate.
	findPieces
		:: (Component.Piece.Piece -> Bool)	-- ^ Predicate.
		-> seeker
		-> [Component.Piece.LocatedPiece]

	{- |
		* Counts the number of @Pawn@s of each /logical colour/ with similar /x/-coordinates; their /y/-coordinate is irrelevant.

		* N.B.: files lacking any @Pawn@, don't feature in the results.
	-}
	countPawnsByFileByLogicalColour :: seeker -> NPiecesByFileByLogicalColour
	countPawnsByFileByLogicalColour	= (
		\(NPiecesByFile
mB, NPiecesByFile
mW) -> [NPiecesByFile] -> NPiecesByFileByLogicalColour
forall (a :: * -> * -> *) e. IArray a e => [e] -> a LogicalColour e
Colour.LogicalColour.listArrayByLogicalColour [NPiecesByFile
mB, NPiecesByFile
mW]
	 ) ((NPiecesByFile, NPiecesByFile) -> NPiecesByFileByLogicalColour)
-> (seeker -> (NPiecesByFile, NPiecesByFile))
-> seeker
-> NPiecesByFileByLogicalColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocatedPiece
 -> (NPiecesByFile, NPiecesByFile)
 -> (NPiecesByFile, NPiecesByFile))
-> (NPiecesByFile, NPiecesByFile)
-> [LocatedPiece]
-> (NPiecesByFile, NPiecesByFile)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
		(
			\(X
x, Bool
isBlack) -> (
				if Bool
isBlack then (NPiecesByFile -> NPiecesByFile)
-> (NPiecesByFile, NPiecesByFile) -> (NPiecesByFile, NPiecesByFile)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first else (NPiecesByFile -> NPiecesByFile)
-> (NPiecesByFile, NPiecesByFile) -> (NPiecesByFile, NPiecesByFile)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Control.Arrow.second	-- Select the appropriate map.
			) ((NPiecesByFile -> NPiecesByFile)
 -> (NPiecesByFile, NPiecesByFile)
 -> (NPiecesByFile, NPiecesByFile))
-> (NPiecesByFile -> NPiecesByFile)
-> (NPiecesByFile, NPiecesByFile)
-> (NPiecesByFile, NPiecesByFile)
forall a b. (a -> b) -> a -> b
$ X -> NPiecesByFile -> NPiecesByFile
accumulatePawnsByFile X
x
		) ((X, Bool)
 -> (NPiecesByFile, NPiecesByFile)
 -> (NPiecesByFile, NPiecesByFile))
-> (LocatedPiece -> (X, Bool))
-> LocatedPiece
-> (NPiecesByFile, NPiecesByFile)
-> (NPiecesByFile, NPiecesByFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
			Coordinates -> X
Cartesian.Coordinates.getX (Coordinates -> X) -> (Piece -> Bool) -> LocatedPiece -> (X, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** LogicalColour -> Bool
Colour.LogicalColour.isBlack (LogicalColour -> Bool)
-> (Piece -> LogicalColour) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> LogicalColour
Component.Piece.getLogicalColour
		)
	 ) (NPiecesByFile, NPiecesByFile)
forall a. Empty a => a
Property.Empty.empty ([LocatedPiece] -> (NPiecesByFile, NPiecesByFile))
-> (seeker -> [LocatedPiece])
-> seeker
-> (NPiecesByFile, NPiecesByFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Piece -> Bool) -> seeker -> [LocatedPiece]
forall seeker.
Seeker seeker =>
(Piece -> Bool) -> seeker -> [LocatedPiece]
findPieces Piece -> Bool
Component.Piece.isPawn

-- | Locate all /piece/s on the board.
findAllPieces :: Seeker seeker => seeker -> [Component.Piece.LocatedPiece]
findAllPieces :: seeker -> [LocatedPiece]
findAllPieces	= (Piece -> Bool) -> seeker -> [LocatedPiece]
forall seeker.
Seeker seeker =>
(Piece -> Bool) -> seeker -> [LocatedPiece]
findPieces ((Piece -> Bool) -> seeker -> [LocatedPiece])
-> (Piece -> Bool) -> seeker -> [LocatedPiece]
forall a b. (a -> b) -> a -> b
$ Bool -> Piece -> Bool
forall a b. a -> b -> a
const Bool
True

-- | Resolves 'NPiecesByFileByLogicalColour' into the total number of /Pawn/s on either side.
summariseNPawnsByLogicalColour :: Seeker seeker => seeker -> Colour.LogicalColour.ArrayByLogicalColour Type.Count.NPieces
summariseNPawnsByLogicalColour :: seeker -> ArrayByLogicalColour X
summariseNPawnsByLogicalColour	= (NPiecesByFile -> X)
-> NPiecesByFileByLogicalColour -> ArrayByLogicalColour X
forall (a :: * -> * -> *) e' e i.
(IArray a e', IArray a e, Ix i) =>
(e' -> e) -> a i e' -> a i e
Data.Array.IArray.amap (
	(X -> X -> X) -> X -> NPiecesByFile -> X
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' X -> X -> X
forall a. Num a => a -> a -> a
(+) X
0
 ) (NPiecesByFileByLogicalColour -> ArrayByLogicalColour X)
-> (seeker -> NPiecesByFileByLogicalColour)
-> seeker
-> ArrayByLogicalColour X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. seeker -> NPiecesByFileByLogicalColour
forall seeker.
Seeker seeker =>
seeker -> NPiecesByFileByLogicalColour
countPawnsByFileByLogicalColour

-- | Self-validate.
findInvalidity :: Seeker seeker => seeker -> [String]
findInvalidity :: seeker -> [String]
findInvalidity	= [(seeker -> Bool, String)] -> seeker -> [String]
forall selfValidator.
[(selfValidator -> Bool, String)] -> selfValidator -> [String]
Property.SelfValidating.findErrors [
	(
		(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (seeker -> (Bool, Bool)) -> seeker -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Piece] -> Bool)
 -> ([Piece] -> Bool) -> ([Piece], [Piece]) -> (Bool, Bool))
-> ([Piece] -> Bool, [Piece] -> Bool)
-> ([Piece], [Piece])
-> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([Piece] -> Bool)
-> ([Piece] -> Bool) -> ([Piece], [Piece]) -> (Bool, Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) (
			([Piece] -> Bool) -> [Piece] -> Bool
forall a. a -> a
id (([Piece] -> Bool) -> [Piece] -> Bool)
-> (([Piece] -> Bool) -> [Piece] -> Bool)
-> ([Piece] -> Bool)
-> ([Piece] -> Bool, [Piece] -> Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ([Piece] -> Bool) -> [Piece] -> Bool
forall a. a -> a
id (([Piece] -> Bool) -> ([Piece] -> Bool, [Piece] -> Bool))
-> ([Piece] -> Bool) -> ([Piece] -> Bool, [Piece] -> Bool)
forall a b. (a -> b) -> a -> b
$ (X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> ArrayByRank X
Attribute.Rank.initialAllocationByRankPerSide ArrayByRank X -> Rank -> X
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Rank
Attribute.Rank.Pawn) (X -> Bool) -> ([Piece] -> X) -> [Piece] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> X
forall a b. (Integral a, Num b) => a -> b
fromIntegral (X -> X) -> ([Piece] -> X) -> [Piece] -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Piece] -> X
forall (t :: * -> *) a. Foldable t => t a -> X
length
		) (([Piece], [Piece]) -> (Bool, Bool))
-> (seeker -> ([Piece], [Piece])) -> seeker -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Piece -> Bool) -> [Piece] -> ([Piece], [Piece])
forall a. (a -> Bool) -> [a] -> ([a], [a])
Data.List.partition (
			LogicalColour -> Bool
Colour.LogicalColour.isBlack (LogicalColour -> Bool)
-> (Piece -> LogicalColour) -> Piece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> LogicalColour
Component.Piece.getLogicalColour
		) ([Piece] -> ([Piece], [Piece]))
-> (seeker -> [Piece]) -> seeker -> ([Piece], [Piece])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocatedPiece -> Piece) -> [LocatedPiece] -> [Piece]
forall a b. (a -> b) -> [a] -> [b]
map LocatedPiece -> Piece
forall a b. (a, b) -> b
snd {-piece-} ([LocatedPiece] -> [Piece])
-> (seeker -> [LocatedPiece]) -> seeker -> [Piece]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Piece -> Bool) -> seeker -> [LocatedPiece]
forall seeker.
Seeker seeker =>
(Piece -> Bool) -> seeker -> [LocatedPiece]
findPieces Piece -> Bool
Component.Piece.isPawn,
		String
"there are too many Pawns of at least one logical colour."
	), (
		(LocatedPiece -> Bool) -> [LocatedPiece] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (
			(Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (LocatedPiece -> (Bool, Bool)) -> LocatedPiece -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((X -> Bool) -> (X -> Bool) -> X -> (Bool, Bool))
-> (X -> Bool, X -> Bool) -> X -> (Bool, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (X -> Bool) -> (X -> Bool) -> X -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) (
				X -> X -> Bool
forall a. Eq a => a -> a -> Bool
(==) (X -> X -> Bool)
-> (X -> X -> Bool) -> (X, X) -> (X -> Bool, X -> Bool)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** X -> X -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((X, X) -> (X -> Bool, X -> Bool))
-> (X, X) -> (X -> Bool, X -> Bool)
forall a b. (a -> b) -> a -> b
$ (X, X)
Cartesian.Ordinate.yBounds
			) (X -> (Bool, Bool))
-> (LocatedPiece -> X) -> LocatedPiece -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coordinates -> X
Cartesian.Coordinates.getY (Coordinates -> X)
-> (LocatedPiece -> Coordinates) -> LocatedPiece -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedPiece -> Coordinates
forall a b. (a, b) -> a
fst {-coordinates-}
		) ([LocatedPiece] -> Bool)
-> (seeker -> [LocatedPiece]) -> seeker -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Piece -> Bool) -> seeker -> [LocatedPiece]
forall seeker.
Seeker seeker =>
(Piece -> Bool) -> seeker -> [LocatedPiece]
findPieces Piece -> Bool
Component.Piece.isPawn,
		String
"no Pawn can exist on either of the terminal ranks."
	)
 ]