From 170d7b09b80cd5706a2c06188479777b1d461038 Mon Sep 17 00:00:00 2001
From: Thorn Avery <s@p7.co.nz>
Date: Tue, 8 Dec 2020 15:55:06 +1300
Subject: [PATCH] cleaned up a little

---
 day7.hs | 56 +++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 39 insertions(+), 17 deletions(-)

diff --git a/day7.hs b/day7.hs
index af38a4a..1eff021 100644
--- a/day7.hs
+++ b/day7.hs
@@ -11,38 +11,55 @@ main :: IO ()
 main = do
   raw <- readFile "day7.txt"
   let bags = validate $ map (parse lineP []) $ lines raw
-      ansA = pred $ length $ filter (\x -> (snd x) == True)
-                $ loeb $ map loebifyA bags
-      ansB = pred $ unMaybe $ lookup "shiny gold"
-                $ loeb $ map loebifyB bags
+      ansA = solveA bags
+      ansB = solveB bags
    in do
      putStrLn $ "day7a: " ++ (show ansA)
      putStrLn $ "day7b: " ++ (show ansB)
 
+solveA :: [Bag] -> Int
+solveA bs = pred
+       $ length
+       $ filter (== True)
+       $ map snd
+       $ loeb
+       $ map loebifyA bs
+
+solveB :: [Bag] -> Int
+solveB bs = pred
+       $ unsafeLookup "shiny gold"
+       $ loeb
+       $ map loebifyB bs
+
 loeb :: Functor f => f (f a -> a) -> f a
-loeb x = go where go = fmap ($ go) x
+loeb x = go
+  where
+    go = fmap ($ go) x
 
-loebifyA :: Bag -> ([(Label, Bool)] -> (Label, Bool))
+loebifyA :: Bag -> [(Label, Bool)] -> (Label, Bool)
 loebifyA (Bag "shiny gold" _) = const ("shiny gold", True)
 loebifyA (Bag l bs) =
-  (\ls -> (l, or (unMaybes (map (\f -> f ls) (map lookupify bs)))))
+  (\ls -> (l, or [f ls | f <- innerbags]))
   where
-    lookupify (_,s) = lookup s
+    lookupify = unsafeLookup . snd
+    innerbags = map lookupify bs
 
 loebifyB :: Bag -> ([(Label, Int)] -> (Label, Int))
 loebifyB (Bag l []) = const (l, 1)
 loebifyB (Bag l bs) =
-  (\ls -> (l, sum (1:(map (\f -> f ls) (map lookupify bs)))))
+  (\ls -> (l, sum $ 1 : [q*(f ls) | (f,q) <- innerbags]))
   where
-    lookupify (q,s) = (\ms -> q * (unMaybe $ lookup s ms))
+    lookupify = unsafeLookup . snd
+    innerbags = zip (map lookupify bs)
+                    (map fst bs)
+
+unsafeLookup :: Eq a => a -> [(a,b)] -> b
+unsafeLookup k = unMaybe . (lookup k)
 
 unMaybe :: Maybe a -> a
 unMaybe Nothing = error "invalid bag label"
 unMaybe (Just v) = v
 
-unMaybes :: [Maybe a] -> [a]
-unMaybes = map unMaybe
-
 validate :: [Either ParseError Bag] -> [Bag]
 validate [] = []
 validate ((Left _):_) = error "invalid input"
@@ -57,12 +74,15 @@ lineP = do
 
 baglistP :: Parsec String () [(Quantity, Label)]
 baglistP = do
-  ((string "no other bags.") >> return []) <|>
-    (endBy qlabelP $ oneOf [',', '.'] >> whitespaces)
+  ((string "no other bags.") >> return [])
+  <|> (endBy qlabelP
+        $ oneOf [',', '.'] >> whitespaces)
 
 initlabelP :: Parsec String () String
 initlabelP = manyTill anyChar
-  (try $ whitespaces >> (string "bags contain") >> whitespaces)
+  (try $ whitespaces
+      >> (string "bags contain")
+      >> whitespaces)
 
 whitespaces :: Parsec String () String
 whitespaces = many $ char ' '
@@ -76,4 +96,6 @@ qlabelP = do
 
 labelP :: Parsec String () String
 labelP = manyTill anyChar
-  (try $ whitespaces >> (string "bag") >> optional (char 's'))
+  (try $ whitespaces
+      >> (string "bag")
+      >> optional (char 's'))