diff --git a/hs/src/Aoc/Y2019.hs b/hs/src/Aoc/Y2019.hs
index bb5bd84..6fb5cff 100644
--- a/hs/src/Aoc/Y2019.hs
+++ b/hs/src/Aoc/Y2019.hs
@@ -5,9 +5,11 @@ module Aoc.Y2019
 import           Aoc.Day
 import qualified Aoc.Y2019.D01 as D01
 import qualified Aoc.Y2019.D02 as D02
+import qualified Aoc.Y2019.D03 as D03
 
 year :: Year
 year = Year 2019
   [ ( 1, D01.day)
   , ( 2, D02.day)
+  , ( 3, D03.day)
   ]
diff --git a/hs/src/Aoc/Y2019/A03.hs b/hs/src/Aoc/Y2019/D03.hs
similarity index 63%
rename from hs/src/Aoc/Y2019/A03.hs
rename to hs/src/Aoc/Y2019/D03.hs
index b697709..229c200 100644
--- a/hs/src/Aoc/Y2019/A03.hs
+++ b/hs/src/Aoc/Y2019/D03.hs
@@ -1,15 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Aoc.Y2019.A03
-  ( solve201903
+module Aoc.Y2019.D03
+  ( day
   ) where
 
 import           Data.List
-import           Data.Maybe
+
 import qualified Data.Map.Strict as M
-import qualified Data.Text as T
-import qualified Data.Text.IO as T
-import           Text.Read (readMaybe)
+
+import           Aoc.Day
+import           Aoc.Parse
 
 data Pos = Pos Int Int
   deriving (Show, Eq, Ord)
@@ -51,30 +51,25 @@ intersections s1 s2 =
       costs2 = costs $ steps zeroPos s2
   in  M.toList $ M.intersectionWith (+) costs1 costs2
 
--- Reading input
+parser :: Parser ([Step], [Step])
+parser = do
+  s1 <- (pStep `sepBy` char ',') <* newline
+  s2 <- (pStep `sepBy` char ',') <* newline
+  pure (s1, s2)
+  where
+    pStep = Step <$> pDir <*> decimal
+    pDir = (U <$ char 'U') <|> (D <$ char 'D') <|> (L <$ char 'L') <|> (R <$ char 'R')
 
-readDir :: Char -> Maybe Dir
-readDir 'U' = Just U
-readDir 'D' = Just D
-readDir 'L' = Just L
-readDir 'R' = Just R
-readDir _ = Nothing
-
-readStep :: String -> Maybe Step
-readStep [] = Nothing
-readStep (d:n) = Step <$> readDir d <*> readMaybe n
-
-readSteps :: T.Text -> Maybe [Step]
-readSteps = traverse (readStep . T.unpack) . T.splitOn ","
-
-solve201903 :: FilePath -> IO ()
-solve201903 f = do
-  text <- T.readFile f
-  let [steps1, steps2] = mapMaybe readSteps $ T.lines text
-      ixs = intersections steps1 steps2
+solver :: ([Step], [Step]) -> IO ()
+solver (steps1, steps2) = do
+  let ixs = intersections steps1 steps2
 
   putStrLn ">> Part 1"
   print $ manhattan $ fst $ head $ sortOn (manhattan . fst) ixs
 
+  putStrLn ""
   putStrLn ">> Part 2"
   print $ snd $ head $ sortOn snd ixs
+
+day :: Day
+day = dayParse parser solver