diff --git a/app/Day5.hs b/app/Day5.hs
index 3368606..5defbd9 100644
--- a/app/Day5.hs
+++ b/app/Day5.hs
@@ -1,5 +1,8 @@
 module Main where
 
+import Control.Arrow ((***))
+import Data.Ix (inRange)
+import Data.List (foldl', sort)
 import System.Environment (getArgs)
 
 main :: IO ()
@@ -14,19 +17,37 @@ part1 = length . uncurry (filter . isFresh) . parse
     isFresh :: [(Int, Int)] -> Int -> Bool
     isFresh fresh ing = any (contained ing) fresh
 
-    contained :: Int -> (Int, Int) -> Bool
-    contained a (x, y) = x <= a && a <= y
+contained :: Int -> (Int, Int) -> Bool
+contained = flip inRange
 
+-- Splits input on empty line and parses the first half with genRanges
+-- and the second half into ints with read.
 parse :: String -> ([(Int, Int)], [Int])
-parse = (\(ranges, ingredients) -> ((map parseRange ranges), map read (drop 1 ingredients))) . span (/= "") . lines
+parse = (genRanges *** (map read . drop 1)) . span (/= "") . lines
   where
+    genRanges :: [String] -> [(Int, Int)]
+    genRanges = foldl' (mergeRanges) mempty . sort . map parseRange
+
+    -- Parse "X-Y" -> (X, Y)
     parseRange :: String -> (Int, Int)
     parseRange s = case span (/= '-') s of
       (start, '-' : end) -> (read start, read end)
       _ -> error $ "parseRange: expected a string on the form \"NUM-NUM\", got \"" <> s <> "\""
 
+    -- Generate ranges by combining adjacent ranges if they overlap.
+    --
+    -- Ignores ranges that are fully enclosed by previous range.
+    -- N.B. Assumes ranges are sorted on first component.
+    mergeRanges :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
+    mergeRanges [] i = [i]
+    mergeRanges fresh@((a, b) : rest) (x, y)
+      | x `contained` (a, b) && y > b = (a, y) : rest
+      | x < a && y `contained` (a, b) = (x, b) : rest
+      | x `contained` (a, b) && y `contained` (a, b) = fresh
+      | otherwise = (x, y) : fresh
+
 part2 :: String -> Int
-part2 = error "Not implemented"
+part2 = sum . map ((+ 1) . uncurry (flip (-))) . fst . parse
 
 testInput :: String
 testInput =