day2: Shorten parsers a bit

src/AoC/Y2023/D02.hs

@@ -24,28 +24,29 @@ pCube =
     , Blue <$ string "blue"
     ]
 
+-- | Parse a single set of cubes
+--
+-- >>> parseText pCubes "3 green"
+-- Right (Green,3)
 pCubes :: Parser (Cube, Integer)
-pCubes = do
-  n <- L.decimal
-  _ <- space1
-  c <- pCube
-  pure (c, n)
+pCubes = flip (,) <$> L.decimal <* space1 <*> pCube
 
-type Game = (Integer, [Round])
+type Game = [Round]
 
+-- | Parse a single Game
+--
+-- >>> parseText pGame "Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green"
+-- Right [fromList [(Red,4),(Blue,3)],fromList [(Red,1),(Green,2),(Blue,6)],fromList [(Green,2)]]
 pGame :: Parser Game
 pGame = do
-  _ <- string "Game" >> ws
-  n <- L.decimal
-  _ <- char ':' >> ws
-  rs <- pRound `sepBy` (char ';' >> ws)
-  pure (n, rs)
+  string "Game" >> ws >> (L.decimal :: Parser Integer) >> char ':' >> ws
+  pRound `sepBy` (char ';' >> ws)
 
 pPuzzle :: Parser [Game]
 pPuzzle = linewise pGame
 
 isGameValid :: Game -> Bool
-isGameValid (_, rounds) = all isRoundValid rounds
+isGameValid = all isRoundValid
 
 isRoundValid :: Round -> Bool
 isRoundValid = getAll . M.foldMapWithKey (\c n -> All $ cubesPossible c n)
@@ -56,17 +57,17 @@ cubesPossible Green = (<= 13)
 cubesPossible Blue = (<= 14)
 
 minimumSet :: Game -> Round
-minimumSet (_, rounds) = foldr (M.unionWith max) M.empty rounds
+minimumSet = foldr (M.unionWith max) M.empty
 
 power :: Round -> Integer
-power = product . M.elems
+power = product
 
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
 solve riddle = case parseText pPuzzle riddle of
   Right puzzle ->
     let
       part1 :: Integer
-      part1 = sum . fmap fst . filter isGameValid $ puzzle
+      part1 = sum . fmap fst . filter (\(_, g) -> isGameValid g) $ zip [1 ..] puzzle
 
       part2 :: Integer
       part2 = sum . fmap (power . minimumSet) $ puzzle