advent-of-code/2023/haskell/solutions/Day02.hs
2023-12-02 13:42:14 +01:00

64 lines
1.5 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Day02 (Cube(..), Game(..), parse, solveA) where
import Data.Void (Void)
import Data.Text (Text)
import Data.Bifunctor (first)
import Text.Megaparsec (Parsec, optional, choice, eof, many, sepBy, runParser, errorBundlePretty)
import Text.Megaparsec.Char (string, space, char, newline)
import Text.Megaparsec.Char.Lexer (decimal)
data Cube = R Int | G Int | B Int deriving Show
data Game = Game
{ gameId :: Int
, gameSets :: [[Cube]]
} deriving Show
type Parser = Parsec Void Text
parse :: Text -> Either String [Game]
parse = first errorBundlePretty . runParser games ""
where
cube :: Parser Cube
cube = do
_ <- optional space
number <- decimal
space
color <- choice
[ R <$ string "red"
, G <$ string "green"
, B <$ string "blue"
]
return . color $ number
set :: Parser [Cube]
set = space *> cube `sepBy` char ','
sets :: Parser [[Cube]]
sets = set `sepBy` char ';'
game :: Parser Game
game = do
_ <- string "Game"
space
gameId <- decimal
_ <- char ':'
gameSets <- sets
_ <- optional newline
return $ Game {..}
games :: Parser [Game]
games = many game <* eof
solveA :: [Game] -> Int
solveA = sum . map gameId . filter isValid
where
isSetValid :: Cube -> Bool
isSetValid count = case count of
R r -> r <= 12
G g -> g <= 13
B b -> b <= 14
isValid :: Game -> Bool
isValid Game {..} = all (all isSetValid) gameSets