module WeekDaze.ExecutionConfiguration.TimetableBreederFecundity(
Fecundity,
TimetableBreederFecundity(
getDeterministicConstructorFecundity,
getRandomConstructorFecundity
),
zero,
mkTimetableBreederFecundity,
(>*<)
) where
import Control.Arrow((&&&))
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.SelfValidate
infixl 7 >*<
tag :: String
tag = "timetableBreederFecundity"
deterministicConstructorFecundityTag :: String
deterministicConstructorFecundityTag = "deterministicConstructorFecundity"
randomConstructorFecundityTag :: String
randomConstructorFecundityTag = "randomConstructorFecundity"
type Fecundity = Int
data TimetableBreederFecundity = MkTimetableBreederFecundity {
getDeterministicConstructorFecundity :: Fecundity,
getRandomConstructorFecundity :: Fecundity
} deriving Eq
instance Read TimetableBreederFecundity where
readsPrec _ = map (Control.Arrow.first $ uncurry mkTimetableBreederFecundity) . reads
instance Show TimetableBreederFecundity where
showsPrec _ = shows . (getDeterministicConstructorFecundity &&& getRandomConstructorFecundity)
instance Data.Default.Default TimetableBreederFecundity where
def = zero
instance ToolShed.SelfValidate.SelfValidator TimetableBreederFecundity where
getErrors timetableBreederFecundity = ToolShed.SelfValidate.extractErrors [
(
any ((< 0) . ($ timetableBreederFecundity)) [getDeterministicConstructorFecundity, getRandomConstructorFecundity],
"fecundity can't be negative; " ++ show timetableBreederFecundity
)
]
instance HXT.XmlPickler TimetableBreederFecundity where
xpickle = HXT.xpDefault defaultTimetableBreederFecundity . HXT.xpElem tag . HXT.xpWrap (
uncurry mkTimetableBreederFecundity,
getDeterministicConstructorFecundity &&& getRandomConstructorFecundity
) $ (
getDeterministicConstructorFecundity defaultTimetableBreederFecundity `HXT.xpDefault` HXT.xpAttr deterministicConstructorFecundityTag HXT.xpInt
) `HXT.xpPair` (
getRandomConstructorFecundity defaultTimetableBreederFecundity `HXT.xpDefault` HXT.xpAttr randomConstructorFecundityTag HXT.xpInt
) where
defaultTimetableBreederFecundity = Data.Default.def
instance Control.DeepSeq.NFData TimetableBreederFecundity where
rnf = Control.DeepSeq.rnf . (getDeterministicConstructorFecundity &&& getRandomConstructorFecundity)
mkTimetableBreederFecundity :: Fecundity -> Fecundity -> TimetableBreederFecundity
mkTimetableBreederFecundity deterministicConstructorFecundity randomConstructorFecundity
| ToolShed.SelfValidate.isValid fecundity = fecundity
| otherwise = error $ "WeekDaze.ExecutionConfiguration.TimetableBreederFecundity.mkTimetableBreederFecundity:\t" ++ ToolShed.SelfValidate.getFirstError fecundity ++ "."
where
fecundity = MkTimetableBreederFecundity deterministicConstructorFecundity randomConstructorFecundity
zero :: TimetableBreederFecundity
zero = mkTimetableBreederFecundity 0 0
(>*<) :: TimetableBreederFecundity -> TimetableBreederFecundity -> TimetableBreederFecundity
MkTimetableBreederFecundity dl rl >*< MkTimetableBreederFecundity dr rr = mkTimetableBreederFecundity (round $ getGeometricMean dl dr) (round $ getGeometricMean rl rr) where
getGeometricMean :: Fecundity -> Fecundity -> Double
getGeometricMean x y = sqrt . fromIntegral $ x * y