Merge pull request #10 from ephemient/hs/day2

README.md

@@ -6,3 +6,4 @@ Development occurs in language-specific directories:
 |[Haskell](hs) ![Haskell CI](https://github.com/ephemient/aoc2024/workflows/Haskell%20CI/badge.svg)|[Kotlin](kt) ![Kotlin CI](https://github.com/ephemient/aoc2024/workflows/Kotlin%20CI/badge.svg)|[Python](py) ![Python CI](https://github.com/ephemient/aoc2024/workflows/Python%20CI/badge.svg)|[Rust](rs) ![Rust CI](https://github.com/ephemient/aoc2024/workflows/Rust%20CI/badge.svg)|
 |--:|--:|--:|--:|
 |[Day1.hs](hs/src/Day1.hs)|[Day1.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day1.kt)|[day1.py](py/aoc2024/day1.py)|[day1.rs](rs/src/day1.rs)|
+|[Day2.hs](hs/src/Day2.hs)||||

hs/aoc2024.cabal

@@ -22,6 +22,7 @@ library
   hs-source-dirs: src
   exposed-modules:
     Day1
+    Day2
 
   other-modules:
     Common
@@ -57,6 +58,7 @@ test-suite aoc2024-test
   main-is: Main.hs
   other-modules:
     Day1Spec
+    Day2Spec
 
   build-depends:
     aoc2024,

hs/app/Main.hs

@@ -8,6 +8,7 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
+import Day2 qualified (part1, part2)
 import System.Environment (getArgs, lookupEnv)
 import System.FilePath (combine)
 
@@ -31,3 +32,4 @@ run' day name showIO funcs = do
 main :: IO ()
 main = do
   run 1 (either fail print) [Day1.part1, Day1.part2]
+  run 2 (either fail print) [Day2.part1, Day2.part2]

hs/bench/Main.hs

@@ -7,6 +7,7 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
+import Day2 qualified (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -29,5 +30,11 @@ main =
           "Day 1"
           [ bench "part 1" $ nf Day1.part1 input,
             bench "part 2" $ nf Day1.part2 input
+          ],
+      env (getDayInput 2) $ \input ->
+        bgroup
+          "Day 2"
+          [ bench "part 1" $ nf Day2.part1 input,
+            bench "part 2" $ nf Day2.part2 input
           ]
     ]

hs/src/Day2.hs

@@ -0,0 +1,26 @@
+-- |
+-- Module:         Day2
+-- Description:    <https://adventofcode.com/2024/day/2 Day 2: Red-Nosed Reports>
+module Day2 (part1, part2) where
+
+import Common (readEntire)
+import Data.Ix (inRange)
+import Data.List (inits, tails)
+import Data.Text (Text)
+import Data.Text qualified as T (lines, words)
+import Data.Text.Read qualified as T (decimal)
+
+parse :: Text -> Either String [[Int]]
+parse = mapM (mapM (readEntire T.decimal) . T.words) . T.lines
+
+isSafe, isSafe' :: [Int] -> Bool
+isSafe report = all (inRange (-3, -1)) delta || all (inRange (1, 3)) delta
+  where
+    delta = zipWith (-) report $ drop 1 report
+isSafe' report = any isSafe [a ++ b | (a, _ : b) <- zip (inits report) (tails report)]
+
+part1 :: Text -> Either String Int
+part1 input = length . filter isSafe <$> parse input
+
+part2 :: Text -> Either String Int
+part2 input = length . filter isSafe' <$> parse input

hs/test/Day2Spec.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day2Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day2 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example =
+  T.unlines
+    [ "7 6 4 2 1",
+      "1 2 7 8 9",
+      "9 7 6 2 1",
+      "1 3 2 4 5",
+      "8 6 4 4 1",
+      "1 3 6 7 9"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example `shouldBe` Right 2
+  describe "part 2" $ do
+    it "examples" $ do
+      part2 example `shouldBe` Right 4