diff --git a/src/AoC/Y2023/D02.hs b/src/AoC/Y2023/D02.hs index f2d0731..f3d22e5 100644 --- a/src/AoC/Y2023/D02.hs +++ b/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