Day 4

Y2022.cabal

@@ -35,6 +35,7 @@ library
         Days.D01
         Days.D02
         Days.D03
+        Days.D04
     build-depends:
         megaparsec    ^>=9.4.0
       , text

app/Main.hs

@@ -11,6 +11,7 @@ paths =
     [ "./data/01.in"
     , "./data/02.in"
     , "./data/03.in"
+    , "./data/04.in"
     ]
 
 solutions :: [(Int, Day, FilePath)]
@@ -19,14 +20,13 @@ solutions = zip3 [1 ..] (map head days) paths
 runAll :: [(Int, Day, FilePath)] -> IO ()
 runAll = mapM_ (\(dayNum, day, path) -> run day path >>= printDR dayNum)
 
-header :: IO ()
-header = putStrLn "[ Day ]------(1)-----+------(2)----"
-
 usage :: IO ()
 usage = putStrLn "./Main"
 
 main :: IO ()
 main =
-    getArgs >>= \case
-        ["all"] -> header >> runAll solutions
-        _ -> header >> runAll [last solutions]
+    printHeader
+        >> getArgs
+        >>= \case
+            ["all"] -> runAll solutions
+            _ -> runAll [last solutions]

src/Days/D04.hs

@@ -0,0 +1,42 @@
+module Days.D04 where
+
+import Text.Megaparsec.Char as C (char)
+
+import Common
+import Parse (Parser, number, parsecDay, someLines)
+import Util (count)
+
+type Interval = (Int, Int)
+type Intermediate = [(Interval, Interval)]
+
+makeInterval :: (Ord a) => a -> a -> (a, a)
+makeInterval a b
+    | a > b = (b, a)
+    | otherwise = (a, b)
+
+parser :: Parser Intermediate
+parser = someLines ((,) <$> interval <* char ',' <*> interval)
+  where
+    interval :: Parser Interval
+    interval = makeInterval <$> number <* char '-' <*> number
+
+contains :: Interval -> Interval -> Bool
+contains (a, b) (c, d) = a <= c && b >= d
+
+overlap :: Interval -> Interval -> Bool
+overlap (a, b) (c, d) = not (b < c || a > d)
+
+sym :: (a -> a -> Bool) -> (a -> a -> Bool)
+sym f a b = f a b || f b a
+
+pairFilter :: (a -> b -> Bool) -> [(a, b)] -> [(a, b)]
+pairFilter f = filter (uncurry f)
+
+part1 :: Intermediate -> Int
+part1 = count (uncurry $ sym contains)
+
+part2 :: Intermediate -> Int
+part2 = count (uncurry overlap)
+
+day :: Day
+day = parsecDay parser (definitive . part1, definitive . part2)

src/Lib.hs

@@ -5,14 +5,16 @@ module Lib (
     Day,
     days,
     printDR,
+    printHeader,
 ) where
 
 import Common (Day (..), DayResult)
-import Print (printDR)
+import Print (printDR, printHeader)
 
 import Days.D01 qualified as D01
 import Days.D02 qualified as D02
 import Days.D03 qualified as D03
+import Days.D04 qualified as D04
 
 import Data.Text.IO qualified as T
 
@@ -26,4 +28,5 @@ days =
     [ [D01.day]
     , [D02.day]
     , [D03.day]
+    , [D04.day]
     ]

src/Print.hs

@@ -3,6 +3,9 @@ module Print where
 import Common
 import Text.Printf (printf)
 
+printHeader :: IO ()
+printHeader = putStrLn "[ Day ]------(1)-----+------(2)-----"
+
 printDR :: Int -> DayResult -> IO ()
 printDR day (Left errorString) = printf "[  %2d ] ====== PARSER ERROR =======\n%s" day errorString
 printDR day (Right (sol1, sol2)) =

src/Util.hs

@@ -5,3 +5,6 @@ dupe a = (a, a)
 
 both :: (a -> b) -> (a, a) -> (b, b)
 both f ~(x, y) = (f x, f y)
+
+count :: (a -> Bool) -> [a] -> Int
+count = (length .) . filter