{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses #-}
{-
Copyright (C) 2013-2015 Dr. Alistair Ward
This file is part of WeekDaze.
WeekDaze 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.
WeekDaze 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 WeekDaze. If not, see .
-}
{- |
[@AUTHOR@] Dr. Alistair Ward
[@DESCRIPTION@]
* Defines the weight associated with some /criterion/.
* Each weighting is quantified by some 'Fractional' value in the /closed unit-interval/; negative values aren't permitted.
* If a concept is of no significance, then its weight can be set to /minBound/, whilst concepts of great significance can be set to /maxBound/.
[@CAVEAT@]
* While this data-type could implement the classes 'Functor', 'Num', 'Fractional' & 'Real', these interfaces allow one to construct invalid instances.
-}
module WeekDaze.ExecutionConfiguration.CriterionWeight(
-- * Type-classes
CriterionWeights(..),
-- * Types
-- ** Data-types
CriterionWeight(
-- MkCriterionWeight,
deconstruct
),
-- * Functions
-- ** Constructor
mkCriterionWeight
) where
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.SelfValidate
#ifdef USE_HDBC
import qualified Database.HDBC
import qualified Data.Convertible
import qualified Data.Ratio
import qualified Data.Typeable
import qualified WeekDaze.Database.Selector as Database.Selector
instance (
Data.Convertible.Convertible Database.HDBC.SqlValue w, -- Flexible context.
Data.Typeable.Typeable w,
RealFrac w
) => Data.Convertible.Convertible Database.HDBC.SqlValue (CriterionWeight w) {-multi-parameter type-class-} where
safeConvert = fmap (
mkCriterionWeight . (
\w -> if Data.Typeable.typeOf w == Data.Typeable.typeOf (undefined :: Data.Ratio.Rational)
then realToFrac $ Database.Selector.round' w
else w
)
) . Data.Convertible.safeConvert
#endif /* USE_HDBC */
{- |
* Quantifies the relative significance, of criteria used to assess the desirability of a /resource/.
* The larger the value, the more significant the criterion; relative to other criteria applicable to the same resource.
-}
newtype CriterionWeight w = MkCriterionWeight {
deconstruct :: w
} deriving (Eq, Ord, Show)
instance Num w => Bounded (CriterionWeight w) where
minBound = MkCriterionWeight 0
maxBound = MkCriterionWeight 1
-- | True if the specified 'criterion-weight' falls within the /closed unit-interval/; .
instance Real w => ToolShed.SelfValidate.SelfValidator (CriterionWeight w) where
getErrors w = ToolShed.SelfValidate.extractErrors [
(
any ($ w) [(< minBound), (> maxBound)],
"'" ++ show (realToFrac $ deconstruct w :: Double {-hide the data-constructor & the actual type-}) ++ "' should be within the closed unit-interval '[0,1]'"
) -- Pair.
]
instance Num w => Data.Default.Default (CriterionWeight w) where
def = minBound
instance (HXT.XmlPickler w, Real w) => HXT.XmlPickler (CriterionWeight w) where
xpickle = HXT.xpWrap (mkCriterionWeight, deconstruct) HXT.xpickle -- CAVEAT: only apply 'HXT.xpDefault' after 'HXT.xpAttr' or 'HXT.xpElem'.
instance Control.DeepSeq.NFData w => Control.DeepSeq.NFData (CriterionWeight w) where
rnf = Control.DeepSeq.rnf . deconstruct
-- | Smart constructor.
mkCriterionWeight :: Real w => w -> CriterionWeight w
mkCriterionWeight w
| ToolShed.SelfValidate.isValid criterionWeight = criterionWeight
| otherwise = error $ "WeekDaze.ExecutionConfiguration.CriterionWeight.mkCriterionWeight:\t" ++ ToolShed.SelfValidate.getFirstError criterionWeight ++ "."
where
criterionWeight = MkCriterionWeight w
-- | An interface to which a collection of criteria-weights may conform.
class CriterionWeights a where
areAllZero :: a -> Bool -- ^ True if all the weights are zero.
instance (Bounded a, Eq a) => CriterionWeights [a] where
areAllZero = all (== minBound)