solve 2022 day 4 pt 1 & 2

2022/README.md

@@ -3,7 +3,7 @@
 |  S  |  M  |  T  |  W  |  T  |  F  |  S   |
 | :-: | :-: | :-: | :-: | :-: | :-: | :--: |
 |     |     |     |     | [1] | [2] |  [3] |
-|  4  |  5  |  6  |  7  |  8  |  9  |  10  |
+| [4] |  5  |  6  |  7  |  8  |  9  |  10  |
 | 11  | 12  | 13  | 14  | 15  | 16  |  17  |
 | 18  | 19  | 20  | 21  | 22  | 23  |  24  |
 | 24  |     |     |     |     |     |      |
@@ -11,3 +11,4 @@
 [1]: ./src/Aoc/Day1.hs
 [2]: ./src/Aoc/Day2.hs
 [3]: ./src/Aoc/Day3.hs
+[4]: ./src/Aoc/Day4.hs

2022/aoc.cabal

@@ -25,9 +25,11 @@ source-repository head
 
 library
   exposed-modules:
+      Aoc
       Aoc.Day1
       Aoc.Day2
       Aoc.Day3
+      Aoc.Day4
   other-modules:
       Paths_aoc
   hs-source-dirs:

2022/app/Main.hs

@@ -5,6 +5,7 @@ import System.Environment (getArgs)
 import qualified Aoc.Day1
 import qualified Aoc.Day2
 import qualified Aoc.Day3
+import qualified Aoc.Day4
 
 main :: IO ()
 main = do
@@ -17,6 +18,7 @@ main = do
   let f = case day of 1 -> Aoc.Day1.solve
                       2 -> Aoc.Day2.solve
                       3 -> Aoc.Day3.solve
+                      4 -> Aoc.Day4.solve
                       _ -> error "unknown day"
 
   putStrLn $ show $ f part contents

2022/src/Aoc.hs

@@ -0,0 +1,11 @@
+module Aoc (runReadP) where
+
+import Text.ParserCombinators.ReadP
+
+runReadP :: ReadP a -> String -> a
+runReadP p s = unwrap $ readP_to_S p s
+  where
+    unwrap [(a, "")]  = a
+    unwrap [(_, _rs)] = error "Parser did not consume entire stream."
+    unwrap (_:as)     = unwrap as
+    unwrap _          = error "Parser error."

2022/src/Aoc/Day4.hs

@@ -0,0 +1,50 @@
+module Aoc.Day4 (solve) where
+
+import Aoc (runReadP)
+import Data.Char
+import Text.ParserCombinators.ReadP
+
+type Range = (Int, Int)
+type Row = (Range, Range)
+type Input = [Row]
+
+parse :: String -> Input
+parse = map (runReadP rowP) . lines
+  where
+    intP :: ReadP Int
+    intP = do
+      digits <- munch1 isDigit
+      return $ read digits
+
+    rangeP :: ReadP Range
+    rangeP = do
+      l <- intP
+      _ <- char '-'
+      r <- intP
+      return (l, r)
+
+    rowP :: ReadP Row
+    rowP = do
+      a <- rangeP
+      _ <- char ','
+      b <- rangeP
+      return (a, b)
+
+fullOverlap :: Row -> Bool
+fullOverlap ((a, b), (c, d))
+  | a <= c && b >= d = True
+  | c <= a && d >= b = True
+  | otherwise        = False
+
+overlap :: Row -> Bool
+overlap ((a, b), (c, d))
+  | b < c     = False -- first is fully to the left of second
+  | d < a     = False -- first is fully to the right of second
+  | otherwise = True  -- there's some overlap
+
+solve :: Integer -> String -> Integer
+solve 1 input = fromIntegral $ length $ filter fullOverlap $ parse input
+
+solve 2 input = fromIntegral $ length $ filter overlap $ parse input
+
+solve _ _ = 0