module Days.Day09 where

import AOCUtil
import Data.Char
import Data.List
import GHC.Utils.Misc

runA :: IO ()
runA = interactF "data/day09.test" (solve)

runB :: IO ()
runB = interactF "data/day09.txt" (solveB)

solve :: String -> String
solve = show . length . nub . sort . map snd . processInstruction [((0, 0), (0, 0))] . parseInput

solveB :: String -> String
solveB = show . length . nub . sort . map last . process2 [longRope] . parseInput

type Pos = (Int, Int)

type Rope = (Pos, Pos)

type LongRope = [Pos]

longRope :: LongRope
longRope = replicate 10 (0, 0)

data Dir = DUp | DDown | DLeft | DRight
-- ^ y
-- |
-- |
-- +----> x

move :: Dir -> Pos -> Pos
move DUp (x, y) = (x, y + 1)
move DDown (x, y) = (x, y - 1)
move DLeft (x, y) = (x - 1, y)
move DRight (x, y) = (x + 1, y)

parseInput :: String -> [Dir]
parseInput = concatMap (parseCommand . words) . lines

parseCommand :: [String] -> [Dir]
parseCommand ["R", i] = replicate (read i) DRight
parseCommand ["L", i] = replicate (read i) DLeft
parseCommand ["U", i] = replicate (read i) DUp
parseCommand ["D", i] = replicate (read i) DDown

processInstruction :: [Rope] -> [Dir] -> [Rope]
processInstruction [] _ = error "Specify starting position"
processInstruction r [] = r
processInstruction r@((h, t) : _) (d : ds) = processInstruction ((h2, adjust3 h2 t) : r) ds
  where
    h2 = move d h

process2 :: [LongRope] -> [Dir] -> [LongRope]
process2 [] _ = error "Specify starting rope"
process2 r [] = r
process2 r@(rope : _) (d : ds) = process2 (moveRope rope d : r) ds

adjust3 :: Pos -> Pos -> Pos -- head, tain -> new tail
adjust3 (hx, hy) (tx, ty) = if max (abs $ hx - tx) (abs $ hy - ty) > 1 then (tx + signum (hx - tx), ty + signum (hy - ty)) else (tx, ty)

moveRope :: LongRope -> Dir -> LongRope -- moves head
moveRope (h : rs) d = fixRope (move d h : rs)

fixRope :: LongRope -> LongRope -- moves tail
fixRope [a] = [a]
fixRope (h : t : ts) = (h : fixRope (adjust3 h t : ts))

-- adjust :: Dir -> Rope -> Rope -- Dir, Head, Tail -> Tail
-- adjust DRight (h@(hx, hy), t@(tx, ty)) = (move DRight h, if tx < hx then h else t)
-- adjust DLeft (h@(hx, hy), t@(tx, ty)) = (move DLeft h, if tx > hx then h else t)
-- adjust DDown (h@(hx, hy), t@(tx, ty)) = (move DDown h, if ty > hy then h else t)
-- adjust DUp (h@(hx, hy), t@(tx, ty)) = (move DUp h, if ty < hy then h else t)

-- adjust2 :: Pos -> Pos -> Pos -- head, tain -> new tail
-- adjust2 h2 t = if dist <= 1 then t else t2
--   where
--     dist = max (abs $ fst h2 - fst t) (abs $ snd h2 - snd t)
--     t2 = head . sortOn (edist t) . map (addT h2) $ [(0, 1), (0, -1), (1, 0), (-1, 0)]

-- edist :: Num a => (a, a) -> (a, a) -> a
-- edist (a1, a2) (b1, b2) = (a1 - b1) ^ 2 + (a2 - b2) ^ 2
