{-# LANGUAGE LambdaCase #-}
{-
	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 result of a /game/.
-}

module BishBosh.Rule.Result(
-- * Types
-- ** Data-types
	Result(
--		VictoryBy,
--		Draw
	),
-- * Function
	findMaybeVictor,
-- ** Constructor
	mkResult,
-- ** Predicates
	isDraw
) where

import qualified	BishBosh.Attribute.LogicalColour	as Attribute.LogicalColour
import qualified	BishBosh.Property.FixedMembership	as Property.FixedMembership
import qualified	BishBosh.Property.Opposable		as Property.Opposable
import qualified	Control.DeepSeq
import qualified	Data.List.Extra

-- | The sum-type of ways in which a game can legally be terminated.
data Result
	= VictoryBy Attribute.LogicalColour.LogicalColour	-- ^ The /logical colour/ of the victor.
	| Draw
	deriving Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq

instance Control.DeepSeq.NFData Result where
	rnf :: Result -> ()
rnf (VictoryBy LogicalColour
logicalColour)	= LogicalColour -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf LogicalColour
logicalColour
	rnf Result
Draw			= ()

-- | Convert a game-termination reason into PGN's @Result@ field; <https://www.chessclub.com/help/pgn-spec>.
instance Show Result where
	showsPrec :: Int -> Result -> ShowS
showsPrec Int
_	= (
		\(ShowS
showsWhiteResult, ShowS
showsBlackResult) -> ShowS
showsWhiteResult ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'-' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsBlackResult
	 ) ((ShowS, ShowS) -> ShowS)
-> (Result -> (ShowS, ShowS)) -> Result -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
		VictoryBy LogicalColour
Attribute.LogicalColour.Black -> (ShowS
lose, ShowS
win)
		VictoryBy LogicalColour
_				-> (ShowS
win, ShowS
lose)
		Result
_					-> (ShowS
draw, ShowS
draw)
		where
			lose :: ShowS
lose	= Char -> ShowS
showChar Char
'0'
			win :: ShowS
win	= Char -> ShowS
showChar Char
'1'
			draw :: ShowS
draw	= String -> ShowS
showString String
"1/2"

instance Read Result where
	readsPrec :: Int -> ReadS Result
readsPrec Int
_ String
s	= case ShowS
Data.List.Extra.trimStart String
s of
		Char
'0' : Char
'-' : Char
'1' : String
remainder				-> [(LogicalColour -> Result
VictoryBy LogicalColour
Attribute.LogicalColour.Black, String
remainder)]
		Char
'1' : Char
'-' : Char
'0' : String
remainder				-> [(LogicalColour -> Result
VictoryBy LogicalColour
Attribute.LogicalColour.White, String
remainder)]
		Char
'1' : Char
'/' : Char
'2' : Char
'-' : Char
'1' : Char
'/' : Char
'2' : String
remainder	-> [(Result
Draw, String
remainder)]
		String
_							-> []	-- No Parse.

instance Property.Opposable.Opposable Result where
	getOpposite :: Result -> Result
getOpposite (VictoryBy LogicalColour
logicalColour)	= LogicalColour -> Result
VictoryBy (LogicalColour -> Result) -> LogicalColour -> Result
forall a b. (a -> b) -> a -> b
$ LogicalColour -> LogicalColour
forall a. Opposable a => a -> a
Property.Opposable.getOpposite LogicalColour
logicalColour
	getOpposite Result
_				= Result
Draw

instance Property.FixedMembership.FixedMembership Result where
	members :: [Result]
members	= Result
Draw Result -> [Result] -> [Result]
forall a. a -> [a] -> [a]
: (LogicalColour -> Result) -> [LogicalColour] -> [Result]
forall a b. (a -> b) -> [a] -> [b]
map LogicalColour -> Result
VictoryBy [LogicalColour]
forall a. FixedMembership a => [a]
Property.FixedMembership.members

-- | Constructor.
mkResult :: Maybe Attribute.LogicalColour.LogicalColour -> Result
mkResult :: Maybe LogicalColour -> Result
mkResult (Just LogicalColour
logicalColour)	= LogicalColour -> Result
VictoryBy LogicalColour
logicalColour
mkResult Maybe LogicalColour
_			= Result
Draw

-- | Whether the game was drawn.
isDraw :: Result -> Bool
isDraw :: Result -> Bool
isDraw Result
Draw	= Bool
True
isDraw Result
_	= Bool
False

-- | Find any winner.
findMaybeVictor :: Result -> Maybe Attribute.LogicalColour.LogicalColour
findMaybeVictor :: Result -> Maybe LogicalColour
findMaybeVictor (VictoryBy LogicalColour
logicalColour)	= LogicalColour -> Maybe LogicalColour
forall a. a -> Maybe a
Just LogicalColour
logicalColour
findMaybeVictor Result
_				= Maybe LogicalColour
forall a. Maybe a
Nothing