Day 9.. Haven't finished part 1 yet, its too late

2022/aoc2022.cabal

@@ -9,4 +9,4 @@ executable aoc2022
     build-depends:    base ^>=4.16.2.0, split ^>=0.2.3.5, regex-tdfa ^>=1.3.2, containers ^>=0.6.6
     hs-source-dirs:   app
     default-language: Haskell2010
-    other-modules:    Day1.Main Day2.Main Day3.Main Day4.Main Day5.Main Day6.Main Day7.Main, Day8.Main
+    other-modules:    Day1.Main Day2.Main Day3.Main Day4.Main Day5.Main Day6.Main Day7.Main, Day8.Main, Day9.Main

2022/app/Day8/Main.hs

@@ -1,4 +1,4 @@
-module Day8.Main where
+module Day8.Main (main) where
 
 import System.IO
 import Data.List

2022/app/Day9/Main.hs

@@ -0,0 +1,137 @@
+module Day9.Main where
+
+import System.IO
+import Data.List
+import Data.List.Split
+
+main :: IO ()
+main = do
+    putStrLn "Day 9"
+    
+    handle <- openFile "app/Day9/example" ReadMode
+    contents <- hGetContents handle
+
+    let r1 = part1 contents
+    putStrLn $ "part 1: " ++ show r1
+
+    let r2 = part2 contents
+    putStrLn $ "part 2: " ++ show r2
+
+data Direction = DUp | DDown | DLeft | DRight
+                 deriving (Show)
+
+data Heading = None | N | E | S | W | NE | SE | SW | NW
+
+type Motion = (Int, Direction)
+type Point = (Int, Int)
+type Rope = (Point, Point) -- head, tail
+
+instance Read Direction where
+    readsPrec _ "R" = [(DRight, "")]
+    readsPrec _ "L" = [(DLeft, "")]
+    readsPrec _ "U" = [(DUp, "")]
+    readsPrec _ "D" = [(DDown, "")]
+
+toMotion :: [String] -> Motion
+toMotion (a:b:_) = (read b, read a)
+
+toHeading :: Rope -> Heading
+toHeading ((hx,hy),(tx,ty))
+ | hx == tx &&
+   hy == ty = None
+
+ | hx == tx &&
+   hy <  ty = S
+ | hx == tx &&
+   hy >  ty = N
+ | hy == ty &&
+   hx <  tx = W
+ | hy == ty &&
+   hx >  tx = E
+   
+ | hx <  tx &&
+   hy <  ty = SW
+ | hx <  tx &&
+   hy >  ty = NW
+ | hx >  tx &&
+   hy <  ty = SE
+ | hx >  tx &&
+   hy >  ty = NE
+
+parseData :: String -> [Motion]
+parseData = (map toMotion) . (map (splitOn " ")) . lines
+
+expandMovement :: [Motion] -> [Direction]
+expandMovement = concatMap (uncurry replicate)
+
+doMovement :: Rope -> Direction -> Rope
+doMovement rope DUp =
+    case toHeading rope of
+        None -> ((hx, hy+1), (tx, ty))
+        
+        N    -> ((hx, hy+1), (tx, ty+1))
+        E    -> ((hx, hy+1), (tx, ty))
+        S    -> ((hx, hy+1), (tx, ty))
+        W    -> ((hx, hy+1), (tx, ty))
+        
+        NE   -> ((hx, hy+1), (tx+1, ty+1))
+        SE   -> ((hx, hy+1), (tx, ty))
+        SW   -> ((hx, hy+1), (tx, ty))
+        NW   -> ((hx, hy+1), (tx-1, ty+1))
+    where
+        ((hx, hy), (tx, ty)) = rope
+
+doMovement rope DDown =
+    case toHeading rope of
+        None -> ((hx, hy-1), (tx, ty))
+
+        N    -> ((hx, hy-1), (tx, ty))
+        E    -> ((hx, hy-1), (tx, ty))
+        S    -> ((hx, hy-1), (tx, ty-1))
+        W    -> ((hx, hy-1), (tx, ty))
+
+        NE   -> ((hx, hy-1), (tx, ty))
+        SE   -> ((hx, hy-1), (tx+1, ty-1))
+        SW   -> ((hx, hy-1), (tx-1, ty-1))
+        NW   -> ((hx, hy-1), (tx, ty))
+    where
+        ((hx, hy), (tx, ty)) = rope
+
+doMovement rope DLeft =
+    case toHeading rope of
+        None -> ((hx-1, hy), (tx, ty))
+
+        N    -> ((hx-1, hy), (tx, ty))
+        E    -> ((hx-1, hy), (tx, ty))
+        S    -> ((hx-1, hy), (tx, ty))
+        W    -> ((hx-1, hy), (tx-1, ty))
+
+        NE   -> ((hx-1, hy), (tx, ty))
+        SE   -> ((hx-1, hy), (tx, ty))
+        SW   -> ((hx-1, hy), (tx-1, ty-1))
+        NW   -> ((hx-1, hy), (tx-1, ty+1))
+    where
+        ((hx, hy), (tx, ty)) = rope
+
+doMovement rope DRight =
+    case toHeading rope of
+        None -> ((hx+1, hy), (tx, ty))
+
+        N    -> ((hx+1, hy), (tx, ty))
+        E    -> ((hx+1, hy), (tx+1, ty))
+        S    -> ((hx+1, hy), (tx, ty))
+        W    -> ((hx+1, hy), (tx, ty))
+
+        NE   -> ((hx+1, hy), (tx+1, ty+1))
+        SE   -> ((hx+1, hy), (tx+1, ty-1))
+        SW   -> ((hx+1, hy), (tx, ty))
+        NW   -> ((hx+1, hy), (tx, ty))
+    where
+        ((hx, hy), (tx, ty)) = rope
+
+part1 contents = path
+    where
+        steps = expandMovement $ parseData contents
+        step = take 2 steps
+        (final, path) = foldr (\m (r, ps) -> let (h,t) = doMovement r m in ((h,t), (t:ps))) (((0,0),(0,0)),[(0,0)]) steps
+part2 contents = 1

2022/app/Day9/example

@@ -0,0 +1,8 @@
+R 4
+U 4
+L 3
+D 1
+R 4
+D 1
+L 5
+R 2

2022/app/Main.hs

@@ -8,6 +8,7 @@ import qualified Day5.Main as Day5
 import qualified Day6.Main as Day6
 import qualified Day7.Main as Day7
 import qualified Day8.Main as Day8
+import qualified Day9.Main as Day9
 
 main :: IO ()
 main = do
@@ -19,3 +20,4 @@ main = do
     Day6.main
     Day7.main
     Day8.main
+    Day9.main