day2: Shorten parsers a bit
This commit is contained in:
parent
ba418a6ded
commit
1311230bbb
2 changed files with 22 additions and 18 deletions
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue