Day 19

day19/Commons.hs

@@ -0,0 +1,63 @@
+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)