module BishBosh.Attribute.RankValues(
RankValues(),
tag,
findRankValue,
calculateMaximumTotalValue,
fromAssocs
) where
import Control.Arrow((***))
import Data.Array.IArray((!))
import qualified BishBosh.Attribute.Rank as Attribute.Rank
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.Text.ShowList as Text.ShowList
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Array.IArray
import qualified Data.Default
import qualified Data.List
import qualified Data.Set
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag = "rankValues"
newtype RankValues rankValue = MkRankValues {
deconstruct :: Attribute.Rank.ByRank rankValue
} deriving (Eq, Read, Show)
instance Real rankValue => Property.ShowFloat.ShowFloat (RankValues rankValue) where
showsFloat fromDouble = Text.ShowList.showsAssociationList' . map (show *** fromDouble . realToFrac) . Data.Array.IArray.assocs . deconstruct
instance (
Fractional rankValue,
Ord rankValue,
Show rankValue
) => Data.Default.Default (RankValues rankValue) where
def = fromAssocs [
(
Attribute.Rank.Pawn, 0.1
), (
Attribute.Rank.Rook, 0.525
), (
Attribute.Rank.Knight, 0.35
), (
Attribute.Rank.Bishop, 0.35
), (
Attribute.Rank.Queen, 1
), (
Attribute.Rank.King, 0
)
]
instance Control.DeepSeq.NFData rankValue => Control.DeepSeq.NFData (RankValues rankValue) where
rnf (MkRankValues byRank) = Control.DeepSeq.rnf byRank
instance (
Fractional rankValue,
HXT.XmlPickler rankValue,
Ord rankValue,
Show rankValue
) => HXT.XmlPickler (RankValues rankValue) where
xpickle = HXT.xpDefault Data.Default.def . HXT.xpWrap (
fromAssocs,
Data.Array.IArray.assocs . deconstruct
) . HXT.xpList1 . HXT.xpElem tag $ HXT.xpickle `HXT.xpPair` HXT.xpAttr "value" HXT.xpickle
fromAssocs :: (
Fractional rankValue,
Ord rankValue,
Show rankValue
) => [(Attribute.Rank.Rank, rankValue)] -> RankValues rankValue
fromAssocs assocs
| not $ Data.Set.null undefinedRanks = Control.Exception.throw . Data.Exception.mkInsufficientData . showString "BishBosh.Attribute.RankValues.fromAssocs:\tranks" . Text.ShowList.showsAssociation $ shows (Data.Set.toList undefinedRanks) " are undefined."
| any (
not . Data.Num.inClosedUnitInterval . snd
) assocs = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Attribute.RankValues.fromAssocs:\tall values must be within the closed unit-interval, [0,1]; " $ shows assocs "."
| otherwise = MkRankValues byRank
where
undefinedRanks = Data.Set.fromAscList Attribute.Rank.range `Data.Set.difference` Data.Set.fromList (map fst assocs)
byRank = Data.Array.IArray.array (minBound, maxBound) assocs
findRankValue :: Attribute.Rank.Rank -> RankValues rankValue -> rankValue
findRankValue rank (MkRankValues byRank) = byRank ! rank
calculateMaximumTotalValue :: Num rankValue => RankValues rankValue -> rankValue
calculateMaximumTotalValue (MkRankValues byRank) = 9 * (byRank ! Attribute.Rank.Queen) + 2 * Data.List.foldl' (
\acc -> (+ acc) . (byRank !)
) 0 Attribute.Rank.flank