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

	* The relative value of a /rank/ of chess-piece.

	* <https://en.wikipedia.org/wiki/Chess_piece_relative_value#Hans_Berliner.27s_system%20Chess-piece%20relative%20values>
-}

module BishBosh.Metric.RankValue(
-- * Types
-- ** Data-types
	RankValue(
--		MkRankValue,
--		deconstruct
	),
-- * Constants
--	tag,
-- * Functions
-- ** Constructor
--	mkRankValue
) where

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.Type.Mass		as Type.Mass
import qualified	Control.Arrow
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.List.Extra
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

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

-- | The constant value associated with a /rank/; the higher, the more valuable it is considered to be.
newtype RankValue = MkRankValue {
	RankValue -> RankValue
deconstruct	:: Type.Mass.RankValue
} deriving (RankValue -> RankValue -> Bool
(RankValue -> RankValue -> Bool)
-> (RankValue -> RankValue -> Bool) -> Eq RankValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RankValue -> RankValue -> Bool
$c/= :: RankValue -> RankValue -> Bool
== :: RankValue -> RankValue -> Bool
$c== :: RankValue -> RankValue -> Bool
Eq, Eq RankValue
Eq RankValue
-> (RankValue -> RankValue -> Ordering)
-> (RankValue -> RankValue -> Bool)
-> (RankValue -> RankValue -> Bool)
-> (RankValue -> RankValue -> Bool)
-> (RankValue -> RankValue -> Bool)
-> (RankValue -> RankValue -> RankValue)
-> (RankValue -> RankValue -> RankValue)
-> Ord RankValue
RankValue -> RankValue -> Bool
RankValue -> RankValue -> Ordering
RankValue -> RankValue -> RankValue
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 :: RankValue -> RankValue -> RankValue
$cmin :: RankValue -> RankValue -> RankValue
max :: RankValue -> RankValue -> RankValue
$cmax :: RankValue -> RankValue -> RankValue
>= :: RankValue -> RankValue -> Bool
$c>= :: RankValue -> RankValue -> Bool
> :: RankValue -> RankValue -> Bool
$c> :: RankValue -> RankValue -> Bool
<= :: RankValue -> RankValue -> Bool
$c<= :: RankValue -> RankValue -> Bool
< :: RankValue -> RankValue -> Bool
$c< :: RankValue -> RankValue -> Bool
compare :: RankValue -> RankValue -> Ordering
$ccompare :: RankValue -> RankValue -> Ordering
$cp1Ord :: Eq RankValue
Ord)

instance Show RankValue where
	showsPrec :: Int -> RankValue -> ShowS
showsPrec Int
precision MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
rankValue }	= Int -> RankValue -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precision RankValue
rankValue

instance Read RankValue where
	readsPrec :: Int -> ReadS RankValue
readsPrec Int
precision	= ((RankValue, String) -> (RankValue, String))
-> [(RankValue, String)] -> [(RankValue, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((RankValue -> RankValue)
-> (RankValue, String) -> (RankValue, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first RankValue -> RankValue
mkRankValue) ([(RankValue, String)] -> [(RankValue, String)])
-> (String -> [(RankValue, String)]) -> ReadS RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(RankValue, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
precision (String -> [(RankValue, String)])
-> ShowS -> String -> [(RankValue, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Data.List.Extra.trimStart

instance Property.ShowFloat.ShowFloat RankValue where
	showsFloat :: (RankValue -> ShowS) -> RankValue -> ShowS
showsFloat RankValue -> ShowS
fromDouble MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
rankValue }	= RankValue -> ShowS
fromDouble (RankValue -> ShowS) -> RankValue -> ShowS
forall a b. (a -> b) -> a -> b
$ RankValue -> RankValue
forall a b. (Real a, Fractional b) => a -> b
realToFrac RankValue
rankValue

instance Num RankValue where
	MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
l } + :: RankValue -> RankValue -> RankValue
+ MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
r }	= RankValue -> RankValue
mkRankValue (RankValue -> RankValue) -> RankValue -> RankValue
forall a b. (a -> b) -> a -> b
$ RankValue
l RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
+ RankValue
r
	MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
l } * :: RankValue -> RankValue -> RankValue
* MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
r }	= RankValue -> RankValue
MkRankValue (RankValue -> RankValue) -> RankValue -> RankValue
forall a b. (a -> b) -> a -> b
$ RankValue
l RankValue -> RankValue -> RankValue
forall a. Num a => a -> a -> a
* RankValue
r
	abs :: RankValue -> RankValue
abs MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
rankValue }				= RankValue -> RankValue
MkRankValue (RankValue -> RankValue) -> RankValue -> RankValue
forall a b. (a -> b) -> a -> b
$ RankValue -> RankValue
forall a. Num a => a -> a
abs RankValue
rankValue		-- N.B.: if the operand is valid, then this is equivalent to 'id'.
	signum :: RankValue -> RankValue
signum MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
rankValue }				= RankValue -> RankValue
MkRankValue (RankValue -> RankValue) -> RankValue -> RankValue
forall a b. (a -> b) -> a -> b
$ RankValue -> RankValue
forall a. Num a => a -> a
signum RankValue
rankValue
	fromInteger :: Integer -> RankValue
fromInteger								= RankValue -> RankValue
mkRankValue (RankValue -> RankValue)
-> (Integer -> RankValue) -> Integer -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> RankValue
forall a. Num a => Integer -> a
fromInteger
	negate :: RankValue -> RankValue
negate MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
rankValue }				= RankValue -> RankValue
mkRankValue (RankValue -> RankValue) -> RankValue -> RankValue
forall a b. (a -> b) -> a -> b
$ RankValue -> RankValue
forall a. Num a => a -> a
negate RankValue
rankValue	-- CAVEAT: only valid for '0'.

instance Fractional RankValue where
	MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
l } / :: RankValue -> RankValue -> RankValue
/ MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
r }	= RankValue -> RankValue
mkRankValue (RankValue -> RankValue) -> RankValue -> RankValue
forall a b. (a -> b) -> a -> b
$ RankValue
l RankValue -> RankValue -> RankValue
forall a. Fractional a => a -> a -> a
/ RankValue
r	-- CAVEAT: it's hard to concoct a scenario in which neither the numerator, denominator nor result are invalid.
	fromRational :: Rational -> RankValue
fromRational								= RankValue -> RankValue
mkRankValue (RankValue -> RankValue)
-> (Rational -> RankValue) -> Rational -> RankValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> RankValue
forall a. Fractional a => Rational -> a
fromRational

instance Real RankValue where
	toRational :: RankValue -> Rational
toRational MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
rankValue }	= RankValue -> Rational
forall a. Real a => a -> Rational
toRational RankValue
rankValue

instance Control.DeepSeq.NFData RankValue where
	rnf :: RankValue -> ()
rnf MkRankValue { deconstruct :: RankValue -> RankValue
deconstruct = RankValue
rankValue }	= RankValue -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf RankValue
rankValue

instance HXT.XmlPickler RankValue where
	xpickle :: PU RankValue
xpickle	= (RankValue -> RankValue, RankValue -> RankValue)
-> PU RankValue -> PU RankValue
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (RankValue -> RankValue
mkRankValue, RankValue -> RankValue
deconstruct) (PU RankValue -> PU RankValue) -> PU RankValue -> PU RankValue
forall a b. (a -> b) -> a -> b
$ String -> PU RankValue -> PU RankValue
forall a. String -> PU a -> PU a
HXT.xpAttr String
tag PU RankValue
forall a. XmlPickler a => PU a
HXT.xpickle

-- | Smart constructor.
mkRankValue :: Type.Mass.RankValue -> RankValue
mkRankValue :: RankValue -> RankValue
mkRankValue RankValue
rankValue
	| RankValue -> Bool
forall n. (Num n, Ord n) => n -> Bool
Data.Num.inClosedUnitInterval RankValue
rankValue	= RankValue -> RankValue
MkRankValue RankValue
rankValue
	| Bool
otherwise					= Exception -> RankValue
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> RankValue)
-> (String -> Exception) -> String -> RankValue
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.Metric.RankValue.mkRankValue:\t" (String -> RankValue) -> String -> RankValue
forall a b. (a -> b) -> a -> b
$ RankValue -> ShowS
forall a. Show a => a -> ShowS
shows RankValue
rankValue String
" must be within the closed unit-interval [0,1]."