module Main where

import Data.List (foldl')

import Input


data V2 a = V2 a a deriving (Show)

data M2 a = M2 a a a a deriving (Show)

class LinMappable v where
    vfmap :: (a -> b) -> v a -> v b
    vzip :: (a -> b -> c) -> v a -> v b -> v c
    vzero :: Num a => v a
instance LinMappable V2 where
    vfmap f (V2 a b) = V2 (f a) (f b)
    vzip f (V2 a b) (V2 a' b') = V2 (f a a') (f b b')
    vzero = V2 0 0
instance LinMappable M2 where
    vfmap f (M2 a b c d) = M2 (f a) (f b) (f c) (f d)
    vzip f (M2 a b c d) (M2 a' b' c' d') = M2 (f a a') (f b b') (f c c') (f d d')
    vzero = M2 0 0 0 0

(!+!) :: (LinMappable v, Num a) => v a -> v a -> v a
(!+!) = vzip (+)

dot :: Num a => V2 a -> V2 a -> a
dot (V2 a b) (V2 c d) = a * c + b * d

(*$) :: (LinMappable v, Num a) => v a -> a -> v a
v *$ s = vfmap (* s) v

(*!) :: Num a => M2 a -> V2 a -> V2 a
M2 a b c d *! v = V2 (V2 a b `dot` v) (V2 c d `dot` v)

-- mathematical axes: X faces east, Y faces north
-- Shift v: pos = pos + v
-- Sail v m1 m2: direction' = m1 *! direction; pos = pos + v + m2 *! direction'
data Instr = Sail (V2 Int) (M2 Int) (M2 Int)
  deriving (Show)

parseInstr :: String -> Instr
parseInstr (c : ns) = case (c, read ns :: Int) of
    ('N', n) -> Sail (V2 0 1 *$ n) idMat vzero
    ('S', n) -> Sail (V2 0 (-1) *$ n) idMat vzero
    ('E', n) -> Sail (V2 1 0 *$ n) idMat vzero
    ('W', n) -> Sail (V2 (-1) 0 *$ n) idMat vzero
    ('F', n) -> Sail vzero idMat (M2 1 0 0 1 *$ n)
    ('R', 90) -> Sail vzero rotRightMat vzero
    ('R', 180) -> Sail vzero mirrorMat vzero
    ('R', 270) -> Sail vzero rotLeftMat vzero
    ('L', 90) -> Sail vzero rotLeftMat vzero
    ('L', 180) -> Sail vzero mirrorMat vzero
    ('L', 270) -> Sail vzero rotRightMat vzero
    _ -> error "Cannot parse instr"
  where
    idMat = M2 1 0 0 1
    rotRightMat = M2 0 1 (-1) 0
    rotLeftMat = rotRightMat *$ (-1)
    mirrorMat = idMat *$ (-1)
parseInstr _ = error "Cannot parse empty instr"

data State = State { sPos :: V2 Int, sDir :: V2 Int }
  deriving (Show)

sail :: Instr -> State -> State
sail (Sail offset dirm posm) (State pos dir) =
    let dir' = dirm *! dir
    in State (pos !+! offset !+! (posm *! dir')) dir'

manhattan :: Num a => V2 a -> a
manhattan (V2 a b) = abs a + abs b

------------
-- PART 2 --
------------

data State2 = State2 { sPos2 :: V2 Int, sWP :: V2 Int }
  deriving (Show)

runInstr2 :: String -> State2 -> State2
runInstr2 (c : ns) = case (c, read ns :: Int) of
    ('N', n) -> addWP (V2 0 n)
    ('S', n) -> addWP (V2 0 (-n))
    ('E', n) -> addWP (V2 n 0)
    ('W', n) -> addWP (V2 (-n) 0)
    ('F', n) -> \(State2 ship wp) -> State2 (ship !+! (wp *$ n)) wp
    ('R', 90) -> mulWP rotRightMat
    ('R', 180) -> mulWP mirrorMat
    ('R', 270) -> mulWP rotLeftMat
    ('L', 90) -> mulWP rotLeftMat
    ('L', 180) -> mulWP mirrorMat
    ('L', 270) -> mulWP rotRightMat
    _ -> error "Cannot parse instr"
  where
    rotRightMat = M2 0 1 (-1) 0
    rotLeftMat = rotRightMat *$ (-1)
    mirrorMat = M2 (-1) 0 0 (-1)
    addWP v (State2 ship wp) = State2 ship (wp !+! v)
    mulWP m (State2 ship wp) = State2 ship (m *! wp)
runInstr2 _ = error "Cannot parse empty instr"

main :: IO ()
main = do
    input <- getInput 12
    print (manhattan . sPos $ foldl' (flip sail) (State (V2 0 0) (V2 1 0)) (map parseInstr input))
    print (manhattan . sPos2 $ foldl' (flip runInstr2) (State2 (V2 0 0) (V2 10 1)) input)