Merge pull request #9 from ephemient/hs/day1

.github/workflows/hs.yml

@@ -59,6 +59,26 @@ jobs:
           name: aoc2024-hs
           path: ${{ steps.build.outputs.exe }}
 
+  lint:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v4
+      - uses: haskell-actions/hlint-setup@v2
+      - uses: haskell-actions/hlint-run@v2
+        with:
+          fail-on: warning
+          path: hs
+      - uses: haskell-actions/run-ormolu@v16
+        with:
+          pattern: |
+            hs/**/*.hs
+            hs/**/*.hs-boot
+      - uses: tfausak/cabal-gild-setup-action@v2
+        with:
+          token: ${{ secrets.GITHUB_TOKEN }}
+      - run: cabal-gild --input hs/aoc2024.cabal --mode check
+
   run:
     needs: [ get-inputs, build ]
     runs-on: ubuntu-latest

hs/README.md

@@ -42,3 +42,17 @@ Run [hlint](https://github.com/ndmitchell/hlint) source code suggestions:
 cabal install hlint
 hlint src test bench
 ```
+
+Run [ormolu](https://github.com/tweag/ormolu) formatting:
+
+```sh
+cabal install ormolu
+git ls-files -coz '*.hs' | xargs -0 ormolu --mode inplace
+```
+
+Run [cabal-gild](https://github.com/tfausak/cabal-gild) formatting:
+
+```sh
+cabal install cabal-gild
+cabal-gild -i aoc2024.cabal -o aoc2024.cabal
+```

hs/aoc2024.cabal

@@ -1,74 +1,94 @@
-cabal-version:      3.0
-
-name:               aoc2024
-version:            0.1.0.0
+cabal-version: 3.0
+name: aoc2024
+version: 0.1.0.0
 synopsis:
-    Please see the README on GitHub at <https://github.com/ephemient/aoc2024/blob/main/hs/README.md>
-homepage:           https://github.com/ephemient/aoc2024/tree/main/hs
-license:            BSD-3-Clause
-license-file:       LICENSE
-author:             Daniel Lin
-maintainer:         [email protected]
-category:           None
-build-type:         Simple
+  Please see the README on GitHub at <https://github.com/ephemient/aoc2024/blob/main/hs/README.md>
+
+homepage: https://github.com/ephemient/aoc2024/tree/main/hs
+license: BSD-3-Clause
+license-file: LICENSE
+author: Daniel Lin
+maintainer: [email protected]
+category: None
+build-type: Simple
 extra-source-files: README.md
 
 source-repository head
-    type:     git
-    location: https://github.com/ephemient/aoc2024.git
-    subdir:   hs
+  type: git
+  location: https://github.com/ephemient/aoc2024.git
+  subdir: hs
 
 library
-    hs-source-dirs:   src
-    exposed-modules:
-        Day1
-    other-modules:
-        Common
-    build-depends:
-        base ^>=4.20.0.0,
-        containers ^>=0.7,
-        text ^>=2.1.1
-    ghc-options: -Wall
-    default-language: GHC2024
+  hs-source-dirs: src
+  exposed-modules:
+    Day1
+
+  other-modules:
+    Common
+
+  build-depends:
+    base ^>=4.20.0.0,
+    containers ^>=0.7,
+    text ^>=2.1.1,
+
+  ghc-options: -Wall
+  default-language: GHC2024
 
 executable aoc2024
-    hs-source-dirs:   app
-    main-is:          Main.hs
-    c-sources:        app/cbits/main.c
-    build-depends:
-        aoc2024,
-        base ^>=4.20.0.0,
-        filepath ^>=1.5.2.0,
-        text ^>=2.1.1
-    ghc-options:      -no-hs-main -threaded -Wall
-    default-language: GHC2024
+  hs-source-dirs: app
+  main-is: Main.hs
+  c-sources: app/cbits/main.c
+  build-depends:
+    aoc2024,
+    base ^>=4.20.0.0,
+    filepath ^>=1.5.2.0,
+    text ^>=2.1.1,
+
+  ghc-options:
+    -no-hs-main
+    -threaded
+    -Wall
+
+  default-language: GHC2024
 
 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,
-        hspec ^>=2.11.10,
-        text ^>=2.1.1
-    build-tool-depends:
-        hspec-discover:hspec-discover ^>=2.11.10
-    ghc-options:      -threaded -rtsopts "-with-rtsopts=-N" -Wall
-    default-language: GHC2024
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: Main.hs
+  other-modules:
+    Day1Spec
+
+  build-depends:
+    aoc2024,
+    base ^>=4.20.0.0,
+    hspec ^>=2.11.10,
+    text ^>=2.1.1,
+
+  build-tool-depends:
+    hspec-discover:hspec-discover ^>=2.11.10
+
+  ghc-options:
+    -threaded
+    -rtsopts
+    -with-rtsopts=-N
+    -Wall
+
+  default-language: GHC2024
 
 benchmark aoc2024-bench
-    type:             exitcode-stdio-1.0
-    hs-source-dirs:   bench
-    main-is:          Main.hs
-    c-sources:        bench/cbits/main.c
-    build-depends:
-        aoc2024,
-        base ^>=4.20.0.0,
-        criterion ^>=1.6.4.0,
-        filepath ^>=1.5.2.0,
-        text ^>=2.1.1
-    ghc-options:      -no-hs-main -threaded
-    default-language: GHC2024
+  type: exitcode-stdio-1.0
+  hs-source-dirs: bench
+  main-is: Main.hs
+  c-sources: bench/cbits/main.c
+  build-depends:
+    aoc2024,
+    base ^>=4.20.0.0,
+    criterion ^>=1.6.4.0,
+    filepath ^>=1.5.2.0,
+    text ^>=2.1.1,
+
+  ghc-options:
+    -no-hs-main
+    -threaded
+
+  default-language: GHC2024

hs/app/Main.hs

@@ -1,34 +1,33 @@
 {-# LANGUAGE NondecreasingIndentation #-}
-module Main (main) where
 
-import qualified Day1 (part1, part2)
+module Main (main) where
 
 import Control.Monad (ap, when)
 import Data.Foldable (find)
-import Data.Function (on)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
-import qualified Data.Text.IO as TIO (putStrLn, readFile)
+import Data.Text.IO qualified as TIO (readFile)
+import Day1 qualified (part1, part2)
 import System.Environment (getArgs, lookupEnv)
 import System.FilePath (combine)
 
 getDayInput :: Int -> IO Text
 getDayInput i = do
-    dataDir <- fromMaybe "." . find (not . null) <$> lookupEnv "AOC2024_DATADIR"
-    TIO.readFile . combine dataDir $ "day" ++ show i ++ ".txt"
+  dataDir <- fromMaybe "." . find (not . null) <$> lookupEnv "AOC2024_DATADIR"
+  TIO.readFile . combine dataDir $ "day" ++ show i ++ ".txt"
 
 run :: Int -> (a -> IO ()) -> [Text -> a] -> IO ()
 run = run' `ap` show
 
 run' :: Int -> String -> (a -> IO ()) -> [Text -> a] -> IO ()
 run' day name showIO funcs = do
-    args <- getArgs
-    when (null args || name `elem` args) $ do
+  args <- getArgs
+  when (null args || name `elem` args) $ do
     putStrLn $ "Day " ++ name
     contents <- getDayInput day
     mapM_ (showIO . ($ contents)) funcs
     putStrLn ""
 
 main :: IO ()
 main = do
-    run 1 (either fail print) [Day1.part1, Day1.part2]
+  run 1 (either fail print) [Day1.part1, Day1.part2]

hs/bench/Main.hs

@@ -5,8 +5,8 @@ import Criterion.Main (bench, bgroup, defaultMain, env, envWithCleanup, nf)
 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 Data.Text.IO qualified as TIO (readFile)
+import Day1 qualified (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -18,13 +18,16 @@ unsetTrace = maybe (unsetEnv "TRACE") (setEnv "TRACE" `flip` True)
 
 getDayInput :: Int -> IO Text
 getDayInput i = do
-    dataDir <- fromMaybe "." . find (not . null) <$> getEnv "AOC2024_DATADIR"
-    TIO.readFile . combine dataDir $ "day" ++ show i ++ ".txt"
+  dataDir <- fromMaybe "." . find (not . null) <$> getEnv "AOC2024_DATADIR"
+  TIO.readFile . combine dataDir $ "day" ++ show i ++ ".txt"
 
 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
-      ]
-  ]
+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/Common.hs

@@ -2,23 +2,24 @@ module Common (readEntire, readMany, readSome) where
 
 import Control.Arrow (first)
 import Data.Char (isSpace)
-import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Text (Text)
-import qualified Data.Text as T (dropWhile, null)
+import Data.Text qualified as T (dropWhile, null)
 import Data.Text.Read (Reader)
 
 readEntire :: Reader a -> Text -> Either String a
 readEntire reader input = do
-    (a, t) <- reader input
-    if T.null t then Right a else Left "incomplete read"
+  (a, t) <- reader input
+  if T.null t then Right a else Left "incomplete read"
 
 readMany :: Reader a -> Reader [a]
-readMany reader = pure . readMany' id where
+readMany reader = pure . readMany' id
+  where
     readMany' k input =
-        either (const (k [], input)) (uncurry $ readMany' . (.) k . (:)) .  reader $
+      either (const (k [], input)) (uncurry $ readMany' . (.) k . (:)) . reader $
         T.dropWhile isSpace input
 
 readSome :: Reader a -> Reader (NonEmpty a)
 readSome reader input = do
-    (a, input') <- reader input
-    first (a :|) <$> readMany reader input'
+  (a, input') <- reader input
+  first (a :|) <$> readMany reader input'

hs/src/Day1.hs

@@ -1,30 +1,29 @@
-{-|
-Module:         Day1
-Description:    <https://adventofcode.com/2024/day/1 Day 1: Historian Hysteria>
--}
+-- |
+-- Module:         Day1
+-- Description:    <https://adventofcode.com/2024/day/1 Day 1: Historian Hysteria>
 module Day1 (part1, part2) where
 
 import Common (readEntire)
+import Data.Either (fromLeft)
 import Data.Function (on)
-import qualified Data.IntMap as IntMap (fromListWith, findWithDefault)
+import Data.IntMap qualified as IntMap (findWithDefault)
+import Data.IntMap.Strict qualified as IntMap (fromListWith)
 import Data.List (sort, transpose)
 import Data.Text (Text)
-import qualified Data.Text as T (lines, words)
-import qualified Data.Text.Read as T (decimal)
+import Data.Text qualified as T (lines, words)
+import Data.Text.Read qualified as T (decimal)
 
 parse :: Text -> Either String [[Int]]
 parse = fmap transpose . mapM (mapM (readEntire T.decimal) . T.words) . T.lines
 
 part1 :: Text -> Either String Int
 part1 input = case parse input of
-    Left err -> Left err
-    Right [as, bs] -> pure $ sum $ abs <$> (zipWith (-) `on` sort) as bs
-    _ -> Left "no parse"
+  Right [as, bs] -> pure $ sum $ abs <$> (zipWith (-) `on` sort) as bs
+  other -> Left $ fromLeft "no parse" other
 
 part2 :: Text -> Either String Int
 part2 input = case parse input of
-    Left err -> Left err
-    Right [as, bs] ->
-        let cs = IntMap.fromListWith (($!) . (+)) [(b, 1) | b <- bs]
-        in pure $ sum [a * IntMap.findWithDefault 0 a cs | a <- as]
-    _ -> Left "no parse"
+  Right [as, bs] ->
+    let cs = IntMap.fromListWith (+) [(b, 1) | b <- bs]
+     in pure $ sum [a * IntMap.findWithDefault 0 a cs | a <- as]
+  other -> Left $ fromLeft "no parse" other