Map of (total, list)

map-of-lists.hs

import Data.Map (Map)
import Data.List
import qualified Data.Map as M

newMap :: Map (Int, Int) (Int, [Int])
newMap = M.fromList []

updateMap key size =
   M.insertWith' ins key (fromSingleVal size)
   where
      --ins old@(a,bs) new = makePair (a+1) bs'
      ins new old@(a,bs) = makePair (a+1) bs'
         where
            newVal = toSingleVal new
            bs' = combine bs newVal

      combine ranges val = 
         update found -- ++ others
         where
            (found, others) = partition (nextToMax val) ranges :: ([Int], [Int])

            -- if this
            nextToMax x y = x == y 

            -- insert this
            update :: [Int] -> [Int]
            update [] = [val]
            update (x:xs) = expand x : xs

            -- with the expansion
            expand x = x * 10
            
            

-- goofy pair function type (de)constructors
makePair a bs = (a,bs)
fromSingleVal b = makePair 1 [b]
toSingleVal pair@(_,b:_) = b
toSingleVal _ = error "empty pair"


showResults :: (Int, Int) -> (Int, [Int]) -> [String] -> [String]
showResults key val acc =
   acc ++ [res]
   where
      (k0,k1) = key
      (count, sizes) = val
      res = show k0 ++ "," ++ show k1 ++ "," ++ show count ++ "," ++ showList sizes
      showList ll = wrap . intercalate "," . map show $ ll
      wrap xx = "\"" ++ xx ++ "\""

showFields = "key0,key1,count,sizes"

test = 
   do
      let m = newMap
      disp m
      let a = updateMap (1,1) 5 m
      disp a
      let b = updateMap (1,1) 7 a
      disp b
      let b' = updateMap (1,1) 5 a
      disp b'
      let c = updateMap (1,1) 7 b
      disp c 
      let d = updateMap (1,15) 3 c
      disp d

      let all = M.foldWithKey showResults [] c
      putStrLn showFields
      mapM_ putStrLn all
   
   where
      disp = putStrLn . show