aoc2023, day 2

day02.hs

module Main where

import           Control.Applicative (liftA2)
import           Data.Char           (toLower, toUpper)
import           Data.Function       (on)
import qualified Data.Map.Strict     as Map
import           Text.Parsec
import           Text.Parsec.String  (Parser)

data Color
  = Red
  | Green
  | Blue
  deriving (Read, Show, Eq, Ord)

data Round =
  Round
    { red   :: Int
    , green :: Int
    , blue  :: Int
    }
  deriving (Show, Eq)

data Game =
  Game
    { gameId :: Int
    , rounds :: [Round]
    }
  deriving (Show, Eq)

type BagContents = Round

ucFirst :: String -> String
ucFirst = uncurry ((:) . toUpper) . ((,) <$> head <*> tail)

digits :: Parser String
digits = many1 digit

parseRound :: Parser Round
parseRound = do
  counts <- parseColor `sepBy1` char ','
  let countsOf' clr = sum [count' | (clr', count') <- counts, clr' == clr]
  pure $
    Round {red = countsOf' Red, green = countsOf' Green, blue = countsOf' Blue}
  where
    parseColor =
      flip (,) <$> (spaces *> (read <$> digits) <* char ' ') <*>
      (read . ucFirst <$> choice (map string ["red", "green", "blue"]))

parseGame :: Parser Game
parseGame =
  Game <$> (string "Game " *> (read <$> digits) <* char ':' <* spaces) <*>
  (concat <$> many1 (parseRound `sepBy1` (char ';' >> spaces)))

isPossibleGame :: Game -> Bool
isPossibleGame game = all (playableRound bagContents) (rounds game)
  where
    playableRound :: Round -> Round -> Bool
    playableRound upperBounds g =
      all (\p -> p g <= p upperBounds) [red, green, blue]

parseInput :: String -> Game
parseInput s =
  case parse parseGame ("in the input: \"" ++ s ++ "\"") s of
    Left err     -> error $ show err
    Right round' -> round'

main :: IO ()
main = do
  putStrLn $ "bag contents = " ++ show bagContents
  interact $ show . liftA2 (,) part1 part2 . map parseInput . lines
  putStrLn "\ndone."

bagContents :: Round
bagContents = Round {red = 12, green = 13, blue = 14}

part1 :: [Game] -> Int
part1 = sum . map gameId . filter isPossibleGame

part2 = sum . map (power . maxGameValues)
  where
    power r = product $ map ($ r) [red, blue, green]
    maxGameValues game =
      Round {red = maxC red, green = maxC green, blue = maxC blue}
      where
        maxC g = maximum $ map g (rounds game)