import Common
import Prelude hiding (Right, Left)
import Data.List.Split (splitOn)
import Data.Char (isNumber)
import Data.List (elemIndex)
import Data.Maybe (fromJust, fromMaybe)

data Tile = Blank | Empty | Wall
  deriving (Eq, Show, Enum)
data Direction = L | R
  deriving (Eq, Show, Enum)
data Facing = Up | Down | Left | Right
  deriving (Eq, Show, Enum)
data Instruction = Face Direction | Step Int
  deriving (Eq, Show)

type State = (Pos, Facing)

parseMap :: String -> Grid Tile
parseMap s = map parseRow rows
  where
    parseRow = map parseTile

    parseTile '#' = Wall
    parseTile '.' = Empty
    parseTile ' ' = Blank
    parseTile _ = undefined

    rows = lines s

turn :: Facing -> Direction -> Facing
turn Left R = Up
turn Up R = Right
turn Right R = Down
turn Down R = Left
turn Left L = Down
turn Up L = Left
turn Right L = Up
turn Down L = Right

charToDir :: Char -> Direction
charToDir 'L' = L
charToDir 'R' = R
charToDir _ = undefined

parseInstructions :: String -> [Instruction]
parseInstructions s = parseNum s
  where
    parseDirection :: String -> [Instruction]
    parseDirection [] = []
    parseDirection s = Face (charToDir (head s)) : parseNum (tail s)
    parseNum :: String -> [Instruction]
    parseNum [] = []
    parseNum s = Step (read num) : parseDirection rest
      where (num, rest) = span isNumber s

getInitialState :: Grid Tile -> State
getInitialState map = ((fromJust $ elemIndex Empty (head map), 0), Right)

forward :: Facing -> Pos
forward Right = (1, 0)
forward Down = (0, 1)
forward Left = (-1, 0)
forward Up = (0, -1)

opposite :: Facing -> Facing
opposite Right = Left
opposite Left = Right
opposite Up = Down
opposite Down = Up

getTile :: Grid Tile -> Pos -> Tile
getTile grid pos = fromMaybe Blank (grid !!? pos)

stepThrough :: (Grid Tile, [Instruction]) -> State
stepThrough (grid, instructions) = step (getInitialState grid) instructions
  where
    step :: State -> [Instruction] -> State
    step state [] = state
    step ((x, y), facing) (instruction:xs) = case instruction of
      Face dir -> step ((x, y), turn facing dir) xs
      Step 0 -> step ((x, y), facing) xs
      Step n -> case wrappedTile of
        Wall -> step ((x, y), facing) xs
        Empty -> step (wrappedPos, facing) (Step (n - 1) : xs)
        Blank -> error "huh?"
      where
        wrappedTile = getTile grid wrappedPos
        wrappedPos = if newTile == Blank then (until (\pos -> getTile grid pos == Blank && pos /= newPos) (`subPos` forward facing) newPos) `addPos` forward facing else newPos
        newTile = getTile grid newPos
        newPos = (x, y) `addPos` forward facing

facingToInt :: Facing -> Int
facingToInt Right = 0
facingToInt Down = 1
facingToInt Left = 2
facingToInt Up = 3

getPassword :: State -> Int
getPassword ((x, y), f) = 1000 * (y + 1) + 4 * (x + 1) + facingToInt f

main = interact $
  show
  . getPassword
  . stepThrough
  . (\[a, b] -> (parseMap $ unlines a, parseInstructions $ head b)) . splitOn [""] . lines