{-
	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@]

	* Describes a /direction/ in two parts; the sense of change in the /x/-coordinate & the sense of change in the /y/-coordinate.

	* The IO-format uses a more concise & familiar format based on 8 points of the compass.

	* CAVEAT: this separation of /direction/ into orthogonal components is driven by the typical use-case,
	but requires that one guards against accidental construction of a degenerate 9th /direction/ which defines a change in neither direction.
-}

module BishBosh.Attribute.Direction(
-- * Types
-- ** Type-synonyms
	ArrayByDirection,
-- ** Data-types
	Direction(
--		MkDirection,
		getXDirection,
		getYDirection
	),
-- * Constants
	nw,
	n,
	ne,
	w,
	e,
	sw,
	s,
	se,
	tag,
	nDistinctDirections,
	parallels,
	diagonals,
--	range,
	opposites,
-- * Functions
--	getOpposite,
	advanceDirection,
	attackDirectionsForPawn,
	listArrayByDirection,
-- ** Constructor
	mkDirection,
-- ** Predicates
	areAligned
) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour
import qualified	BishBosh.Data.Exception			as Data.Exception
import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership
import qualified	BishBosh.Property.Opposable		as Property.Opposable
import qualified	BishBosh.Property.Orientated		as Property.Orientated
import qualified	BishBosh.Property.Reflectable		as Property.Reflectable
import qualified	BishBosh.Type.Count			as Type.Count
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

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

-- | Constant direction.
nw :: Direction
nw :: Direction
nw	= Ordering -> Ordering -> Direction
MkDirection Ordering
LT Ordering
GT

-- | Constant direction.
n :: Direction
n :: Direction
n	= Ordering -> Ordering -> Direction
MkDirection Ordering
EQ Ordering
GT

-- | Constant direction.
ne :: Direction
ne :: Direction
ne	= Ordering -> Ordering -> Direction
MkDirection Ordering
GT Ordering
GT

-- | Constant direction.
w :: Direction
w :: Direction
w	= Ordering -> Ordering -> Direction
MkDirection Ordering
LT Ordering
EQ

-- | Constant direction.
e :: Direction
e :: Direction
e	= Ordering -> Ordering -> Direction
MkDirection Ordering
GT Ordering
EQ

-- | Constant direction.
sw :: Direction
sw :: Direction
sw	= Ordering -> Ordering -> Direction
MkDirection Ordering
LT Ordering
LT

-- | Constant direction.
s :: Direction
s :: Direction
s	= Ordering -> Ordering -> Direction
MkDirection Ordering
EQ Ordering
LT

-- | Constant direction.
se :: Direction
se :: Direction
se	= Ordering -> Ordering -> Direction
MkDirection Ordering
GT Ordering
LT

-- | Define a /direction/ by the sense of change to /x/ & /y/ coordinates.
data Direction	= MkDirection {
	Direction -> Ordering
getXDirection	:: ! Ordering,	-- ^ The sense of the change in the /x/-coordinate.
	Direction -> Ordering
getYDirection	:: ! Ordering	-- ^ The sense of the change in the /y/-coordinate.
} deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
$cp1Ord :: Eq Direction
Ord)

instance Bounded Direction where
	minBound :: Direction
minBound	= Direction
sw
	maxBound :: Direction
maxBound	= Direction
ne

instance Control.DeepSeq.NFData Direction where
	rnf :: Direction -> ()
rnf MkDirection {
		getXDirection :: Direction -> Ordering
getXDirection	= Ordering
xDirection,
		getYDirection :: Direction -> Ordering
getYDirection	= Ordering
yDirection
	} = Ordering
xDirection Ordering -> () -> ()
`seq` Ordering
yDirection Ordering -> () -> ()
`seq` ()

instance Show Direction where
	showsPrec :: Int -> Direction -> ShowS
showsPrec Int
_ MkDirection {
		getXDirection :: Direction -> Ordering
getXDirection	= Ordering
xDirection,
		getYDirection :: Direction -> Ordering
getYDirection	= Ordering
yDirection
	} = (
		case Ordering
yDirection of
			Ordering
LT	-> Char -> ShowS
showChar Char
'S'
			Ordering
EQ	-> ShowS
forall a. a -> a
id
			Ordering
GT	-> Char -> ShowS
showChar Char
'N'
	 ) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (
		case Ordering
xDirection of
			Ordering
LT	-> Char -> ShowS
showChar Char
'W'
			Ordering
EQ	-> ShowS
forall a. a -> a
id
			Ordering
GT	-> Char -> ShowS
showChar Char
'E'
	 )

instance Read Direction where
	readsPrec :: Int -> ReadS Direction
readsPrec Int
_ String
ss	= let
		s' :: String
s'	= ShowS
Data.List.Extra.trimStart String
ss
	 in case ShowS
Data.List.Extra.upper String
s' of
		Char
'S' : String
remainder	-> case String
remainder of
			Char
'W' : String
_	-> [(Direction
sw, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
s')]
			Char
'E' : String
_	-> [(Direction
se, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
s')]
			String
_	-> [(Direction
s, ShowS
forall a. [a] -> [a]
tail String
s')]
		Char
'N' : String
remainder	-> case String
remainder of
			Char
'W' : String
_	-> [(Direction
nw, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
s')]
			Char
'E' : String
_	-> [(Direction
ne, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 String
s')]
			String
_	-> [(Direction
n, ShowS
forall a. [a] -> [a]
tail String
s')]
		Char
'W' : String
_	-> [(Direction
w, ShowS
forall a. [a] -> [a]
tail String
s')]
		Char
'E' : String
_	-> [(Direction
e, ShowS
forall a. [a] -> [a]
tail String
s')]
		String
_	-> []	-- No parse.

instance Property.Opposable.Opposable Direction where
	getOpposite :: Direction -> Direction
getOpposite MkDirection {
		getXDirection :: Direction -> Ordering
getXDirection	= Ordering
xDirection,
		getYDirection :: Direction -> Ordering
getYDirection	= Ordering
yDirection
	} = MkDirection :: Ordering -> Ordering -> Direction
MkDirection {
		getXDirection :: Ordering
getXDirection	= Ordering -> Ordering
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Ordering
xDirection,
		getYDirection :: Ordering
getYDirection	= Ordering -> Ordering
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Ordering
yDirection
	}

instance Property.Orientated.Orientated Direction where
	isDiagonal :: Direction -> Bool
isDiagonal MkDirection { getXDirection :: Direction -> Ordering
getXDirection = Ordering
xDirection, getYDirection :: Direction -> Ordering
getYDirection = Ordering
yDirection }	= Ordering
xDirection Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ Bool -> Bool -> Bool
&& Ordering
yDirection Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ
	isParallel :: Direction -> Bool
isParallel MkDirection { getXDirection :: Direction -> Ordering
getXDirection = Ordering
xDirection, getYDirection :: Direction -> Ordering
getYDirection = Ordering
yDirection }	= Ordering
xDirection Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
|| Ordering
yDirection Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
	isStraight :: Direction -> Bool
isStraight										= Bool -> Direction -> Bool
forall a b. a -> b -> a
const Bool
True

instance Property.Reflectable.ReflectableOnX Direction where
	reflectOnX :: Direction -> Direction
reflectOnX direction :: Direction
direction@MkDirection { getYDirection :: Direction -> Ordering
getYDirection = Ordering
yDirection }	= Direction
direction {
		getYDirection :: Ordering
getYDirection	= Ordering -> Ordering
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Ordering
yDirection
	}

instance Property.Reflectable.ReflectableOnY Direction where
	reflectOnY :: Direction -> Direction
reflectOnY direction :: Direction
direction@MkDirection { getXDirection :: Direction -> Ordering
getXDirection = Ordering
xDirection }	= Direction
direction {
		getXDirection :: Ordering
getXDirection	= Ordering -> Ordering
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Ordering
xDirection
	}

instance HXT.XmlPickler Direction where
	xpickle :: PU Direction
xpickle	= (String -> Direction, Direction -> String)
-> PU String -> PU Direction
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (String -> Direction
forall a. Read a => String -> a
read, Direction -> String
forall a. Show a => a -> String
show) (PU String -> PU Direction)
-> ([String] -> PU String) -> [String] -> PU Direction
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 Direction) -> [String] -> PU Direction
forall a b. (a -> b) -> a -> b
$ (Direction -> String) -> [Direction] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Direction -> String
forall a. Show a => a -> String
show [Direction]
range

instance Data.Array.IArray.Ix Direction where
	range :: (Direction, Direction) -> [Direction]
range (Direction
lower, Direction
upper)						= Bool -> [Direction] -> [Direction]
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Direction
lower Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Direction
upper Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
maxBound) [Direction]
forall a. FixedMembership a => [a]
Property.FixedMembership.members
	inRange :: (Direction, Direction) -> Direction -> Bool
inRange (Direction
lower, Direction
upper) Direction
_					= Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Direction
lower Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Direction
upper Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
maxBound) Bool
True
	index :: (Direction, Direction) -> Direction -> Int
index (Direction
lower, Direction
upper) (MkDirection Ordering
xDirection Ordering
yDirection)	= Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (Direction
lower Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Direction
upper Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
forall a. Bounded a => a
maxBound) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ case Ordering
xDirection of
		Ordering
LT	-> case Ordering
yDirection of
			Ordering
LT	-> Int
0
			Ordering
EQ	-> Int
1
			Ordering
GT	-> Int
2
		Ordering
EQ	-> case Ordering
yDirection of
			Ordering
LT	-> Int
3
			Ordering
EQ	-> Exception -> Int
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Int) -> Exception -> Int
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Attribute.Direction.index:\tundefined direction."
			Ordering
GT	-> Int
4
		Ordering
GT	-> case Ordering
yDirection of
			Ordering
LT	-> Int
5
			Ordering
EQ	-> Int
6
			Ordering
GT	-> Int
7

-- | The ordered /direction/s in which /royalty/ can move.
range :: [Direction]
range :: [Direction]
range	= [Direction
sw, Direction
w, Direction
nw, Direction
s, Direction
n, Direction
se, Direction
e, Direction
ne]

instance Property.FixedMembership.FixedMembership Direction where
	members :: [Direction]
members	= [Direction]
range

-- | Smart constructor.
mkDirection
	:: Ordering	-- ^ The sense of the change in the /x/-coordinate.
	-> Ordering	-- ^ The sense of the change in the /y/-coordinate.
	-> Direction
mkDirection :: Ordering -> Ordering -> Direction
mkDirection Ordering
EQ Ordering
EQ			= Exception -> Direction
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Direction) -> Exception -> Direction
forall a b. (a -> b) -> a -> b
$ String -> Exception
Data.Exception.mkResultUndefined String
"BishBosh.Attribute.Direction.mkDirection:\till-defined."
mkDirection Ordering
xDirection Ordering
yDirection	= Ordering -> Ordering -> Direction
MkDirection Ordering
xDirection Ordering
yDirection

-- | The ordered /direction/s in which a @Rook@ can move.
parallels :: [Direction]
parallels :: [Direction]
parallels	= [Direction
w, Direction
s, Direction
n, Direction
e]

-- | The ordered /direction/s in which a @Bishop@ can move.
diagonals :: [Direction]
diagonals :: [Direction]
diagonals	= [Direction
sw, Direction
nw, Direction
se, Direction
ne]

-- | The constant number of distinct /direction/s.
nDistinctDirections :: Type.Count.NDirections
nDistinctDirections :: Int
nDistinctDirections	= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Direction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Direction]
range

{- |
	* Returns a list of /direction/s, each paired with its anti-parallel.

	* CAVEAT: each /direction/ only appears once in the list, on an arbitrary side of a pair.
-}
opposites :: [(Direction, Direction)]
opposites :: [(Direction, Direction)]
opposites	= (Direction -> (Direction, Direction))
-> [Direction] -> [(Direction, Direction)]
forall a b. (a -> b) -> [a] -> [b]
map (Direction -> Direction
forall a. a -> a
id (Direction -> Direction)
-> (Direction -> Direction) -> Direction -> (Direction, Direction)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Direction -> Direction
forall a. Opposable a => a -> a
Property.Opposable.getOpposite) [Direction
sw, Direction
w, Direction
nw, Direction
s]

-- | The /y/-direction in which a @Pawn@ of the specified /logical colour/ advances.
advanceDirection :: Attribute.LogicalColour.LogicalColour -> Ordering
advanceDirection :: LogicalColour -> Ordering
advanceDirection LogicalColour
Attribute.LogicalColour.Black	= Ordering
LT	-- Black moves down.
advanceDirection LogicalColour
_				= Ordering
GT	-- White moves up.

-- | The /direction/s in which a @Pawn@ can attack.
attackDirectionsForPawn :: Attribute.LogicalColour.LogicalColour -> [Direction]
attackDirectionsForPawn :: LogicalColour -> [Direction]
attackDirectionsForPawn LogicalColour
logicalColour	= (Ordering -> Direction) -> [Ordering] -> [Direction]
forall a b. (a -> b) -> [a] -> [b]
map (Ordering -> Ordering -> Direction
`MkDirection` LogicalColour -> Ordering
advanceDirection LogicalColour
logicalColour) [Ordering
LT, Ordering
GT]

-- | Whether the two /direction/s specified, are either parallel or anti-parallel.
areAligned :: Direction -> Direction -> Bool
areAligned :: Direction -> Direction -> Bool
areAligned Direction
direction	= (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (Direction -> (Bool, Bool)) -> Direction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
direction) (Direction -> Bool)
-> (Direction -> Bool) -> Direction -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction -> Direction
forall a. Opposable a => a -> a
Property.Opposable.getOpposite Direction
direction))

-- | A boxed array indexed by /direction/, of arbitrary elements.
type ArrayByDirection	= Data.Array.IArray.Array {-Boxed-} Direction

-- | Array-constructor.
listArrayByDirection :: Data.Array.IArray.IArray a e => [e] -> a Direction e
listArrayByDirection :: [e] -> a Direction e
listArrayByDirection	= (Direction, Direction) -> [e] -> a Direction e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (Direction
forall a. Bounded a => a
minBound, Direction
forall a. Bounded a => a
maxBound)