<div dir="ltr"><div><div>My goal is to take data like this:<br><br>                        [ Info 0 "Alcohol" "TX"<br>                        , Info 1 "Alcohol" "TX"<br>                        , Info 2 "Pregnancy" "MA"<br>                        ]<br><br></div>and build a Map like this:<br><br>[("MA",[("Pregnancy",1)]),("TX",[("Alcohol",2)])]<br><br></div>Here is my failed attempt:<br><br>{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}<br>import qualified Data.Map as M<br>import Data.List (foldl')<br>import Data.Maybe<br>import Debug.Trace<br><br>data Info = Info { i :: !Int, healthTopic :: !String, state :: !String } deriving Show<br><br>m :: M.Map String (M.Map String Integer)<br>m = M.fromList [("MA", M.fromList[("Pregnancy",1)]),("TX", M.fromList[("Alcohol",2)])]<br><br>constantValsPerState = foldl'<br><br>                        (\accum currentRow -> do<br>                            M.insert (state currentRow) "xxx" accum<br>                        )<br><br>                        M.empty<br><br>                        [ Info 0 "Alcohol" "TX"<br>                        , Info 1 "Alcohol" "TX"<br>                        , Info 2 "Pregnancy" "MA"<br>                        ]<br><br>-- λ> constantValsPerState<br>-- fromList [("MA","xxx"),("TX","xxx")]<br><br>-- how can I get something like:<br>-- λ> numTopicsPerState<br>-- fromList [("MA", fromList[("Pregnancy",1)]),("TX", fromList[("Alcohol",2)])]<br><br>-- so we need to give the modified stae of the new map isntead of M.empty<br>-- λ> m<br>-- fromList [("MA",fromList [("Pregnancy",1)]),("TX",fromList [("Alcohol",2)])]<br>-- λ> M.insertWith (\new old -> new) "MA" M.empty m<br>-- fromList [("MA",fromList []),("TX",fromList [("Alcohol",2)])]<br><br>numTopicsPerState = foldl'<br>                        (\(accum :: M.Map String (M.Map String Integer)) currentRow -> do<br>                            M.insertWithKey<br>                              (\k new old -> M.insert<br>                                              (healthTopic currentRow)<br>                                              ((fromMaybe 0 $ M.lookup (healthTopic currentRow) old) + 1)<br>                                              new<br>                              )<br>                              (state currentRow)<br>                              (fromMaybe (M.empty) (M.lookup (state currentRow) accum))<br>                              accum<br>                        )<br><br>                        M.empty<br>                        [ Info 0 "Alcohol" "TX"<br>                        , Info 1 "Alcohol" "TX"<br>                        , Info 2 "Pregnancy" "MA"<br>                        ]<br><br>-- WRONG OUTPUT<br>-- λ> numTopicsPerState<br>-- fromList [("MA",fromList []),("TX",fromList [("Alcohol",1)])]<br><br><br>-- TODO<br>-- turn<br>-- fromList [("Alcohol",fromList []),("MA",fromList [("Pregnancy",1)]),("TX",fromList [("Alcohol",2)])]<br>-- into<br>-- fromList [("MA",fromList [("Pregnancy",1)]),("TX",fromList [("Alcohol",3)])]<br><br></div>