runMachine
  :: (MonadState Machine m, MonadWriter [Int] m)
  => Int
  -> m ()
runMachine input = do
  op <- getOp
  case op of
    (Add m1 m2) -> do
      arithBinOp (+) m1 m2
      stepPc op
      runMachine input
    (Mul m1 m2) -> do
      arithBinOp (*) m1 m2
      stepPc op
      runMachine input
    Input -> do
      p <- read Immediate 1
      write input p
      stepPc op
      runMachine input
    Output -> do
      p <- read Position 1
      tell [p]
      stepPc op
      runMachine input
    (JumpT m1 m2) -> do
      v <- read m1 1
      case v of
        0 -> stepPc op
        _ -> do
          p <- read m2 2
          setPc p
      runMachine input
    (JumpF m1 m2) -> do
      v <- read m1 1
      case v of
        0 -> do
          p <- read m2 2
          setPc p
        _ -> stepPc op
      runMachine input
    (LessThan m1 m2) -> do
      arithBinOp (\v1 v2 -> if v1 < v2 then 1 else 0) m1 m2
      stepPc op
      runMachine input
    (EqTo m1 m2) -> do
      arithBinOp (\v1 v2 -> if v1 == v2 then 1 else 0) m1 m2
      stepPc op
      runMachine input
    Terminate -> return ()

 where
  arithBinOp f m1 m2 = do
    v1 <- read m1 1
    v2 <- read m2 2
    p3 <- read Immediate 3
    write (f v1 v2) p3

  getOp = do
    (Machine state pc) <- get
    return . parseOp $ state ! pc

  write n p = do
    m@Machine{..} <- get
    put $ m { mState = mState // [(p, n)] }

  read m p = do
    (Machine state pc) <- get
    case m of
      Position  ->
        return $ state ! (state ! (pc + p))
      Immediate ->
        return $ state ! (pc+p)

  stepPc op = do
    modify (\m@Machine{..} -> m { mPc = mPc + paramCt op + 1})

  setPc p =
    modify (\m -> m { mPc = p })