From 3146355a35c6e15f759ba2ad1b4473ac41abf57d Mon Sep 17 00:00:00 2001 From: Daniel Lin Date: Sun, 1 Dec 2024 23:37:10 -0500 Subject: [PATCH] Automate formatting --- .github/workflows/hs.yml | 20 ++++++ hs/README.md | 14 ++++ hs/aoc2024.cabal | 144 ++++++++++++++++++++++----------------- hs/app/Main.hs | 17 +++-- hs/bench/Main.hs | 23 ++++--- hs/src/Common.hs | 17 ++--- hs/src/Day1.hs | 29 ++++---- hs/test/Day1Spec.hs | 32 +++++---- 8 files changed, 177 insertions(+), 119 deletions(-) diff --git a/.github/workflows/hs.yml b/.github/workflows/hs.yml index 4de42c63..eda32662 100644 --- a/.github/workflows/hs.yml +++ b/.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 diff --git a/hs/README.md b/hs/README.md index 49a1478c..4854cf92 100644 --- a/hs/README.md +++ b/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 +``` diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal index 6b3728cb..c40790c1 100644 --- a/hs/aoc2024.cabal +++ b/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 -homepage: https://github.com/ephemient/aoc2024/tree/main/hs -license: BSD-3-Clause -license-file: LICENSE -author: Daniel Lin -maintainer: ephemient@gmail.com -category: None -build-type: Simple + Please see the README on GitHub at + +homepage: https://github.com/ephemient/aoc2024/tree/main/hs +license: BSD-3-Clause +license-file: LICENSE +author: Daniel Lin +maintainer: ephemient@gmail.com +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 diff --git a/hs/app/Main.hs b/hs/app/Main.hs index d88274ad..f5fa2f6c 100644 --- a/hs/app/Main.hs +++ b/hs/app/Main.hs @@ -1,29 +1,28 @@ {-# 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 @@ -31,4 +30,4 @@ run' day name showIO funcs = do main :: IO () main = do - run 1 (either fail print) [Day1.part1, Day1.part2] + run 1 (either fail print) [Day1.part1, Day1.part2] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index 998ddd3b..49ef4571 100644 --- a/hs/bench/Main.hs +++ b/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 + ] + ] diff --git a/hs/src/Common.hs b/hs/src/Common.hs index a188b81e..db1d6500 100644 --- a/hs/src/Common.hs +++ b/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' diff --git a/hs/src/Day1.hs b/hs/src/Day1.hs index cbecf240..fa63aae7 100644 --- a/hs/src/Day1.hs +++ b/hs/src/Day1.hs @@ -1,30 +1,29 @@ -{-| -Module: Day1 -Description: --} +-- | +-- Module: Day1 +-- Description: 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 diff --git a/hs/test/Day1Spec.hs b/hs/test/Day1Spec.hs index c826b725..28c27f2f 100644 --- a/hs/test/Day1Spec.hs +++ b/hs/test/Day1Spec.hs @@ -1,26 +1,28 @@ {-# LANGUAGE OverloadedStrings #-} + module Day1Spec (spec) where import Data.Text (Text) -import qualified Data.Text as T (unlines) +import Data.Text qualified 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" - ] +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` Right 11 - describe "part 2" $ do - it "examples" $ do - part2 example `shouldBe` Right 31 + describe "part 1" $ do + it "examples" $ do + part1 example `shouldBe` Right 11 + describe "part 2" $ do + it "examples" $ do + part2 example `shouldBe` Right 31