let's gooo

.github/workflows/ci.yml

@@ -0,0 +1,46 @@
+name: CI
+
+# Trigger the workflow on push or pull request, but only for the main branch
+on:
+  pull_request:
+  push:
+    branches: ["main"]
+
+jobs:
+  generateMatrix:
+    runs-on: ubuntu-latest
+    outputs:
+      matrix: ${{ steps.set-matrix-ghc.output.ghcs }}
+    steps:
+      - id: set-matrix-ghc
+        run: echo "ghcs={\"include\":[\"9.2.4\"]}"
+  tests:
+    name: ${{ matrix.ghc }} on ${{ matrix.os }}
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [ubuntu-latest, macos-latest, windows-latest]
+        ghc: ${{ fromJSON(needs.generateMatrix.outputs.matrix) }}
+    steps:
+      - name: Checkout base repo
+        uses: actions/checkout@v2
+      - name: Set up Haskell
+        id: setup-haskell
+        uses: haskell/actions/setup@v1
+        with:
+          ghc-version: ${{ matrix.ghc }}
+          cabal-version: 'latest'
+      - name: Configure
+        run: cabal new-configure --enable-tests
+      - name: Freeze
+        run: cabal freeze
+      - name: Cache
+        uses: actions/cache@v2.1.3
+        with:
+          path: ${{ steps.setup-haskell.outputs.cabal-store }}
+          key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
+          restore-keys: ${{ runner.os }}-${{ matrix.ghc }}-
+      - name: Build
+        run: cabal new-build
+      - name: Test
+        run: cabal new-test all

.github/workflows/linting.yml

@@ -0,0 +1,34 @@
+name: Linting
+
+on:
+  pull_request:
+  push:
+    branches: ["main"]
+
+jobs:
+  fourmolu:
+    runs-on: ubuntu-latest
+    steps:
+    - uses: actions/checkout@v2
+
+    - uses: fourmolu/fourmolu-action@v5
+      with:
+        pattern: |
+          src/**/*.hs
+          test/**/*.hs
+
+  hlint:
+    runs-on: ubuntu-latest
+    steps:
+    - uses: actions/checkout@v2
+
+    - name: 'Set up HLint'
+      uses: rwe/actions-hlint-setup@v1
+      with:
+        version: '3.5'
+
+    - name: 'Run HLint'
+      uses: rwe/actions-hlint-run@v1
+      with:
+        path: '["src/", "test/"]'
+        fail-on: warning

.gitignore

@@ -0,0 +1,10 @@
+.hie/
+.hspec-failures
+<
+Session.vim
+cabal.project.local*
+dist*
+hlint.log
+stdout.log
+tags
+tags.mtime

.hlint.yaml

@@ -0,0 +1,3 @@
+- ignore: {name: "Eta reduce"}
+- ignore: {name: "Avoid lambda"}
+- ignore: {name: "Use newtype instead of data"}

CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for get-tested-ghc
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2022, Hécate Moonlight
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Hécate Moonlight nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Makefile

@@ -0,0 +1,27 @@
+build: ## Build the project
+	@cabal build
+
+clean: ## Remove compilation artifacts
+	@cabal clean
+
+repl: ## Start a REPL
+	@cabal repl
+
+test: ## Run the test suite
+	@cabal test
+
+lint: ## Run the code linter (HLint)
+	@find app -name "*.hs" | parallel -j $(PROCS) -- hlint --refactor-options="-i" --refactor {}
+
+style: ## Run the code styler (stylish-haskell)
+	@fourmolu -q --mode inplace app
+	@cabal-fmt -i *.cabal
+
+help: ## Display this help message
+	@grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | awk 'BEGIN {FS = ":.* ?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}'
+
+PROCS := $(shell nproc)
+
+.PHONY: all $(MAKECMDGOALS)
+
+.DEFAULT_GOAL := help

app/Extract.hs

@@ -0,0 +1,72 @@
+module Extract where
+
+import Control.Monad
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as BS
+import Data.Function ((&))
+import Data.Text (Text)
+import Data.Text.Display (display)
+import Data.Text.Encoding qualified as Text
+import Data.Vector (Vector)
+import Data.Vector qualified as Vector
+import Distribution.Compiler (CompilerFlavor (..))
+import Distribution.Fields
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Parsec
+import Distribution.Types.Version (Version)
+import Distribution.Types.VersionRange (VersionRange, withinRange)
+import Effectful
+import Effectful.Error.Static (Error, throwError)
+import System.Directory qualified as System
+import System.IO (stdout)
+import Types
+
+-- | Loads and parses a Cabal file
+loadFile
+  :: (Error ProcessingError :> es, IOE :> es)
+  => FilePath
+  -- ^ The absolute path to the Cabal file
+  -> Eff es GenericPackageDescription
+loadFile path = do
+  exists <- liftIO $ System.doesFileExist path
+  unless exists $
+    throwError $
+      CabalFileNotFound path
+  content <- liftIO $ BS.readFile path
+  parseString path content
+
+parseString
+  :: (Error ProcessingError :> es, IOE :> es)
+  => String
+  -- ^ File name
+  -> BS.ByteString
+  -> Eff es GenericPackageDescription
+parseString name bs = do
+  let (_warnings, result) = runParseResult (parseGenericPackageDescription bs)
+  case result of
+    Right x -> pure x
+    Left err -> do
+      logAttention (display $ show err)
+      throwError $ CabalFileCouldNotBeParsed name
+
+extractTestedWith :: GenericPackageDescription -> Vector VersionRange
+extractTestedWith genericPackageDescription =
+  Vector.fromList genericPackageDescription.packageDescription.testedWith
+    & Vector.filter (\(flavour, _) -> flavour == GHC)
+    & Vector.filter (\(_, versionRange) -> any (`withinRange` versionRange) versionList)
+    & Vector.map snd
+
+getVersions :: Vector VersionRange -> Vector Version
+getVersions supportedCompilers =
+  foldMap
+    (\version -> Vector.foldMap (\versionRange -> checkVersion version versionRange) supportedCompilers)
+    versionList
+
+checkVersion :: Version -> VersionRange -> Vector Version
+checkVersion version versionRange =
+  if version `withinRange` versionRange
+    then Vector.singleton version
+    else Vector.empty
+
+logAttention :: (IOE :> es) => Text -> Eff es ()
+logAttention message = liftIO $ BS.hPutStrLn stdout $ Text.encodeUtf8 message

app/Main.hs

@@ -0,0 +1,36 @@
+module Main where
+
+import Effectful
+import Effectful.Error.Static
+import Extract
+import Options.Applicative
+import Types
+import qualified Data.Aeson as Aeson
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as ByteString
+
+newtype Options = Options {path :: FilePath}
+  deriving stock (Show, Eq)
+
+main :: IO ()
+main = do
+  result <- execParser (parseOptions `withInfo` "Extract the tested-with stanza from your cabal file")
+  processingResult <- runEff . runErrorNoCallStack $ runOptions result
+  case processingResult of
+    Right json -> ByteString.putStrLn json
+    Left _ -> error "mleh!"
+
+parseOptions :: Parser Options
+parseOptions =
+  Options
+    <$> argument str (metavar "FILE")
+
+runOptions :: Options -> Eff [Error ProcessingError, IOE] ByteString
+runOptions options = do
+  genericPackageDescription <- loadFile options.path
+  let supportedCompilers = extractTestedWith genericPackageDescription
+      result = getVersions supportedCompilers
+  pure $ Aeson.encode $ ActionMatrix result
+
+withInfo :: Parser a -> String -> ParserInfo a
+withInfo opts desc = info (helper <*> opts) $ progDesc desc

app/Types.hs

@@ -0,0 +1,87 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Types where
+
+import Data.Aeson
+import Data.Set (Set)
+import Data.Set qualified as Set
+import Data.Text qualified as Text
+import Data.Text.Display
+import Data.Text.Lazy.Builder qualified as Builder
+import Distribution.Compiler
+import Distribution.Parsec (simpleParsec)
+import Distribution.Pretty qualified as Pretty
+import Distribution.Types.Version
+import Distribution.Types.VersionRange
+import Distribution.Version qualified as Version
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+
+data ProcessingError
+  = CabalFileNotFound FilePath
+  | CabalFileCouldNotBeParsed FilePath
+  deriving stock (Eq, Ord, Show)
+  deriving
+    (Display)
+    via ShowInstance ProcessingError
+
+instance ToJSON CompilerFlavor where
+  toJSON = toJSON . Pretty.prettyShow
+
+instance FromJSON CompilerFlavor where
+  parseJSON = withText "Compiler Flavor" $ \s ->
+    maybe (fail "Invalid compiler flavor") pure (simpleParsec $ Text.unpack s)
+
+instance Display CompilerFlavor where
+  displayBuilder = Builder.fromString . Pretty.prettyShow
+
+instance Display VersionRange where
+  displayBuilder = Builder.fromString . Pretty.prettyShow
+
+instance ToJSON Version where
+  toJSON = toJSON . Pretty.prettyShow
+
+instance FromJSON VersionRange where
+  parseJSON = withText "Version Range" $ \s ->
+    maybe (fail "Invalid version range") pure (simpleParsec $ Text.unpack s)
+
+data ActionMatrix = ActionMatrix
+  { include :: Vector Version
+  }
+  deriving stock (Eq, Ord, Generic)
+  deriving anyclass (ToJSON)
+
+versionList :: Set Version
+versionList =
+  Set.fromList
+    [ Version.mkVersion [9, 4, 1]
+    , Version.mkVersion [9, 2, 4]
+    , Version.mkVersion [9, 2, 3]
+    , Version.mkVersion [9, 2, 2]
+    , Version.mkVersion [9, 2, 1]
+    , Version.mkVersion [9, 0, 2]
+    , Version.mkVersion [9, 0, 1]
+    , Version.mkVersion [8, 10, 7]
+    , Version.mkVersion [8, 10, 6]
+    , Version.mkVersion [8, 10, 5]
+    , Version.mkVersion [8, 10, 4]
+    , Version.mkVersion [8, 10, 3]
+    , Version.mkVersion [8, 10, 2]
+    , Version.mkVersion [8, 10, 1]
+    , Version.mkVersion [8, 8, 4]
+    , Version.mkVersion [8, 8, 3]
+    , Version.mkVersion [8, 8, 2]
+    , Version.mkVersion [8, 8, 1]
+    , Version.mkVersion [8, 6, 5]
+    , Version.mkVersion [8, 6, 4]
+    , Version.mkVersion [8, 6, 3]
+    , Version.mkVersion [8, 6, 2]
+    , Version.mkVersion [8, 6, 1]
+    , Version.mkVersion [8, 4, 4]
+    , Version.mkVersion [8, 4, 3]
+    , Version.mkVersion [8, 4, 2]
+    , Version.mkVersion [8, 4, 1]
+    , Version.mkVersion [8, 2, 2]
+    , Version.mkVersion [8, 0, 2]
+    , Version.mkVersion [7, 10, 3]
+    ]

cabal.project

@@ -0,0 +1,14 @@
+packages: ./
+
+with-compiler: ghc-9.2
+
+jobs: 8
+
+tests: True
+
+allow-newer: all
+
+test-show-details: direct
+
+package *
+  ghc-options: +RTS -A32m -RTS -j

fourmolu.yaml

@@ -0,0 +1,10 @@
+indentation: 2
+comma-style: leading # for lists, tuples etc. - can also be 'leading'
+import-export-style: leading
+record-brace-space: false # rec {x = 1} vs. rec{x = 1}
+indent-wheres: true # 'false' means save space by only half-indenting the 'where' keyword
+respectful: true # don't be too opinionated about newlines etc.
+haddock-style: single-line # '--' vs. '{-'
+newlines-between-decls: 1 # number of newlines between top-level declarations
+fixities: []
+function-arrows: leading

get-tested-ghc.cabal

@@ -0,0 +1,70 @@
+cabal-version:   3.4
+name:            get-tested-ghc
+version:         0.1.0.0
+synopsis:        Get the tested-with stanza of your Cabal file
+
+-- description:
+homepage:        https://github.com/Kleidukos/get-tested-ghc
+license:         BSD-3-Clause
+license-file:    LICENSE
+author:          Hécate Moonlight
+maintainer:      hecate+github@glitchbra.in
+tested-with:     GHC >=9.2 && <9.3
+
+-- copyright:
+category:        Development
+build-type:      Simple
+extra-doc-files: CHANGELOG.md
+
+-- extra-source-files:
+
+executable get-tested-ghc
+  main-is:            Main.hs
+  ghc-options:
+    -Wall -Wcompat -Widentities -Wincomplete-record-updates
+    -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
+    -fhide-source-paths -Wno-unused-do-bind -fshow-hole-constraints
+    -fprint-potential-instances -Wno-unticked-promoted-constructors
+    -Werror=unused-imports -flate-specialise -funbox-strict-fields
+    -finline-generics-aggressively -fexpose-all-unfoldings -threaded
+    "-with-rtsopts=-N -T"
+
+  default-extensions:
+    NoStarIsType
+    DataKinds
+    DeriveAnyClass
+    DerivingStrategies
+    DerivingVia
+    DuplicateRecordFields
+    LambdaCase
+    OverloadedLabels
+    OverloadedRecordDot
+    OverloadedStrings
+    PackageImports
+    PolyKinds
+    QuasiQuotes
+    RecordWildCards
+    StrictData
+    TypeFamilies
+    ViewPatterns
+
+  other-modules:
+    Extract
+    Types
+
+  build-depends:
+    , aeson                 ^>=2.1
+    , base                  ^>=4.16
+    , bytestring            ^>=0.11
+    , Cabal-syntax          ^>=3.8
+    , containers            ^>=0.6
+    , directory             ^>=1.3
+    , effectful-core        ^>=2.2
+    , filepath              ^>=1.4
+    , optparse-applicative  ^>=0.17
+    , text                  ^>=2.0
+    , text-display          ^>=0.0
+    , vector                ^>=0.13
+
+  hs-source-dirs:     app
+  default-language:   GHC2021