Merge pull request #2 from ephemient/hs/day1

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)|

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,

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]

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
+      ]
   ]

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]

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