day2: Shorten parsers a bit

This commit is contained in:
Alexander Kobjolke 2023-12-03 20:21:59 +01:00
parent ba418a6ded
commit 1311230bbb
2 changed files with 22 additions and 18 deletions

View file

@ -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 ()

View file

@ -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