2020 day 7 - refactor

2020/day07/Bag.hs

@@ -1,38 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Bag where
 
+import Data.Bifunctor
 import qualified Data.Text as T
+import Data.Tuple
 
 type Bag = (String, [(String, Int)])
 
-findWithContent :: [Bag] -> String -> [String]
-findWithContent bags target = map first . filter (elem target . second) . map (mapSecond $ map first) $ bags
-
 bagSpec :: String -> Bag
-bagSpec = mapFirst T.unpack . mapSecond contents . breakNoPrefix (T.pack " bags contain ") . T.pack
+bagSpec = bimap T.unpack contents . breakNoPrefix " bags contain " . T.pack
 
 contents :: T.Text -> [(String, Int)]
 contents c
-    | c == (T.pack "no other bags.") = []
-    | otherwise = map (mapSecond read . both T.unpack . swap . breakNoPrefix spc . T.strip . first . T.breakOnEnd spc) . T.splitOn (T.pack ",") $ T.init c
-        where spc = T.pack " "
+    | c == "no other bags." = []
+    | otherwise = map (bimap T.unpack (read . T.unpack) . swap . breakNoPrefix " " . T.strip . fst . T.breakOnEnd " ") . T.splitOn "," $ T.init c
 
 breakNoPrefix :: T.Text -> T.Text -> (T.Text, T.Text)
 breakNoPrefix prefix text = (a, T.drop (T.length prefix) b) where (a, b) = T.breakOn prefix text
-
-first :: (a, b) -> a
-first (a, b) = a
-
-second :: (a, b) -> b
-second (a, b) = b
-
-mapFirst :: (a -> c) -> (a, b) -> (c, b)
-mapFirst f (a, b) = (f a, b)
-
-mapSecond :: (b -> c) -> (a, b) -> (a, c)
-mapSecond f (a, b) = (a, f b)
-
-both :: (a -> b) -> (a, a) -> (b, b)
-both f (a, b) = (f a, f b)
-
-swap :: (a, b) -> (b, a)
-swap (a,b) = (b,a)

2020/day07/part1.hs

@@ -1,4 +1,5 @@
 import Bag
+import Data.Bifunctor
 import Data.List
 
 main :: IO ()
@@ -8,4 +9,7 @@ main = do
 
 willContain :: String -> [Bag] -> [String]
 willContain target bags = foldr union current . map (flip willContain $ bags) $ current
-    where current = findWithContent bags target
+    where current = findWithContent target bags
+
+findWithContent :: String -> [Bag] -> [String]
+findWithContent target = map fst . filter (elem target . snd) . map (second $ map fst)

2020/day07/part2.hs

@@ -6,8 +6,8 @@ main = do
     putStrLn . show . bagsNeeded "shiny gold" . map bagSpec . lines $ input
 
 bagsNeeded :: String -> [Bag] -> Int
-bagsNeeded bagType bags = _bagsNeeded bags (bagType, 1) - 1
+bagsNeeded bagType bags = bagsNeededRec bags (bagType, 1) - 1
 
-_bagsNeeded :: [Bag] -> (String, Int) -> Int
-_bagsNeeded bags (bagType, qty) = qty + qty * sum
-    (maybe [] (map $ _bagsNeeded bags) $ lookup bagType bags)
+bagsNeededRec :: [Bag] -> (String, Int) -> Int
+bagsNeededRec bags (bagType, qty) = qty + qty * sum
+    (maybe [] (map $ bagsNeededRec bags) $ lookup bagType bags)