diff --git a/haskell/aoc2023.cabal b/haskell/aoc2023.cabal
index 285abdf..4f1a2fb 100644
--- a/haskell/aoc2023.cabal
+++ b/haskell/aoc2023.cabal
@@ -25,6 +25,7 @@ library
                     , Day3
                     , Day4
                     , Day5
+                    , Day6
 
 executable aoc2023
     import:           warnings
diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs
index b41fd59..510e464 100644
--- a/haskell/app/Main.hs
+++ b/haskell/app/Main.hs
@@ -4,10 +4,11 @@ module Main where
 
 import Day1 qualified
 import Day2 qualified
+import Day3 qualified
+import Day4 qualified
+import Day5 qualified
+import Day6 qualified
 import System.Environment (getArgs)
-import qualified Day3
-import qualified Day4
-import qualified Day5
 
 main :: IO ()
 main = do
@@ -17,4 +18,5 @@ main = do
     ["day3"] -> Day3.run
     ["day4"] -> Day4.run
     ["day5"] -> Day5.run
+    ["day6"] -> Day6.run
     args -> error $ "Invlaid args: " <> show args
diff --git a/haskell/src/Day6.hs b/haskell/src/Day6.hs
new file mode 100644
index 0000000..1de98de
--- /dev/null
+++ b/haskell/src/Day6.hs
@@ -0,0 +1,99 @@
+module Day6 where
+
+import Data.Char
+import Text.ParserCombinators.ReadP
+
+run :: IO ()
+run = do
+  (records, record) <- readInput
+  putStrLn $ "Part 1 Answer: " <> show (part1 records)
+  putStrLn $ "Part 2 Answer: " <> show (part2 record)
+
+part1 :: [Record] -> Int
+part1 =
+  product . map (uncurry waysOfWinning)
+
+part2 :: Record -> Int
+part2 = uncurry waysOfWinning
+
+-- | There is definitely a better way for doing this. But this runs in less than
+-- a second.
+waysOfWinning :: Time -> Distance -> Int
+waysOfWinning time recordDistance =
+  length $ filter (> recordDistance) $ productsOfAdders time
+
+-- | Finds products of all adders
+--
+-- >>> productsOfAdders 7
+-- [0,6,10,12,12,10,6,0]
+--
+-- >>> productsOfAdders 30
+-- [0,29,56,81,104,125,144,161,176,189,200,209,216,221,224,225,224,221,216,209,200,189,176,161,144,125,104,81,56,29,0]
+productsOfAdders :: Int -> [Int]
+productsOfAdders = map (uncurry (*)) . adders
+
+-- | Postitive integers which add up to the given integer
+--
+-- >>> adders 7
+-- [(0,7),(1,6),(2,5),(3,4),(4,3),(5,2),(6,1),(7,0)]
+--
+-- >>> adders 8
+-- [(0,8),(1,7),(2,6),(3,5),(4,4),(5,3),(6,2),(7,1),(8,0)]
+adders :: Int -> [(Int, Int)]
+adders n = map (\x -> (x, n - x)) [0 .. n]
+
+type Time = Int
+
+type Distance = Int
+
+type Race = (Time, Distance)
+
+type Record = (Time, Distance)
+
+readInput :: IO ([Record], Record)
+readInput = do
+  input <- getContents
+  let parseWith p = case readP_to_S p input of
+        [] -> error "Parser failed"
+        [(parsed, "")] -> parsed
+        xs -> error $ "Parser failed: " <> show xs
+  pure (parseWith recordsParser, parseWith betterRecordParser)
+
+numberParser :: ReadP Int
+numberParser =
+  read <$> munch1 isDigit
+
+timesParser :: ReadP [Time]
+timesParser = do
+  _ <- string "Time: "
+  _ <- skipSpaces
+  sepBy1 numberParser skipSpaces
+
+distancesParser :: ReadP [Distance]
+distancesParser = do
+  _ <- string "Distance: "
+  _ <- skipSpaces
+  sepBy1 numberParser skipSpaces
+
+recordsParser :: ReadP [Record]
+recordsParser = do
+  times <- timesParser
+  _ <- char '\n'
+  distances <- distancesParser
+  eof
+  pure $ zip times distances
+
+betterNumberParser :: ReadP Int
+betterNumberParser =
+  read . filter (/= ' ') <$> munch1 (\c -> c == ' ' || isDigit c)
+
+betterRecordParser :: ReadP (Time, Distance)
+betterRecordParser = do
+  _ <- string "Time: "
+  skipSpaces
+  t <- betterNumberParser
+  _ <- string "\nDistance: "
+  skipSpaces
+  d <- betterNumberParser
+  eof
+  pure (t, d)
diff --git a/input/day6 b/input/day6
new file mode 100644
index 0000000..671d365
--- /dev/null
+++ b/input/day6
@@ -0,0 +1,2 @@
+Time:        62     73     75     65
+Distance:   644   1023   1240   1023
\ No newline at end of file
diff --git a/input/day6-eg b/input/day6-eg
new file mode 100644
index 0000000..b39f49d
--- /dev/null
+++ b/input/day6-eg
@@ -0,0 +1,2 @@
+Time:      7  15   30
+Distance:  9  40  200
\ No newline at end of file