{-
	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 weight associated with some 'Metric.CriterionValue.CriterionValue'.

	* Each weighting is constrained to the unsigned /closed unit-interval/; negative values aren't permitted.

	* If the /criterion-value/ is considered unimportant, then its weight can be set to @0@, whilst concepts of great significance can be set to @1@.
-}

module BishBosh.Metric.CriterionWeight(
-- * Types
-- ** Data-types
	CriterionWeight(
--		MkCriterionWeight,
--		deconstruct
	)
-- * Functions
-- ** Constructor
--	mkCriterionWeight
) where

import qualified	BishBosh.Data.Exception		as Data.Exception
import qualified	BishBosh.Data.Num		as Data.Num
import qualified	BishBosh.Type.Mass		as Type.Mass
import qualified	Control.DeepSeq
import qualified	Control.Exception
import qualified	Data.Default
import qualified	Text.XML.HXT.Arrow.Pickle	as HXT

{- |
	* Quantifies the relative significance of a /criterion-value/; the larger the weight, the more significant the criterion is relative to other criteria.

	* N.B.: the type-constructor is a peg on which to hang class-instances & its data-constructor guards the permissible bounds.
-}
newtype CriterionWeight	= MkCriterionWeight {
	CriterionWeight -> CriterionWeight
deconstruct	:: Type.Mass.CriterionWeight
} deriving (CriterionWeight -> CriterionWeight -> Bool
(CriterionWeight -> CriterionWeight -> Bool)
-> (CriterionWeight -> CriterionWeight -> Bool)
-> Eq CriterionWeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CriterionWeight -> CriterionWeight -> Bool
$c/= :: CriterionWeight -> CriterionWeight -> Bool
== :: CriterionWeight -> CriterionWeight -> Bool
$c== :: CriterionWeight -> CriterionWeight -> Bool
Eq, Eq CriterionWeight
Eq CriterionWeight
-> (CriterionWeight -> CriterionWeight -> Ordering)
-> (CriterionWeight -> CriterionWeight -> Bool)
-> (CriterionWeight -> CriterionWeight -> Bool)
-> (CriterionWeight -> CriterionWeight -> Bool)
-> (CriterionWeight -> CriterionWeight -> Bool)
-> (CriterionWeight -> CriterionWeight -> CriterionWeight)
-> (CriterionWeight -> CriterionWeight -> CriterionWeight)
-> Ord CriterionWeight
CriterionWeight -> CriterionWeight -> Bool
CriterionWeight -> CriterionWeight -> Ordering
CriterionWeight -> CriterionWeight -> CriterionWeight
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 :: CriterionWeight -> CriterionWeight -> CriterionWeight
$cmin :: CriterionWeight -> CriterionWeight -> CriterionWeight
max :: CriterionWeight -> CriterionWeight -> CriterionWeight
$cmax :: CriterionWeight -> CriterionWeight -> CriterionWeight
>= :: CriterionWeight -> CriterionWeight -> Bool
$c>= :: CriterionWeight -> CriterionWeight -> Bool
> :: CriterionWeight -> CriterionWeight -> Bool
$c> :: CriterionWeight -> CriterionWeight -> Bool
<= :: CriterionWeight -> CriterionWeight -> Bool
$c<= :: CriterionWeight -> CriterionWeight -> Bool
< :: CriterionWeight -> CriterionWeight -> Bool
$c< :: CriterionWeight -> CriterionWeight -> Bool
compare :: CriterionWeight -> CriterionWeight -> Ordering
$ccompare :: CriterionWeight -> CriterionWeight -> Ordering
$cp1Ord :: Eq CriterionWeight
Ord)

instance Show CriterionWeight where
	showsPrec :: Int -> CriterionWeight -> ShowS
showsPrec Int
precedence (MkCriterionWeight CriterionWeight
criterionWeight)	= Int -> CriterionWeight -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
precedence CriterionWeight
criterionWeight

instance Num CriterionWeight where
	MkCriterionWeight CriterionWeight
l + :: CriterionWeight -> CriterionWeight -> CriterionWeight
+ MkCriterionWeight CriterionWeight
r	= CriterionWeight -> CriterionWeight
mkCriterionWeight (CriterionWeight -> CriterionWeight)
-> CriterionWeight -> CriterionWeight
forall a b. (a -> b) -> a -> b
$! CriterionWeight
l CriterionWeight -> CriterionWeight -> CriterionWeight
forall a. Num a => a -> a -> a
+ CriterionWeight
r
	MkCriterionWeight CriterionWeight
l * :: CriterionWeight -> CriterionWeight -> CriterionWeight
* MkCriterionWeight CriterionWeight
r	= CriterionWeight -> CriterionWeight
MkCriterionWeight (CriterionWeight -> CriterionWeight)
-> CriterionWeight -> CriterionWeight
forall a b. (a -> b) -> a -> b
$! CriterionWeight
l CriterionWeight -> CriterionWeight -> CriterionWeight
forall a. Num a => a -> a -> a
* CriterionWeight
r
	abs :: CriterionWeight -> CriterionWeight
abs (MkCriterionWeight CriterionWeight
criterionWeight)		= CriterionWeight -> CriterionWeight
MkCriterionWeight (CriterionWeight -> CriterionWeight)
-> CriterionWeight -> CriterionWeight
forall a b. (a -> b) -> a -> b
$! CriterionWeight -> CriterionWeight
forall a. Num a => a -> a
abs CriterionWeight
criterionWeight	-- N.B.: if the operand is valid, then this is equivalent to 'id'.
	signum :: CriterionWeight -> CriterionWeight
signum (MkCriterionWeight CriterionWeight
criterionWeight)	= CriterionWeight -> CriterionWeight
MkCriterionWeight (CriterionWeight -> CriterionWeight)
-> CriterionWeight -> CriterionWeight
forall a b. (a -> b) -> a -> b
$! CriterionWeight -> CriterionWeight
forall a. Num a => a -> a
signum CriterionWeight
criterionWeight
	fromInteger :: Integer -> CriterionWeight
fromInteger					= CriterionWeight -> CriterionWeight
mkCriterionWeight (CriterionWeight -> CriterionWeight)
-> (Integer -> CriterionWeight) -> Integer -> CriterionWeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CriterionWeight
forall a. Num a => Integer -> a
fromInteger
	negate :: CriterionWeight -> CriterionWeight
negate (MkCriterionWeight CriterionWeight
criterionWeight)	= CriterionWeight -> CriterionWeight
mkCriterionWeight (CriterionWeight -> CriterionWeight)
-> CriterionWeight -> CriterionWeight
forall a b. (a -> b) -> a -> b
$! CriterionWeight -> CriterionWeight
forall a. Num a => a -> a
negate CriterionWeight
criterionWeight	-- CAVEAT: only valid for '0'.

instance Fractional CriterionWeight where
	MkCriterionWeight CriterionWeight
l / :: CriterionWeight -> CriterionWeight -> CriterionWeight
/ MkCriterionWeight CriterionWeight
r	= CriterionWeight -> CriterionWeight
mkCriterionWeight (CriterionWeight -> CriterionWeight)
-> CriterionWeight -> CriterionWeight
forall a b. (a -> b) -> a -> b
$! CriterionWeight
l CriterionWeight -> CriterionWeight -> CriterionWeight
forall a. Fractional a => a -> a -> a
/ CriterionWeight
r	-- CAVEAT: it's hard to concoct a scenario in which neither the numerator, denominator nor result are invalid.
	fromRational :: Rational -> CriterionWeight
fromRational					= CriterionWeight -> CriterionWeight
mkCriterionWeight (CriterionWeight -> CriterionWeight)
-> (Rational -> CriterionWeight) -> Rational -> CriterionWeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> CriterionWeight
forall a. Fractional a => Rational -> a
fromRational

instance Real CriterionWeight where
	toRational :: CriterionWeight -> Rational
toRational (MkCriterionWeight CriterionWeight
criterionWeight)	= CriterionWeight -> Rational
forall a. Real a => a -> Rational
toRational CriterionWeight
criterionWeight

instance Bounded CriterionWeight where
	minBound :: CriterionWeight
minBound	= CriterionWeight -> CriterionWeight
MkCriterionWeight CriterionWeight
0
	maxBound :: CriterionWeight
maxBound	= CriterionWeight -> CriterionWeight
MkCriterionWeight CriterionWeight
1

instance Data.Default.Default CriterionWeight where
	def :: CriterionWeight
def	= CriterionWeight
forall a. Bounded a => a
minBound

instance Control.DeepSeq.NFData CriterionWeight where
	rnf :: CriterionWeight -> ()
rnf (MkCriterionWeight CriterionWeight
criterionWeight)	= CriterionWeight -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf CriterionWeight
criterionWeight

instance HXT.XmlPickler CriterionWeight where
	xpickle :: PU CriterionWeight
xpickle	= (CriterionWeight -> CriterionWeight,
 CriterionWeight -> CriterionWeight)
-> PU CriterionWeight -> PU CriterionWeight
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (CriterionWeight -> CriterionWeight
mkCriterionWeight, CriterionWeight -> CriterionWeight
deconstruct) PU CriterionWeight
forall a. XmlPickler a => PU a
HXT.xpickle

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