Not hugely proud of this one; part one would have been easier if I’d spend more time reading the question and not started on an overly-general solution, and I lost a lot of time on part two to a missing a +. More haste, less speed, eh?
<span style="color:#323232;">import Data.List
</span><span style="color:#323232;">import Data.List.Split
</span><span style="color:#323232;">
</span><span style="color:#323232;">readInput :: String -> ([Int], [(String, [(Int, Int, Int)])])
</span><span style="color:#323232;">readInput s =
</span><span style="color:#323232;"> let (seedsChunk : mapChunks) = splitOn [""] $ lines s
</span><span style="color:#323232;"> seeds = map read $ tail $ words $ head seedsChunk
</span><span style="color:#323232;"> maps = map readMapChunk mapChunks
</span><span style="color:#323232;"> in (seeds, maps)
</span><span style="color:#323232;"> where
</span><span style="color:#323232;"> readMapChunk (title : rows) =
</span><span style="color:#323232;"> let name = head $ words title
</span><span style="color:#323232;"> entries = map (([a, b, c] -> (a, b, c)) . map read . words) rows
</span><span style="color:#323232;"> in (name, entries)
</span><span style="color:#323232;">
</span><span style="color:#323232;">part1 (seeds, maps) =
</span><span style="color:#323232;"> let f = foldl1' (flip (.)) $ map (ref . snd) maps
</span><span style="color:#323232;"> in minimum $ map f seeds
</span><span style="color:#323232;"> where
</span><span style="color:#323232;"> ref [] x = x
</span><span style="color:#323232;"> ref ((a, b, c) : rest) x =
</span><span style="color:#323232;"> let i = x - b
</span><span style="color:#323232;"> in if i >= 0 && i < c
</span><span style="color:#323232;"> then a + i
</span><span style="color:#323232;"> else ref rest x
</span><span style="color:#323232;">
</span><span style="color:#323232;">mapRange :: [(Int, Int, Int)] -> (Int, Int) -> [(Int, Int)]
</span><span style="color:#323232;">mapRange entries (start, end) =
</span><span style="color:#323232;"> go start $ sortOn ((_, b, _) -> b) entries
</span><span style="color:#323232;"> where
</span><span style="color:#323232;"> go i [] = [(i, end)]
</span><span style="color:#323232;"> go i es@((a, b, c) : rest)
</span><span style="color:#323232;"> | i > end = []
</span><span style="color:#323232;"> | b > end = go i []
</span><span style="color:#323232;"> | b + c <= i = go i rest
</span><span style="color:#323232;"> | i < b = (i, b - 1) : go b es
</span><span style="color:#323232;"> | otherwise =
</span><span style="color:#323232;"> let d = min (b + c - 1) end
</span><span style="color:#323232;"> in (a + i - b, a + d - b) : go (d + 1) rest
</span><span style="color:#323232;">
</span><span style="color:#323232;">part2 (seeds, maps) =
</span><span style="color:#323232;"> let seedRanges = map ([a, b] -> (a, a + b - 1)) $ chunksOf 2 seeds
</span><span style="color:#323232;"> in minimum $ map fst $ foldl' (flip mapRanges) seedRanges $ map snd maps
</span><span style="color:#323232;"> where
</span><span style="color:#323232;"> mapRanges m = concatMap (mapRange m)
</span><span style="color:#323232;">
</span><span style="color:#323232;">main = do
</span><span style="color:#323232;"> input <- readInput <$> readFile "input05"
</span><span style="color:#323232;"> print $ part1 input
</span><span style="color:#323232;"> print $ part2 input
</span>