{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

import Prelude hiding (Left, Right)
import Data.List
import GHC.IO
import Control.DeepSeq

knotN = 10

data Direction = Left | Down | Up | Right
  deriving (Eq, Show)

newtype Instruction = Instruction (Int, Direction)
  deriving (Eq, Show)

-- help
{-# NOINLINE debug #-}
debug :: Show a => a -> ()
debug = unsafePerformIO . print

trace :: Show b => b -> a -> a
trace s = deepseq (debug s)

parseDirection "L" = Left
parseDirection "D" = Down
parseDirection "U" = Up
parseDirection "R" = Right

directionToOffset :: Direction -> (Int, Int)
directionToOffset Left  = (-1, 0)
directionToOffset Down  = (0, -1)
directionToOffset Up    = (0, 1)
directionToOffset Right = (1, 0)

parseInstructions :: String -> [Instruction]
parseInstructions = map (Instruction . (\[d, n] -> (read n, parseDirection d)) . words) . lines

unrollInstructions :: [Instruction] -> [Direction]
unrollInstructions = concatMap (\(Instruction (n, d)) -> replicate n d)

taxicabDist :: (Int, Int) -> (Int, Int) -> Int
taxicabDist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)

addPos :: (Int, Int) -> (Int, Int) -> (Int, Int)
addPos (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)

subPos :: (Int, Int) -> (Int, Int) -> (Int, Int)
subPos (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)

run :: [Direction] -> [(Int, Int)]
run = snd . foldl stepAccum (replicate knotN (0, 0), [(0, 0)])
  where stepAccum :: ([(Int, Int)], [(Int, Int)]) -> Direction -> ([(Int, Int)], [(Int, Int)])
        stepAccum (knots, l) i = (newKnots, if lastKnot `elem` l then l else lastKnot : l)
          where newKnots = step' knots i
                lastKnot = last newKnots

        -- accounts for >2 knots
        step' :: [(Int, Int)] -> Direction -> [(Int, Int)]
        step' knots dir = map snd $ scanl foldStep (h, newHead) t
          where h = head knots
                t = tail knots
                offset = directionToOffset dir
                newHead = h `addPos` offset
                foldStep (oldKnot, newKnot) thisKnot = (thisKnot, step (oldKnot, thisKnot) (newKnot `subPos` oldKnot))

        step :: ((Int, Int), (Int, Int)) -> (Int, Int) -> (Int, Int)
        step ((hX, hY), (tX, tY)) (offsetX, offsetY) = (tXNew, tYNew)
          where (hXNew, hYNew) = (hX, hY) `addPos` (offsetX, offsetY)
                tailDistNew = (tX, tY) `taxicabDist` (hXNew, hYNew)
                (tXNew, tYNew)
                  -- directly touching, no problem
                  | tailDistNew <= 1 = (tX, tY)
                  -- diagonally touching, no problem
                  | tailDistNew == 2 && (tX /= hXNew) && (tY /= hYNew) = (tX, tY)
                  -- horizontally offset, catch up
                  | hYNew == tY = (tX + offsetX, hYNew)
                  -- vertically offset, catch up
                  | hXNew == tX = (hXNew, tY + offsetY)
                  -- diagonally offset moving horizontally, vertically align and catch up
                  | offsetY == 0 = (tX + offsetX, hYNew)
                  -- diagonally offset moving vertically, horizontally align and catch up
                  | offsetX == 0 = (hXNew, tY + offsetY)
                  -- diagonally offset moving diagonally but previous offset was horizontal, vertically align and recurse
                  | offsetX /= 0 && offsetY /= 0 && (hY - tY) == 0 = step ((hX, hY), (tX, hYNew)) (offsetX, offsetY)
                  -- diagonally offset moving diagonally but previous offset was vertical, horizontally align and recurse
                  | offsetX /= 0 && offsetY /= 0 && (hX - tX) == 0 = step ((hX, hY), (hXNew, tY)) (offsetX, offsetY)
                  -- diagonally offset moving diagonally by previous offset was diagonal, move in the same direction and recurse
                  | offsetX /= 0 && offsetY /= 0 && (hX - tX) /= 0 && (hY - tY) /= 0 = step ((hX, hY), (tX + offsetX, tY + offsetY)) (offsetX, offsetY)
                  | otherwise = error $ "wtf: offset x" ++ show offsetX ++ " y" ++ show offsetY ++ ", prev offset x" ++ show (hX - tX) ++ " y" ++ show (hY - tY)

-- for debugging
renderSeenMap :: [(Int, Int)] -> String
renderSeenMap positions = intercalate "\n" $ map (\y -> map (\x -> if (x, y) `elem` positions then '#' else '.') [0..maxX]) (reverse [0..maxY])
  where maxX = maximum $ map fst positions
        maxY = maximum $ map snd positions

main = interact $
  show
  . length . run
  . unrollInstructions . parseInstructions