[hs] Clean up 2020_07

hs/package.yaml

@@ -7,6 +7,7 @@ dependencies:
 - megaparsec
 - optparse-applicative
 - text
+- transformers
 
 library:
   source-dirs: src

hs/src/Aoc/Y2020/D07.hs

@@ -7,6 +7,7 @@ module Aoc.Y2020.D07
 import           Control.Monad
 import           Data.Maybe
 
+import           Control.Monad.Trans.State
 import qualified Data.Map                  as Map
 import qualified Data.Set                  as Set
 import qualified Data.Text                 as T
@@ -25,19 +26,12 @@ type BagMap = Map.Map BagName [BagCount]
 
 pBagName :: Parser T.Text
 pBagName = do
-  first <- word
-  void $ char ' '
-  second <- word
-  void $ char ' '
+  name <- mconcat <$> sequenceA [word, string " ", word]
   void $ string " bags" <|> string " bag"
-  pure $ first <> " " <> second
+  pure name
 
 pBagCount :: Parser BagCount
-pBagCount = do
-  n <- decimal
-  void $ char ' '
-  name <- pBagName
-  pure $ BagCount name n
+pBagCount = flip BagCount <$> (decimal <* char ' ') <*> pBagName
 
 parser :: Parser BagMap
 parser = fmap Map.fromList $ manyLines $ do
@@ -47,10 +41,16 @@ parser = fmap Map.fromList $ manyLines $ do
   void $ char '.'
   pure (name, bags)
 
-children :: BagMap -> BagName -> Set.Set BagName
-children m b =
+children :: BagMap -> BagName -> State (Map.Map BagName (Set.Set BagName)) (Set.Set BagName)
+children m b = do
+  sm <- get
+  case sm Map.!? b of
+    Just result -> pure result
+    Nothing -> do
       let ch = map bcName $ fromMaybe [] $ m Map.!? b
-  in  foldr Set.union (Set.fromList ch) $ map (children m) ch
+      result <- Set.unions . (Set.fromList ch :) <$> traverse (children m) ch
+      put $ Map.insert b result sm
+      pure result
 
 countChildren :: BagMap -> BagName -> Int
 countChildren m b =
@@ -63,7 +63,8 @@ myBag = "shiny gold"
 solver :: BagMap -> IO ()
 solver bags = do
   putStrLn ">> Part 1"
-  print $ length $ filter (Set.member myBag) $ map (children bags) $ Set.toList $ Map.keysSet bags
+  let childrenPerBag = flip evalState Map.empty $ traverse (children bags) $ Map.keys bags
+  print $ length $ filter (Set.member myBag) childrenPerBag
 
   putStrLn ""
   putStrLn ">> Part 2"