Files
advent-of-code-2023/day19/Commons.hs
2023-12-19 13:35:45 +01:00

64 lines
3.6 KiB
Haskell

module Commons where
import Data.List.Utils (split)
import GHC.IO.Handle (isEOF)
import Data.Map (Map, assocs, member, (!), fromList, empty, insert)
data Part = Part { xr :: Int, mr :: Int, ar :: Int, sr :: Int } deriving (Eq, Show)
data Rule = Rule { apply :: Part -> Bool, destination :: String, r :: Char, v :: Int, s :: Char }
type Workflows = Map String [Rule]
parsePart :: String -> Part
parsePart line = let (x: m: a: s: _) = split "," line
in Part {xr = read $ tail $ tail x, mr = read $ tail $ tail m, ar = read $ tail $ tail a,
sr = read $ tail $ tail s}
parseParts :: [Part] -> IO [Part]
parseParts otherParts = do done <- isEOF
if done then return otherParts
else do line <- getLine
let part = parsePart $ tail $ init line
parseParts $ otherParts ++ [part]
parseRules :: [String] -> [Rule]
parseRules = map (\ rule -> if length rule < 2 || head (tail rule) /= '<' && head (tail rule) /= '>'
then Rule {apply = const True, destination = rule, r = '*', v = 0, s = '>'}
else let (condition: destination: _) = split ":" rule
(r: s: vRaw) = condition
v = read vRaw
in case (r, s) of
('x', '>') -> Rule {apply = \ p -> xr p > v, destination = destination,
r = r, v = v, s = s}
('m', '>') -> Rule {apply = \ p -> mr p > v, destination = destination,
r = r, v = v, s = s}
('a', '>') -> Rule {apply = \ p -> ar p > v, destination = destination,
r = r, v = v, s = s}
('s', '>') -> Rule {apply = \ p -> sr p > v, destination = destination,
r = r, v = v, s = s}
('x', '<') -> Rule {apply = \ p -> xr p < v, destination = destination,
r = r, v = v, s = s}
('m', '<') -> Rule {apply = \ p -> mr p < v, destination = destination,
r = r, v = v, s = s}
('a', '<') -> Rule {apply = \ p -> ar p < v, destination = destination,
r = r, v = v, s = s}
('s', '<') -> Rule {apply = \ p -> sr p < v, destination = destination,
r = r, v = v, s = s})
parseWorkflow :: String -> (String, [Rule])
parseWorkflow line = let (name: rulesRaw: _) = split "{" line
in (name, parseRules $ split "," $ init rulesRaw)
parseWorkflows :: Workflows -> IO Workflows
parseWorkflows otherWorkflows = do line <- getLine
if null line
then return otherWorkflows
else do let (name, rules) = parseWorkflow line
parseWorkflows $ insert name rules otherWorkflows
parse :: IO (Workflows, [Part])
parse = do workflows <- parseWorkflows empty
ratings <- parseParts []
return (workflows, ratings)