From 1311230bbb2e5c45fcf2577b451dae8b10b82f2e Mon Sep 17 00:00:00 2001
From: Alexander Kobjolke <me@failco.de>
Date: Sun, 3 Dec 2023 20:21:59 +0100
Subject: [PATCH] day2: Shorten parsers a bit

---
 src/AoC/Parser.hs    |  4 ++--
 src/AoC/Y2023/D02.hs | 36 ++++++++++++++++++++----------------
 2 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/src/AoC/Parser.hs b/src/AoC/Parser.hs
index ba305db..7073ef3 100644
--- a/src/AoC/Parser.hs
+++ b/src/AoC/Parser.hs
@@ -1,6 +1,6 @@
 module AoC.Parser (Parser, parseText, ws, linewise) where
 
-import Text.Megaparsec (Parsec, parse, sepEndBy1)
+import Text.Megaparsec (Parsec, errorBundlePretty, parse, sepEndBy1)
 import Text.Megaparsec.Char (eol, space1)
 import Text.Megaparsec.Char.Lexer qualified as L
 
@@ -9,7 +9,7 @@ type Parser = Parsec Void Text
 parseText :: Parser a -> Text -> Either Text a
 parseText p t = case parse p "<inline>" t of
   Right a -> pure a
-  Left e -> Left $ show e
+  Left e -> Left $ fromString $ errorBundlePretty e
 
 -- skip whitespace
 ws :: Parser ()
diff --git a/src/AoC/Y2023/D02.hs b/src/AoC/Y2023/D02.hs
index f2d0731..95c0fbc 100644
--- a/src/AoC/Y2023/D02.hs
+++ b/src/AoC/Y2023/D02.hs
@@ -5,7 +5,7 @@ import AoC.Riddle
 
 import Data.Map qualified as M
 import Text.Megaparsec (choice, sepBy)
-import Text.Megaparsec.Char (char, space1, string)
+import Text.Megaparsec.Char (char, string)
 import Text.Megaparsec.Char.Lexer qualified as L
 
 data Cube = Red | Green | Blue
@@ -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 <* ws <*> 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,20 @@ 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
 
+-- | Calculate the 'power' of a round by multiplying everything together.
+-- >>> power $ fromList [(Red, 2), (Green, 4)]
+-- 8
 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