Day 13

src/Days/D13.hs

@@ -0,0 +1,57 @@
+module Days.D13 where
+
+import Common
+import Data.List (foldl')
+import Parse
+import Text.Megaparsec (between, sepBy, (<|>))
+import Text.Megaparsec.Char (char, newline)
+
+data Packet
+  = N Int
+  | L [Packet]
+  deriving (Show, Eq)
+
+instance Ord Packet where
+  compare (N a) (N b) = compare a b
+  compare (L a) (L b) = compare a b
+  compare (N a) b = compare (L [N a]) b
+  compare a (N b) = compare a (L [N b])
+
+parser :: Parser [(Packet, Packet)]
+parser = sepBy packetPair newline
+  where
+    packetPair :: Parser (Packet, Packet)
+    packetPair = (,) <$> packet <* newline <*> packet <* newline
+
+    packet :: Parser Packet
+    packet =
+      (L <$> between (char '[') (char ']') (sepBy packet (char ',')))
+        <|> (N <$> number)
+
+part1 :: [(Packet, Packet)] -> Int
+part1 l = sum [idx | (idx, pair) <- zip [1 ..] l, uncurry (<) pair]
+
+sep2 :: Packet
+sep2 = L [L [N 2]]
+
+sep6 :: Packet
+sep6 = L [L [N 6]]
+
+part2 :: [(Packet, Packet)] -> Int
+part2 =
+  (\(acc2, acc6) -> (acc2 + 1) * (acc2 + acc6 + 2))
+    . foldl'
+      ( \(acc2, acc6) p ->
+          ( if p < sep2
+              then (acc2 + 1, acc6)
+              else
+                if p < sep6
+                  then (acc2, acc6 + 1)
+                  else (acc2, acc6)
+          )
+      )
+      (0, 0)
+    . foldl' (\acc (p1, p2) -> p1 : p2 : acc) []
+
+day :: Day
+day = parsecDay parser (definitive . part1, definitive . part2)