import Data.List.Split
import Data.List as L
import Data.Vector as V hiding ((++), concatMap, map, elem, last, head, length, splitAt, reverse)
import qualified Data.Vector as V ((++), last)
import Data.Char
import Control.DeepSeq as DeepSeq

data OutAction = Continue | Output | Halt deriving (Enum, Eq, Show)
data Mode = Position | Immediate | Relative deriving (Enum, Eq, Show)
type Tape = Vector Integer
type TapeSection = Vector Integer
type TuringMachine = (Tape,Integer,Integer)

main = do
    content <- readFile "input"
    let tape = fromList $ concatMap (map read . splitOn ",") (lines content)
    let run x = execSteps ((tapePreprocess tape,0,0),[x],[],Continue)
    let (_,_,out1,_) = run 1
    let (_,_,out2,_) = run 2
    print $ L.concat ["Part 1: " ++ show a ++ ", Part 2: " ++ show b | a<-out1,b<-out2]

tapePreprocess :: TapeSection -> TapeSection
tapePreprocess t = (V.++) t $ V.replicate 105 0


opLength :: Integer -> Integer
opLength x
    | n`elem`"1278"=4
    | n`elem`"56"=3
    | n`elem`"349"=2
    | otherwise=1
    where n = last $ show x

parseModes :: String -> [Mode]
parseModes m = L.replicate (3 - length l) Position ++ l
    where l = map (toEnum . digitToInt) m

paramChange :: [Mode] -> Integer -> TapeSection -> Tape -> TapeSection
paramChange m rbase opvec t = imap f (V.tail opvec)
    where f i a = case m !! i of
                    Immediate -> a
                    Position  -> t ! fromInteger a
                    Relative  -> t ! fromInteger (a + rbase)

getOpModes :: TapeSection -> (String, [Mode])
getOpModes opvec = (op_dedup,parsed_modes)
    where (op,modes) = splitAt 2 $ reverse $ show $ opvec ! 0
          parsed_modes = reverse $ parseModes $ reverse modes
          op_dedup = if last op == '0' then [head op] else op

step :: TapeSection -> (TuringMachine, [Integer], [Integer]) -> (TuringMachine, OutAction, [Integer], [Integer])
step opvec ((t,p,rbase),input,output) = case op of
    "1" -> (tm_binop (+),Continue,input,output)
    "2" -> (tm_binop (*),Continue,input,output)
    "3" -> (new_tm t $ head input,Continue,L.tail input,output)
    "4" -> ((t,p,rbase),Output,input,V.last params:output)
    "5" -> ((t, if params ! 0/=0 then params ! 1 else p,rbase),Continue,input,output)
    "6" -> ((t, if params ! 0==0 then params ! 1 else p,rbase),Continue,input,output)
    "7" -> (tm_binop (\x y->if x<y then 1 else 0),Continue,input,output)
    "8" -> (tm_binop (\x y->if x==y then 1 else 0),Continue,input,output)
    "9" -> ((t,p,rbase + (params ! 0)),Continue,input,output)
    "99" -> ((t,p,rbase),Halt,input,output)
    where (op,m) = getOpModes opvec
          params = paramChange m rbase opvec t
          tm_binop x = new_tm t ((params ! 0) `x` (params ! 1))
          {-without the following DeepSeq call, thunks build up eternally and
          the vectors won’t be garbage collected: >4GB RAM usage, god knows
          how much with larger tapes (my laptop crashed), now it’s a cozy ~20mB-}
          new_tm t x = DeepSeq.force (t // [(target, x)],p,rbase)
          target = fromInteger $ case m !! (length params -1) of
                     Relative -> V.last opvec + rbase
                     _ -> V.last opvec

execSteps :: (TuringMachine, [Integer], [Integer], OutAction) -> (TuringMachine, [Integer], [Integer], OutAction)
execSteps ((t,p,rbase),input,output,halt) =
    let command_length = opLength $! t ! fromInteger p
        opvec = slice (fromInteger p) (fromInteger command_length) t
        ((t_new,p_new,rbase_new),cond,input_new,output_new) =
            step opvec ((t,p+command_length,rbase),input,output) in
    case cond of
      Halt -> ((t_new,p_new,rbase_new),input_new,output_new,cond)
      _ -> execSteps ((t_new,p_new,rbase_new),input_new,output_new,cond)