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 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 (eol, space1)
import Text.Megaparsec.Char.Lexer qualified as L 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 :: Parser a -> Text -> Either Text a
parseText p t = case parse p "<inline>" t of parseText p t = case parse p "<inline>" t of
Right a -> pure a Right a -> pure a
Left e -> Left $ show e Left e -> Left $ fromString $ errorBundlePretty e
-- skip whitespace -- skip whitespace
ws :: Parser () ws :: Parser ()

View file

@ -5,7 +5,7 @@ import AoC.Riddle
import Data.Map qualified as M import Data.Map qualified as M
import Text.Megaparsec (choice, sepBy) 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 import Text.Megaparsec.Char.Lexer qualified as L
data Cube = Red | Green | Blue data Cube = Red | Green | Blue
@ -24,28 +24,29 @@ pCube =
, Blue <$ string "blue" , Blue <$ string "blue"
] ]
-- | Parse a single set of cubes
--
-- >>> parseText pCubes "3 green"
-- Right (Green,3)
pCubes :: Parser (Cube, Integer) pCubes :: Parser (Cube, Integer)
pCubes = do pCubes = flip (,) <$> L.decimal <* ws <*> pCube
n <- L.decimal
_ <- space1
c <- pCube
pure (c, n)
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 :: Parser Game
pGame = do pGame = do
_ <- string "Game" >> ws string "Game" >> ws >> (L.decimal :: Parser Integer) >> char ':' >> ws
n <- L.decimal pRound `sepBy` (char ';' >> ws)
_ <- char ':' >> ws
rs <- pRound `sepBy` (char ';' >> ws)
pure (n, rs)
pPuzzle :: Parser [Game] pPuzzle :: Parser [Game]
pPuzzle = linewise pGame pPuzzle = linewise pGame
isGameValid :: Game -> Bool isGameValid :: Game -> Bool
isGameValid (_, rounds) = all isRoundValid rounds isGameValid = all isRoundValid
isRoundValid :: Round -> Bool isRoundValid :: Round -> Bool
isRoundValid = getAll . M.foldMapWithKey (\c n -> All $ cubesPossible c n) isRoundValid = getAll . M.foldMapWithKey (\c n -> All $ cubesPossible c n)
@ -56,17 +57,20 @@ cubesPossible Green = (<= 13)
cubesPossible Blue = (<= 14) cubesPossible Blue = (<= 14)
minimumSet :: Game -> Round 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 :: Round -> Integer
power = product . M.elems power = product
solve :: (MonadIO m) => Text -> m (Either Text Solution) solve :: (MonadIO m) => Text -> m (Either Text Solution)
solve riddle = case parseText pPuzzle riddle of solve riddle = case parseText pPuzzle riddle of
Right puzzle -> Right puzzle ->
let let
part1 :: Integer part1 :: Integer
part1 = sum . fmap fst . filter isGameValid $ puzzle part1 = sum . fmap fst . filter (\(_, g) -> isGameValid g) $ zip [1 ..] puzzle
part2 :: Integer part2 :: Integer
part2 = sum . fmap (power . minimumSet) $ puzzle part2 = sum . fmap (power . minimumSet) $ puzzle