content: {-# LANGUAGE RankNTypes #-}
  
  module Main where
  
  import Parallel
  import qualified Memo
  import qualified Data.Map.Lazy as M
  import Control.DeepSeq
  import Control.Monad.ST
  import Data.STRef
  
  fight :: Int -> Int -> [Int]
  fight i a = map fst $ fightVanillaM i a
  
  fightVanillaM :: Int -> Int -> [(Int, Int)]
  fightVanillaM = Memo.memo2 Memo.bits Memo.bits fightVanilla
  
  fightVanilla :: Int -> Int -> [(Int, Int)]
  fightVanilla php ohp
    | php <= 0 || ohp <= 0 = [(max 0 php, max 0 ohp)]
    | otherwise = regroup $ do
        (odmg, pdmg) <- [(9,3),(10,2),(11,2),(12,2),(14,1),(16,1),(18,0),(100,0),(100,0),(100,0)]
        fightVanillaM (php - pdmg) (ohp - odmg)
  
  update :: Int -> Int -> [(Int, Int)]
  update i outcome = (,) outcome <$> fight i outcome
  
  memoState :: Memo.Memo (Int, Int)
  memoState = Memo.pair Memo.bits Memo.bits
  
  fibFight :: Int -> [Int]
  fibFight 0 = []
  fibFight 1 = []
  fibFight x = [(x - 1), (x - 2)]
  
  
  -----------------------------------------------------------------------------------
  regroup :: (NFData a, Show a, Eq a, Ord a) => [(a, Int)] -> [(a, Int)]
  regroup xs =
      let xs' = M.toList $ M.fromListWith (+) xs
          s' = addTheNumbers (map (\(_,x) -> x) xs) -- sum (map snd xs')
          s  = sum (map snd xs)
       in if s' /= s
              then if show s' == show s
                      then error "WAT????"
                      else error $ "Those are expected to be equal" ++ show (s', s)
              else xs'
  ----------------------------------------------------------------------------------
  
  addTheNumbers :: [Int] -> Int
  addTheNumbers xs0 = runST $ do
    y <- newSTRef 0
    let go [] = readSTRef y
        go (x : xs) = do
          modifySTRef y (+x)
          go xs
    go xs0
  
  main :: IO ()
  main = rnf (go (80, 250)) `seq` return ()
      where
          go = memoState (rnf . parMap rdeepseq (map go) . step)
  step (cid, hp) = map (update hp) (fibFight cid)
  