Day 4 Part 2

04/Main.idr

@@ -0,0 +1,62 @@
+import Data.String
+import Data.List1
+import System.File.ReadWrite
+
+record Range where
+  constructor MkRange
+  start, end : Int
+
+-- Parse a range from a string like "2-4"
+parseRange : String -> Maybe Range
+parseRange str =
+  let components = forget $ Data.String.split (== '-') str
+  in case components of
+       [x, y] => do start <- parseInteger x
+                    end <- parseInteger y
+                    Just $ MkRange start end
+       _ => Nothing
+
+-- Return true if the first range contains the second
+contains : Range -> Range -> Bool
+contains outer inner = (start outer <= start inner) && (end outer >= end inner)
+
+-- Returns true if the first range contains part of the second
+overlaps : Range -> Range -> Bool
+overlaps outer inner = start outer <= start inner && end outer >= start inner
+
+record RangePair where
+  constructor MkRangePair
+  first, second : Range
+
+-- Parse a range pair from a string like "2-4,5-8"
+parseRangePair : String -> Maybe RangePair
+parseRangePair str =
+  let components = forget $ Data.String.split (== ',') str
+  in case components of
+       [x, y] => do first <- parseRange x
+                    second <- parseRange y
+                    Just $ MkRangePair first second
+       _ => Nothing
+
+-- Returns true if one of the ranges contains the other
+doesContain : RangePair -> Bool
+doesContain pair = contains (first pair) (second pair) || contains (second pair) (first pair)
+
+-- Returns true if one of the ranges overlaps the other
+doesOverlap : RangePair -> Bool
+doesOverlap pair = overlaps (first pair) (second pair) || overlaps (second pair) (first pair)
+
+
+main : IO ()
+main =
+  do file <- readFile "input"
+     case file of
+       Right content =>
+         let pairs = catMaybes . map parseRangePair . lines $ content
+             containsCount = length . filter doesContain $ pairs
+             overlapsCount = length . filter doesOverlap $ pairs
+         in do putStr "Part 1: "
+               printLn containsCount
+               putStr "Part 2: "
+               printLn overlapsCount
+       Left err => printLn err