diff --git a/2019/day17/Helpers.hs b/2019/day17/Helpers.hs
new file mode 100644
index 0000000..eee3e80
--- /dev/null
+++ b/2019/day17/Helpers.hs
@@ -0,0 +1,50 @@
+module Helpers
+  ( v2x
+  , v2y
+  , drawMap
+  , drawLine
+  , unitVecs
+  ) where
+
+import Data.List
+import Data.List.Split
+import qualified Data.Map as M
+import Linear.V2
+
+v2x :: V2 a -> a
+v2x (V2 x _) = x
+
+v2y :: V2 a -> a
+v2y (V2 _ y) = y
+
+unitVecs :: [V2 Int]
+unitVecs = take 4 $ iterate perp (V2 0 1)
+
+drawLine :: V2 Int -> [V2 Int]
+drawLine (V2 0 0) = []
+drawLine (V2 a b)
+  | abs a > abs b = V2 (a - signum a) b : drawLine (V2 (a - signum a) b)
+  | otherwise = V2 a (b - signum b) : drawLine (V2 a (b - signum b))
+getBounds :: M.Map (V2 Int) Integer -> (Int, Int, Int, Int)
+getBounds m = (getMinX, getMinY, getMaxX, getMaxY)
+  where
+    getMaxX = getFromMap maximum v2x
+    getMaxY = getFromMap maximum v2y
+    getMinX = getFromMap minimum v2x
+    getMinY = getFromMap minimum v2y
+    getFromMap f1 f2 = M.foldrWithKey (\k _ result -> f1 [f2 k, result]) 0 m
+
+drawMap :: M.Map Integer Char -> M.Map (V2 Int) Integer -> String
+drawMap dict m =
+  intercalate "\n" $
+  transpose $
+  chunksOf
+    (abs (abs y1 - abs y2) + 1)
+    [ let c = M.findWithDefault (-99) (V2 x y) m
+       in M.findWithDefault ' ' c dict
+    | x <- [x1 .. x2]
+    , y <- [y1 .. y2]
+    ]
+  where
+    (x1, y1, x2, y2) = getBounds m
+
diff --git a/2019/day17/Intcode.hs b/2019/day17/Intcode.hs
new file mode 100644
index 0000000..6cc5bf0
--- /dev/null
+++ b/2019/day17/Intcode.hs
@@ -0,0 +1,172 @@
+module Intcode
+  ( TuringMachine(TM, tape, pointer, pointerOffset, output, input,
+              state)
+  , step
+  , defaultTM
+  , TMOutState(Continue, AwaitInput, Halt)
+  , execSteps
+  , readIntcode
+  ) where
+
+import Control.DeepSeq as DeepSeq
+import Data.Char
+import Data.List as L
+import Data.List.Split
+import Data.Maybe
+import Debug.Trace
+import Data.Vector as V hiding
+  ( (++)
+  , concatMap
+  , elem
+  , head
+  , last
+  , length
+  , map
+  , reverse
+  , splitAt
+  )
+import qualified Data.Vector as V ((++), last)
+
+data TMOutState
+  = Continue
+  | AwaitInput
+  | Halt
+  deriving (Enum, Eq, Show)
+
+data Mode
+  = Position
+  | Immediate
+  | Relative
+  deriving (Enum, Eq, Show)
+
+data TuringMachine =
+  TM
+    { tape :: Vector Integer
+    , pointer :: Integer
+    , pointerOffset :: Integer
+    , output :: [Integer]
+    , input :: Maybe Integer
+    , state :: TMOutState
+    }
+  deriving (Show)
+
+readIntcode :: String -> V.Vector Integer
+readIntcode = V.fromList . concatMap (map read . splitOn ",") . lines
+
+defaultTM :: Maybe (Int, Integer) -> Vector Integer -> TuringMachine
+defaultTM replacement t =
+  TM
+    { tape = maybe (tapePreprocess t (0,t ! 0)) (tapePreprocess t) replacement
+    , pointer = 0
+    , pointerOffset = 0
+    , output = []
+    , input = Nothing
+    , state = Continue
+    }
+
+tapePreprocess :: Vector Integer -> (Int, Integer) -> Vector Integer
+tapePreprocess t (target, repl) =
+  flip (//) [(target, repl)] $ (V.++) t $ V.replicate 22000 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 -> Vector Integer -> Vector Integer -> Vector Integer
+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 :: Vector Integer -> (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 :: TuringMachine -> TuringMachine
+step tm =
+  case op of
+    "1" -> tmBinop (+)
+    "2" -> tmBinop (*)
+    "3" ->
+      if isJust (input tm)
+        then (getNewTM (fromJust $ input tm)) {input = Nothing}
+        else tm {state = AwaitInput}
+    "4" -> tmn {output = V.last params : output tm}
+    "5" ->
+      tm
+        { pointer =
+            if params ! 0 /= 0
+              then params ! 1
+              else pNew
+        }
+    "6" ->
+      tm
+        { pointer =
+            if params ! 0 == 0
+              then params ! 1
+              else pNew
+        }
+    "7" ->
+      tmBinop
+        (\x y ->
+           if x < y
+             then 1
+             else 0)
+    "8" ->
+      tmBinop
+        (\x y ->
+           if x == y
+             then 1
+             else 0)
+    "9" -> tmn {pointerOffset = pointerOffset tm + (params ! 0)}
+    "99" -> tm {state = Halt}
+    _ -> error "Illegal Opcode."
+  where
+    pNew = pointer tm + opLength (tape tm ! fromInteger (pointer tm))
+    tmn = tm {pointer = pNew}
+    opvec =
+      slice
+        (fromInteger (pointer tm))
+        (fromInteger (pNew - pointer tm))
+        (tape tm)
+    (op, m) = getOpModes opvec
+    params = paramChange m (pointerOffset tm) opvec (tape tm)
+    tmBinop x = getNewTM ((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-}
+    getNewTM x =
+      tmn {tape = DeepSeq.force (tape tm // [(target, x)]), state = Continue}
+    target =
+      fromInteger $
+      case m !! (length params - 1) of
+        Relative -> V.last opvec + pointerOffset tm
+        _ -> V.last opvec
+
+execSteps :: TuringMachine -> TuringMachine
+execSteps tm =
+  case state tmNew of
+    Continue -> execSteps tmNew
+    _ -> tmNew
+  where
+    tmNew = step tm
diff --git a/2019/day17/day17.hs b/2019/day17/day17.hs
new file mode 100644
index 0000000..97f78e4
--- /dev/null
+++ b/2019/day17/day17.hs
@@ -0,0 +1,195 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main where
+
+import Control.Arrow ((&&&))
+import Data.List
+import Data.List.Split
+import Data.List.Utils
+import qualified Data.Map.Strict as M
+import Data.Maybe
+import qualified Data.Set as S
+import Helpers
+import Intcode
+import Linear.V2
+import System.Console.ANSI
+import System.IO
+  ( BufferMode(NoBuffering)
+  , hReady
+  , hSetBuffering
+  , hSetEcho
+  , stdin
+  )
+
+type ScreenBuffer = M.Map (V2 Int) Integer
+
+main :: IO ()
+main = do
+  program <- readIntcode <$> readFile "input"
+  let tm = defaultTM (Nothing) program
+  let run x = runGameloop $ pure (tm, M.empty, True)
+  (_, buf, _) <- run 0
+  let cmd = getCMD buf
+  print cmd
+
+takeRepl s n a = replace (take n ((funTake . funTail) a)) [s] a
+  where
+    funTail = dropWhile (`elem` ["a", "b"])
+    funTake = takeWhile (`notElem` ["a", "b"])
+
+tryPartition (x, y, z) = takeRepl "c" z . takeRepl "b" y . takeRepl "a" x
+
+part2 seq =
+  catMaybes
+    [ if ((== 3) . length . S.fromList . tryPartition (x, y, z)) seq
+      then Just (x, y, z)
+      else Nothing
+    | x <- [1 .. 10]
+    , y <- [1 .. 10]
+    , z <- [1 .. 10]
+    ]
+
+runGameloop ::
+     IO (TuringMachine, ScreenBuffer, Bool)
+  -> IO (TuringMachine, ScreenBuffer, Bool)
+runGameloop io = do
+  (tm, buf, mode) <- io
+  let tmNew = execSteps tm
+  print $ output tmNew
+  let bufNew = updateScreenBuffer buf (0, 0) $ reverse $ output tmNew
+  putStrLn $ drawBoard bufNew
+  putStrLn $ "Highscore: " ++ getHighscore bufNew
+  putStrLn $ "Blocks left: " ++ countBlocks bufNew
+  case state tmNew of
+    AwaitInput -> do
+      nextCommand <-
+        if mode
+          then do
+            clearScreen
+            getInput
+          else pure $ getInputBot (output tmNew)
+      runGameloop $
+        pure (tmNew {input = Just nextCommand, output = []}, bufNew, mode)
+    _ -> pure (tmNew, bufNew, mode)
+
+getInputBot :: [Integer] -> Integer
+getInputBot n = negate $ signum paddleBallDiff
+  where
+    f :: (V2 Int, V2 Int) -> [(V2 Int, Integer)] -> (V2 Int, V2 Int)
+    (ball, paddle) = f (V2 0 0, V2 0 0) vals
+    vals = M.toList $ updateScreenBuffer M.empty (0, 0) $ reverse n
+    paddleBallDiff = fromIntegral $ v2x $ ball - paddle
+    f (paddle, ball) [] = (paddle, ball)
+    f (paddle, ball) ((coord, obj):xs)
+      | obj == 4 = f (paddle, coord) xs
+      | obj == 3 = f (coord, ball) xs
+      | otherwise = f (paddle, ball) xs
+
+getHighscore :: ScreenBuffer -> String
+getHighscore buf = show $ M.findWithDefault 0 (V2 (-1) 0) buf
+
+getInput :: IO Integer
+getInput = do
+  hSetBuffering stdin NoBuffering
+  hSetEcho stdin False
+  getKeyNow >>= \case
+    "i" -> pure (-1)
+    "a" -> pure 0
+    "e" -> pure 1
+    _ -> getInput
+
+getKeyNow :: IO String
+getKeyNow = reverse <$> getKey' ""
+  where
+    getKey' chars = do
+      char <- getChar
+      more <- hReady stdin
+      (if more
+         then getKey'
+         else return)
+        (char : chars)
+
+updateScreenBuffer :: ScreenBuffer -> (Int, Int) -> [Integer] -> ScreenBuffer
+updateScreenBuffer buf _ [] = buf
+updateScreenBuffer buf (x, y) (a:as) = updateScreenBuffer bufNew coord as
+  where
+    bufNew =
+      if a /= 10
+        then M.insert (V2 x y) a buf
+        else buf
+    coord =
+      if a /= 10
+        then (x + 1, y)
+        else (0, y + 1)
+
+countBlocks :: ScreenBuffer -> String
+countBlocks = show . length . M.filter (== 2)
+
+drawBoard :: ScreenBuffer -> String
+drawBoard =
+  drawMap
+    (M.fromList
+       [(35, '#'), (46, '.'), (62, '>'), (60, '<'), (94, '^'), (118, 'v')])
+
+getIntersections :: ScreenBuffer -> ScreenBuffer
+getIntersections buf = M.filterWithKey f buf
+  where
+    f k v = v == 35 && and [buf M.!? (k + u) == Just 35 | u <- unitVecs]
+
+getTurns :: ScreenBuffer -> ScreenBuffer
+getTurns buf = M.filterWithKey f buf M.\\ getIntersections buf
+  where
+    f k v =
+      v == 35 &&
+      or
+        [ buf M.!? (k + u) == Just 35 && buf M.!? (k + perp u) == Just 35
+        | u <- unitVecs
+        ]
+
+countIntAlign :: ScreenBuffer -> String
+countIntAlign m = show $ sum [x * y | (V2 x y, _) <- M.toList m]
+
+toRelPath :: [V2 Int] -> [V2 Int]
+toRelPath path = zipWith (-) (tail path) path
+
+toCMD :: V2 Int -> [V2 Int] -> [String]
+toCMD _ [] = []
+toCMD u (x:xs)
+  | crossZ u x < 0 = ("R" ++ (show . abs . sum) x) : toCMD (perp u) xs
+  | crossZ u x >= 0 = ("L" ++ (show . abs . sum) x) : toCMD (perp (u * (-1))) xs
+
+getCMD :: ScreenBuffer -> [String]
+getCMD buf = toCMD dir (toRelPath path)
+  where
+    (pos, dir) = roboPos buf
+    path = pos : getPath buf [] [pos]
+
+getPath :: ScreenBuffer -> [V2 Int] -> [V2 Int] -> [V2 Int]
+getPath _ acc [] = acc
+getPath m acc currs =
+  let a = nextTurn \\ acc
+   in getPath m (acc ++ a) a
+  where
+    curr = head currs
+    candidates =
+      M.filterWithKey
+        (\k _ -> v2x (k - curr) == 0 || v2y (k - curr) == 0)
+        (getTurns m)
+    isConnected =
+      M.filterWithKey
+        (\k _ ->
+           and
+             [ m M.!? x `elem` [Just 35, Just 94]
+             | x <- map (+ curr) $ drawLine (k - curr)
+             ])
+    nextTurn =
+      map fst $
+      M.toList $ M.filterWithKey (\k _ -> M.member k m) $ isConnected candidates
+
+roboPos :: ScreenBuffer -> (V2 Int, V2 Int)
+roboPos = toTuple . M.toList . M.filter (`elem` [60, 62, 94, 118])
+  where
+    toTuple [(k, 60)] = (k, V2 (-1) 0)
+    toTuple [(k, 62)] = (k, V2 1 0)
+    toTuple [(k, 94)] = (k, V2 0 1)
+    toTuple [(k, 118)] = (k, V2 0 (-1))