From e54e7d7a475ff00d724b7f1a6eac46aa5c5da561 Mon Sep 17 00:00:00 2001
From: Daniel Lin <ephemient@gmail.com>
Date: Sun, 1 Dec 2024 00:24:13 -0500
Subject: [PATCH] Day 1: Historian Hysteria

---
 README.md           |  1 +
 hs/aoc2024.cabal    |  9 +++++++--
 hs/app/Main.hs      |  4 +++-
 hs/bench/Main.hs    |  6 +++++-
 hs/src/Day1.hs      | 22 ++++++++++++++++++++++
 hs/test/Day1Spec.hs | 26 ++++++++++++++++++++++++++
 6 files changed, 64 insertions(+), 4 deletions(-)
 create mode 100644 hs/src/Day1.hs
 create mode 100644 hs/test/Day1Spec.hs

diff --git a/README.md b/README.md
index 341ad8f..43b295a 100644
--- a/README.md
+++ b/README.md
@@ -5,3 +5,4 @@ Development occurs in language-specific directories:
 
 |[Haskell](hs) ![Haskell CI](https://github.com/ephemient/aoc2024/workflows/Haskell%20CI/badge.svg)|
 |--:|
+|[Day1.hs](hs/src/Day1.hs)|
diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal
index cae35cb..7a2994c 100644
--- a/hs/aoc2024.cabal
+++ b/hs/aoc2024.cabal
@@ -19,12 +19,15 @@ source-repository head
     subdir:   hs
 
 library
+    hs-source-dirs:   src
+    exposed-modules:
+        Day1
     other-modules:
         Common
     build-depends:
         base ^>=4.20.0.0,
-        text ^>=2.1.1 
-    hs-source-dirs:   src
+        containers ^>=0.7,
+        text ^>=2.1.1
     ghc-options: -Wall
     default-language: GHC2024
 
@@ -45,6 +48,8 @@ test-suite aoc2024-test
     type:             exitcode-stdio-1.0
     hs-source-dirs:   test
     main-is:          Main.hs
+    other-modules:
+        Day1Spec
     build-depends:
         aoc2024,
         base ^>=4.20.0.0,
diff --git a/hs/app/Main.hs b/hs/app/Main.hs
index b80d677..ced0cc4 100644
--- a/hs/app/Main.hs
+++ b/hs/app/Main.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE NondecreasingIndentation #-}
 module Main (main) where
 
+import qualified Day1 (part1, part2)
+
 import Control.Monad (ap, when)
 import Data.Foldable (find)
 import Data.Function (on)
@@ -30,4 +32,4 @@ run' day name showIO funcs = do
 
 main :: IO ()
 main = do
-    pure ()
+    run 1 print [Day1.part1, Day1.part2]
diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs
index e87cdd7..998ddd3 100644
--- a/hs/bench/Main.hs
+++ b/hs/bench/Main.hs
@@ -6,6 +6,7 @@ import Data.Foldable (find)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text.IO as TIO (readFile)
+import qualified Day1 (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -22,5 +23,8 @@ getDayInput i = do
 
 main :: IO ()
 main = defaultMain
-  [
+  [ env (getDayInput 1) $ \input -> bgroup "Day 1"
+      [ bench "part 1" $ nf Day1.part1 input
+      , bench "part 2" $ nf Day1.part2 input
+      ]
   ]
diff --git a/hs/src/Day1.hs b/hs/src/Day1.hs
new file mode 100644
index 0000000..a28920f
--- /dev/null
+++ b/hs/src/Day1.hs
@@ -0,0 +1,22 @@
+{-|
+Module:         Day1
+Description:    <https://adventofcode.com/2024/day/1 Day 1: Historian Hysteria>
+-}
+module Day1 (part1, part2) where
+
+import Data.Function (on)
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap (fromListWith, findWithDefault)
+import Data.List (sort, transpose)
+import Data.Text (Text)
+import qualified Data.Text as T (lines, words, unpack)
+
+part1 :: Text -> Int
+part1 input = sum $ abs <$> cs where
+    [as, bs] = transpose $ map (map (read . T.unpack) . T.words) $ T.lines input
+    cs = (zipWith (-) `on` sort) as bs
+
+part2 :: Text -> Int
+part2 input = sum [a * IntMap.findWithDefault 0 a cs | a <- as] where
+    [as, bs] = transpose $ map (map (read . T.unpack) . T.words) $ T.lines input
+    cs = IntMap.fromListWith (+) [(b, 1) | b <- bs]
diff --git a/hs/test/Day1Spec.hs b/hs/test/Day1Spec.hs
new file mode 100644
index 0000000..227cc0f
--- /dev/null
+++ b/hs/test/Day1Spec.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day1Spec (spec) where
+
+import Data.Text (Text)
+import qualified Data.Text as T (unlines)
+import Day1 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example = T.unlines
+  [ "3   4"
+  , "4   3"
+  , "2   5"
+  , "1   3"
+  , "3   9"
+  , "3   3"
+  ]
+
+spec :: Spec
+spec = do
+    describe "part 1" $ do
+        it "examples" $ do
+            part1 example `shouldBe` 11
+    describe "part 2" $ do
+        it "examples" $ do
+            part2 example `shouldBe` 31