HeterogenousMapLookup.hs

module HeterogenousMapLookup where

data FactorOne = FactorOneA | FactorOneB deriving (Eq, Ord)
data FactorTwo = FactorTwoA | FactorTwoB deriving (Eq, Ord)

data Tariff = Tariff
  { factorOne :: FactorOne
  , factorTwo :: FactorTwo
  } deriving Generic

myTariff :: Tariff
myTariff = Tariff FactorOneA FactorTwoB

class Resolve a s where
  resolve :: s -> a

instance HasType a s => Resolve a s where
  resolve = getTyped

instance (HasType a s, HasType b s) => Resolve (a, b) s where
  resolve s = (getTyped s, getTyped s)

data ResolvableMap b = forall a. (Ord a, Resolve a b) => ResolvableMap (M.Map a Double)

resolveMap :: Tariff -> ResolvableMap Tariff -> Maybe Double
resolveMap t (ResolvableMap m) = M.lookup (resolve t) m

factorMaps :: [ResolvableMap Tariff]
factorMaps =
  [ ResolvableMap (M.fromList [ (FactorOneA, 1.5)
                              , (FactorOneB, 1.6)
                              ])
  , ResolvableMap (M.fromList [ (FactorTwoA, 0.8)
                              , (FactorTwoB, 0.9)
                              ])
  , ResolvableMap (M.fromList [ ((FactorOneA, FactorTwoA), 1.7)
                              , ((FactorOneA, FactorTwoB), 1.8)
                              , ((FactorOneB, FactorTwoA), 1.9)
                              , ((FactorOneB, FactorTwoB), 2.0)
                              ])
  ]

calculateFactorModifier :: Tariff -> [ResolvableMap Tariff] -> Maybe Double
calculateFactorModifier t xs = getProduct . foldMap Product <$> traverse (resolveMap t) xs

doTheThing :: IO ()
doTheThing = print $ calculateFactorModifier myTariff factorMaps