Overengineered Day4, part two

adventofcode.cabal

@@ -15,6 +15,7 @@ library
       AoC.Day1
       AoC.Day2
       AoC.Day3
+      AoC.Day4
   other-modules:
       Paths_adventofcode
   hs-source-dirs:

executable/Main.hs

@@ -3,6 +3,7 @@
 import AoC.Day1 as Day1
 import AoC.Day2 as Day2
 import AoC.Day3 as Day3
+import AoC.Day4 as Day4
 
 import qualified Data.Text.IO as T (readFile)
 
@@ -25,3 +26,10 @@ main = do
   putStrLn $ show $ Day3.solveA input3
   putStrLn $ show $ Day3.solveB demoInput3
   putStrLn $ show $ Day3.solveB input3
+
+  input4 <- T.readFile "./input/day4.txt"
+  let demoInput4 = "2-4,6-8\n2-3,4-5\n5-7,7-9\n2-8,3-7\n6-6,4-6\n2-6,4-8"
+  putStrLn $ show $ Day4.solveA demoInput4
+  putStrLn $ show $ Day4.solveA input4
+  putStrLn $ show $ Day4.solveB demoInput4
+  putStrLn $ show $ Day4.solveB input4

package.yaml

@@ -15,6 +15,7 @@ library:
     - AoC.Day1
     - AoC.Day2
     - AoC.Day3
+    - AoC.Day4
 
 executable:
   source-dirs: executable

src/AoC/Day4.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module AoC.Day4 where
+
+import Data.Text (Text)
+
+import Data.Attoparsec.Text
+import Data.Bits (xor)
+
+type Lower = Int
+type Higher = Int
+data Range1D = Range1D Lower Higher
+
+included :: Range1D -> Range1D -> Bool
+included (Range1D l1 r1) (Range1D l2 r2) = (l2 <= l1) && (r1 <= r2)
+
+eitherIncluded :: Range1D -> Range1D -> Bool
+eitherIncluded range1 range2 =
+  (range1 `included` range2) || (range2 `included` range1)
+
+parseInput :: Text -> Either String [(Range1D,Range1D)]
+parseInput = parseOnly (parseLine `sepBy` space)
+
+parseLine :: Parser (Range1D,Range1D)
+parseLine = do
+  l1 <- decimal
+  _ <- char '-'
+  r1 <- decimal
+  _ <- char ','
+  l2 <- decimal
+  _ <- char '-'
+  r2 <- decimal
+  pure (Range1D l1 r1,Range1D l2 r2)
+
+solveA :: Text -> Either String Int
+solveA txt = do
+  lines' <- parseInput txt
+  pure $ (length . filter (uncurry eitherIncluded)) lines'
+
+--------------------------------------------------------------------------------
+-- Part 2
+overlap :: Range1D -> Range1D -> Bool
+overlap (Range1D l1 r1) (Range1D l2 r2) = (r1 >= l2) && (l1 <= r2)
+
+eitherOverlap :: Range1D -> Range1D -> Bool
+eitherOverlap range1 range2 = range1 `overlap` range2
+
+solveB :: Text -> Either String Int
+solveB txt = do
+  lines' <- parseInput txt
+  pure $ (length . filter (uncurry eitherOverlap)) lines'