Advent of Code Day 2 (Part 1 & 2)

import Data.List (foldl')
import Data.List.Split (splitOn)
import Data.Char (isDigit)
import Data.Bifunctor (bimap)

-- part 1

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

type CubeSet = [(Int, Color)]

type Game = (Int, [CubeSet])

type ColorCounts = (Int, Int, Int)

parseColor :: String -> Color
parseColor s
  | s == "red" = Red
  | s == "green" = Green
  | s == "blue" = Blue
  | otherwise = error "Unknown color"

parseCubeCount :: String -> (Int, Color)
parseCubeCount s = bimap read (parseColor . tail) $ span isDigit s

parseCubeSet :: String -> CubeSet
parseCubeSet s = map parseCubeCount $ splitOn ", " s

parseGame :: String -> Game
parseGame s = 
  let (gameId, rest) = break (== ':') $ drop 5 s
      cubeSets = splitOn "; " $ drop 2 rest
  in (read gameId, map parseCubeSet cubeSets)

parseInput :: String -> [Game]
parseInput input = map parseGame $ lines input

accumulateColors :: CubeSet -> ColorCounts
accumulateColors = foldl' colorAccumulator (0,0,0)
  where colorAccumulator (r, g, b) (cnt, c) = case c of
          Red -> (r + cnt, g, b)
          Green -> (r, g + cnt, b)
          Blue -> (r, g, b + cnt)

countColors :: Game -> [ColorCounts]
countColors (_, cubeSets) = map accumulateColors cubeSets

isPossible :: ColorCounts -> Game -> Bool
isPossible colorCounts game =
  let (redCount, greenCount, blueCount) = colorCounts
      isPossibleCubeSet (r, g, b) = r <= redCount && g <= greenCount && b <= blueCount
  in all isPossibleCubeSet $ countColors game

partOne :: IO ()
partOne = interact $ show . sum . map fst . filter (isPossible (12, 13, 14)) . map parseGame . lines

-- part 2

getMinPossibleColorCounts :: Game -> ColorCounts
getMinPossibleColorCounts (_, cubeSets) = 
  let colorCounts = map accumulateColors cubeSets
      takeMaximumColorCounts (r,g,b) (r',g',b') = (max r r', max g g', max b b')
  in if null colorCounts
    then (0,0,0)
    else foldl' takeMaximumColorCounts (0,0,0) colorCounts

power :: ColorCounts -> Int
power (r,g,b) = r * g * b

partTwo :: IO ()
partTwo = interact $ show . sum . map (power . getMinPossibleColorCounts . parseGame) . lines

main :: IO ()
main = partTwo