2022/04/Main.idr

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