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

import Prelude hiding (Left, Right)
import Data.List

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

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

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)

run :: [Direction] -> [(Int, Int)]
run = (\(a, b, l) -> l) . foldl stepAccum ((0, 0), (0, 0), [(0, 0)])
  where stepAccum :: ((Int, Int), (Int, Int), [(Int, Int)]) -> Direction -> ((Int, Int), (Int, Int), [(Int, Int)])
        stepAccum (posHead, posTail, l) i = (newPosHead, newPosTail, if newPosTail `elem` l then l else newPosTail : l)
          where (newPosHead, newPosTail) = step (posHead, posTail) i

        step :: ((Int, Int), (Int, Int)) -> Direction -> ((Int, Int), (Int, Int))
        step ((hX, hY), (tX, tY)) dir = ((hXNew, hYNew), (tXNew, tYNew))
          where (offsetX, offsetY) = directionToOffset dir
                (hXNew, hYNew) = addPos (hX, hY) (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)

-- 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