Refactor code

src/Day05.hs

@@ -0,0 +1,56 @@
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
+module Day05
+  ( day05_1,
+    day05_2,
+  )
+where
+
+import Data.List ((\\))
+import Data.List.Split (splitOn)
+
+isSortedS :: [(String, String)] -> [String] -> Bool
+isSortedS _ [_] = True
+isSortedS rules (x : xs) =
+  let after = [p | (p, n) <- rules, n == x]
+   in not (any (`elem` after) xs) && isSortedS rules xs
+
+isSortedI :: [(Int, Int)] -> [Int] -> Bool
+isSortedI _ [_] = True
+isSortedI rules (x : xs) =
+  let after = [p | (p, n) <- rules, n == x]
+   in not (any (`elem` after) xs) && isSortedI rules xs
+
+getMiddleS :: [String] -> String
+getMiddleS xs = xs !! (length xs `div` 2)
+
+getMiddleI :: [Int] -> Int
+getMiddleI xs = xs !! (length xs `div` 2)
+
+sortOnRules :: [(Int, Int)] -> [Int] -> [Int]
+sortOnRules _ [] = []
+sortOnRules rules (x : xs) = sortOnRules rules beforeArray ++ [x] ++ sortOnRules rules afterArray
+  where
+    afterArray = xs \\ before
+    beforeArray = xs \\ afterArray
+    before = [p | (p, n) <- rules, n == x]
+
+day05_1 :: IO ()
+day05_1 = do
+  contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt"
+  let rules = [(x, y) | [x, y] <- takeWhile (/= [""]) contents]
+      updates = concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents
+      sorted = filter (isSortedS rules) updates
+  putStrLn $
+    "Day 5, Puzzle 1 solution: "
+      ++ (show :: Int -> String) (sum $ map (read . getMiddleS) sorted)
+
+day05_2 :: IO ()
+day05_2 = do
+  contents <- map (splitOn "|") . lines <$> readFile "input/day5.txt"
+  let rules = [(read x, read y) | [x, y] <- takeWhile (/= [""]) contents]
+      unsorted = filter (not . isSortedI rules) . map (map read) $ concatMap (map (splitOn ",")) . drop 1 $ dropWhile (/= [""]) contents
+      fixUnsorted = map (sortOnRules rules) unsorted
+  putStrLn $
+    "Day 5, Puzzle 2 solution: "
+      ++ show (sum $ map getMiddleI fixUnsorted)