From cd526d0b9ffa78336350204e424e8d59b136657f Mon Sep 17 00:00:00 2001 From: Tommy Bidne Date: Fri, 23 Oct 2026 15:48:18 +1300 Subject: [PATCH] Implement --snapshot-url Adds --snapshot-url for an easier alternative to --snapshot-path, when all we want to do is pick a different snapshot. We also add another ci job that builds stackage with some fixed "stable" snapshot once a week. As the nightly snapshot runs into problems a few times a month, this gives users a fallback "last known good" snapshot use. --- .github/scripts/batch_index.sh | 8 ++- .github/scripts/dry_run.sh | 7 +- .github/workflows/build.yaml | 60 ++++++++++++++++++ .github/workflows/nightly.yaml | 22 +++++++ .github/workflows/{ci.yaml => runner.yaml} | 74 +++------------------- .github/workflows/stable.yaml | 22 +++++++ README.md | 52 +++++++++++++-- dev.md | 17 +++-- src/CLC/Stackage/Parser.hs | 18 +++--- src/CLC/Stackage/Parser/API.hs | 37 ++++++++--- src/CLC/Stackage/Parser/API/CabalConfig.hs | 16 ++--- src/CLC/Stackage/Parser/API/Common.hs | 18 ++++-- src/CLC/Stackage/Parser/API/JSON.hs | 13 ++-- src/CLC/Stackage/Runner/Args.hs | 33 ++++++++-- src/CLC/Stackage/Runner/Env.hs | 4 +- src/CLC/Stackage/Utils/Logging.hs | 8 +++ test/unit/Unit/CLC/Stackage/Parser/API.hs | 4 +- 17 files changed, 289 insertions(+), 124 deletions(-) create mode 100644 .github/workflows/build.yaml create mode 100644 .github/workflows/nightly.yaml rename .github/workflows/{ci.yaml => runner.yaml} (65%) create mode 100644 .github/workflows/stable.yaml diff --git a/.github/scripts/batch_index.sh b/.github/scripts/batch_index.sh index 7dd823c..1f27666 100755 --- a/.github/scripts/batch_index.sh +++ b/.github/scripts/batch_index.sh @@ -5,6 +5,11 @@ set -e # total time reasonable. batch_index=$1 +url="" +if [[ -n "$2" ]]; then + url="--snapshot-url=$2" +fi + source .github/scripts/install.sh if [[ -d output ]]; then @@ -19,7 +24,8 @@ clc-stackage \ --batch 200 \ --batch-index $batch_index \ --cabal-options="--semaphore" \ - --cleanup off + --cleanup off \ + $url ec=$? diff --git a/.github/scripts/dry_run.sh b/.github/scripts/dry_run.sh index baf5667..d1ac2df 100755 --- a/.github/scripts/dry_run.sh +++ b/.github/scripts/dry_run.sh @@ -1,3 +1,8 @@ +url="" +if [[ -n "$1" ]]; then + url="--snapshot-url=$1" +fi + source .github/scripts/install.sh if [[ -d output ]]; then @@ -7,7 +12,7 @@ fi echo "*** Building all with --dry-run ***" set +e -clc-stackage --batch 200 --cabal-options="--dry-run" +clc-stackage --batch 200 --cabal-options="--dry-run" $url ec=$? diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml new file mode 100644 index 0000000..9370118 --- /dev/null +++ b/.github/workflows/build.yaml @@ -0,0 +1,60 @@ +name: build +on: + push: + branches: + - master + + pull_request: + branches: + - master + + schedule: + # Once a week. + # + # https://crontab.guru + - cron: '0 0 * * 0' + + workflow_dispatch: + +jobs: + cabal: + strategy: + fail-fast: false + matrix: + os: + - "macos-latest" + - "ubuntu-latest" + - "windows-latest" + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v6 + - uses: haskell-actions/setup@v2 + with: + # Should be the current stackage nightly, though this will likely go + # out-of-date eventually, until a problem is reported. + ghc-version: "9.12" + - name: Configure + run: | + cabal configure --enable-tests --ghc-options -Werror + + - name: Build executable + run: cabal build exe:clc-stackage + + - name: Unit Tests + id: unit + run: cabal test unit + + - name: Functional Tests + id: functional + # We want to run these tests even if the unit tests fail, because + # it is useful to know if e.g. the unit tests fail due to one + # stackage endpoint failing, but the functional tests pass due to + # a backup working. + if: always() + shell: bash + run: NO_CLEANUP=1 cabal test functional + + - name: Print functional failures + if: ${{ failure() && steps.functional.conclusion == 'failure' }} + shell: bash + run: .github/scripts/print_logs.sh diff --git a/.github/workflows/nightly.yaml b/.github/workflows/nightly.yaml new file mode 100644 index 0000000..b4ad319 --- /dev/null +++ b/.github/workflows/nightly.yaml @@ -0,0 +1,22 @@ +name: nightly +on: + push: + branches: + - master + + pull_request: + branches: + - master + + schedule: + # Every day at 00:00 UTC. + # + # https://crontab.guru + - cron: '0 0 * * *' + + workflow_dispatch: +jobs: + trigger-build: + uses: ./.github/workflows/runner.yaml + with: + snapshot: 'nightly' diff --git a/.github/workflows/ci.yaml b/.github/workflows/runner.yaml similarity index 65% rename from .github/workflows/ci.yaml rename to .github/workflows/runner.yaml index ecc0b4a..fc45706 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/runner.yaml @@ -1,69 +1,15 @@ -name: ci +name: runner on: - push: - branches: - - master - - pull_request: - branches: - - master - - schedule: - # Every day at 00:00 UTC. - # - # https://crontab.guru - - cron: '0 0 * * *' + workflow_call: + inputs: + snapshot: + required: true + type: string workflow_dispatch: jobs: - cabal: - strategy: - fail-fast: false - matrix: - os: - - "macos-latest" - - "ubuntu-latest" - - "windows-latest" - runs-on: ${{ matrix.os }} - steps: - - uses: actions/checkout@v6 - - uses: haskell-actions/setup@v2 - with: - # Should be the current stackage nightly, though this will likely go - # out-of-date eventually, until a problem is reported. - ghc-version: "9.12" - - name: Configure - run: | - cabal configure --enable-tests --ghc-options -Werror - - - name: Build executable - run: cabal build exe:clc-stackage - - - name: Unit Tests - id: unit - run: cabal test unit - - - name: Functional Tests - id: functional - # We want to run these tests even if the unit tests fail, because - # it is useful to know if e.g. the unit tests fail due to one - # stackage endpoint failing, but the functional tests pass due to - # a backup working. - if: always() - shell: bash - run: NO_CLEANUP=1 cabal test functional - - - name: Print functional failures - if: ${{ failure() && steps.functional.conclusion == 'failure' }} - shell: bash - run: .github/scripts/print_logs.sh dry-run: - strategy: - fail-fast: false - matrix: - os: - - "ubuntu-latest" - runs-on: ${{ matrix.os }} + runs-on: "ubuntu-latest" steps: - uses: actions/checkout@v6 @@ -73,8 +19,8 @@ jobs: github_access_token: ${{ secrets.GITHUB_TOKEN }} nix_path: nixpkgs=channel:nixos-unstable - - name: Dry run - run: nix develop .#ci -Lv -c bash -c '.github/scripts/dry_run.sh' + - name: Dry run ${{ inputs.snapshot }} + run: nix develop .#ci -Lv -c bash -c '.github/scripts/dry_run.sh ${{ inputs.snapshot }}' # Upload installed binary so that build-batch does not need to re-install # it. @@ -147,4 +93,4 @@ jobs: path: ./bin - name: Build - run: nix develop .#ci -Lv -c bash -c '.github/scripts/batch_index.sh ${{ matrix.index }}' + run: nix develop .#ci -Lv -c bash -c '.github/scripts/batch_index.sh ${{ matrix.index }} ${{ inputs.snapshot }}' diff --git a/.github/workflows/stable.yaml b/.github/workflows/stable.yaml new file mode 100644 index 0000000..5fc75eb --- /dev/null +++ b/.github/workflows/stable.yaml @@ -0,0 +1,22 @@ +name: stable +on: + push: + branches: + - master + + pull_request: + branches: + - master + + schedule: + # Once a week. + # + # https://crontab.guru + - cron: '0 0 * * 0' + + workflow_dispatch: +jobs: + trigger-build: + uses: ./.github/workflows/runner.yaml + with: + snapshot: 'nightly-2026-10-22' diff --git a/README.md b/README.md index b48361b..da65af6 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ # `clc-stackage` -[![ci](https://github.com/haskell/clc-stackage/actions/workflows/ci.yaml/badge.svg)](https://github.com/haskell/clc-stackage/actions/workflows/ci.yaml) +[![build](https://github.com/haskell/clc-stackage/actions/workflows/build.yaml/badge.svg)](https://github.com/haskell/clc-stackage/actions/workflows/build.yaml) +[![stable](https://github.com/haskell/clc-stackage/actions/workflows/stable.yaml/badge.svg)](https://github.com/haskell/clc-stackage/actions/workflows/stable.yaml) +[![nightly](https://github.com/haskell/clc-stackage/actions/workflows/nightly.yaml/badge.svg)](https://github.com/haskell/clc-stackage/actions/workflows/nightly.yaml) ## How to? @@ -14,7 +16,18 @@ An impact assessment is due when The procedure is as follows: -1. Rebase changes, mandated by your proposal, atop the ghc branch (or tag) that corresponds to the current [stackage nightly](https://www.stackage.org/nightly). For example, if the latest snapshot ghc is `ghc-9.12.3`, we would want to rebase our changes on the `ghc-9.12.3-release` tag. +1. Rebase changes, mandated by your proposal, atop the ghc branch (or tag) that corresponds to the snapshot you intend to use. The most natural snapshot choices are either the [current stable](./.github/workflows/stable.yaml): + + ```yaml + # .github/workflows/stable.yaml + snapshot: 'nightly-' + ``` + + Or just `nightly` for the latest. Ideally we would like to use `nightly`, as it is the most recent and likely easiest GHC to build. But `nightly` can sometimes bring in new, problematic packages, hence we also list a `stable`, as a last known "good" snapshot, for when `nightly` is broken. + + Both snapshots have CI jobs that attempt to build them, so CI can be a useful indicator of the current snapshots' health. + + As an example, if our chosen snapshot corresponds to `ghc-9.12.3`, we would want to rebase our changes on the `ghc-9.12.3-release` tag. 2. Compile a patched GHC, say, `~/ghc/_build/stage1/bin/ghc`. @@ -70,7 +83,17 @@ The procedure is as follows: ### Troubleshooting -Because we build with `nightly` and are at the mercy of cabal's constraint solver, it is possible to run into solver / build issues that have nothing to do with our custom GHC. Some of the most common problems include: +#### Stable + +While the stable snapshot is more stable than `nightly`, we can still run into problems: + +- Hackage revisions can make a build fail e.g. `base<0`. + +It may be useful to combine `stable` with `index-state` in [generated/cabal.project](./generated/cabal.project). + +#### Nightly + +Building with `nightly` leaves us at the mercy of cabal's constraint solver, hence it is possible to run into solver / build issues that have nothing to do with our custom GHC. Some of the most common problems include: - Nightly adds a new, problematic package `p` e.g. @@ -133,7 +156,28 @@ In general, user mitigations for solver / build problems include: #### Querying stackage -By default, `clc-stackage` queries https://www.stackage.org/ for snapshot information. In situations where this is not desirable (e.g. the server is not working, or we want to test a custom snapshot), the snapshot can be overridden: +By default, `clc-stackage` queries `https://www.stackage.org/nightly` for snapshot information. In situations where this is not desirable (e.g. the server is not working, or we want to test a custom snapshot), the snapshot can be overridden in two ways. + +##### Supplying another url + +The `--snapshot-url` param can be used to override the default snapshot e.g. + +```sh +# resolves to https://www.stackage.org/nightly-2026-04-23 +$ clc-stackage --snapshot-url=nightly-2026-04-23 + +# https://www.stackage.org/lts-24.38 +$ clc-stackage --snapshot-url=lts-24.38 + +# https://some-url +$ clc-stackage --snapshot-url=https://some-url +``` + +Note that we expect the url to have the same API as stackage, and fall back to `/cabal.config` if its json endpoint is not working. + +##### Supplying a manual snapshot + +We can also supply a snapshot manually: ```sh $ clc-stackage --snapshot-path=path/to/snapshot diff --git a/dev.md b/dev.md index 3a5cdab..dcc23bf 100644 --- a/dev.md +++ b/dev.md @@ -75,13 +75,20 @@ The executable that actually runs. This is a very thin wrapper over `runner`, wh ## Updating to a new snapshot -`clc-stackage` is based on `nightly` -- which changes automatically -- meaning we do not necessarily have to do anything when a new (minor) snapshot is released. On the other hand, *major* snapshot updates will almost certainly bring in new packages that need to be excluded, so there are some general "update steps" we will want to take: +While `clc-stackage` is based on `nightly` -- which changes automatically -- we also specify a `stable` snapshot as a backup for when `nightly` runs into build issues e.g. a new package is added that needs to be excluded or have a flag set. This occurs a few times a month. We therefore pick an arbitrary `nightly` snapshot that has many packages in it (generally 3000+). When we do want to update the snapshot -- generally, once per GHC major version update -- there are some general steps we will want to take: -1. Modify [package_index.jsonc](package_index.jsonc) as needed. That is, updating the snapshot major version will probably bring in some new packages that we do not want. The update process is essentially trial-and-error i.e. run `clc-stackage` as normal, and later add any failing packages to `package_index.excluded` that should be excluded. +1. Update the [stable snapshot date](./.github/workflows/stable.yaml): -2. Update `ghc-version` in [.github/workflows/ci.yaml](.github/workflows/ci.yaml). + ```yaml + # .github/workflows/stable.yaml + snapshot: 'nightly-' + ``` -3. Optional: Update nix: +2. Modify [package_index.jsonc](package_index.jsonc) as needed. That is, updating the snapshot version will probably bring in some new packages that we do not want. The update process is essentially trial-and-error i.e. run `clc-stackage` as normal, and later add any failing packages to `package_index.excluded` that should be excluded. + +3. If this is a major ghc update, update the `ghc-version` in [.github/workflows/build.yaml](.github/workflows/build.yaml). + +4. Optional: Update nix: - Inputs (`nix flake update`). - GHC: Update the `compiler = pkgs.haskell.packages.ghc;` line. @@ -115,4 +122,4 @@ Note that this only saves files from the _last_ test, so if you want to examine > [!TIP] > -> CI has a job `build-batch` which actually builds the entire package set, hence it can be used in place of manual building / testing. Note it takes about an hour to run. +> CI has workflows `nightly` and `stable` which build the entire package set, hence they can be used in place of manual building / testing. Note they each take about an hour to run. diff --git a/src/CLC/Stackage/Parser.hs b/src/CLC/Stackage/Parser.hs index b652589..dff35af 100644 --- a/src/CLC/Stackage/Parser.hs +++ b/src/CLC/Stackage/Parser.hs @@ -45,9 +45,9 @@ import Text.ParserCombinators.ReadP qualified as ReadP -- | Retrieves the 'PackageSet', based on -- 'CLC.Stackage.Parser.API.stackageUrl'. -getPackageList :: Logging.Handle -> Maybe OsPath -> IO PackageSet -getPackageList hLogger msnapshotPath = do - response <- getStackageResponse hLogger msnapshotPath +getPackageList :: Logging.Handle -> Maybe OsPath -> Maybe String -> IO PackageSet +getPackageList hLogger msnapshotPath msnapshotUrl = do + response <- getStackageResponse hLogger msnapshotPath msnapshotUrl packageListToSet hLogger response.packages -- | Given a list of packages, returns a 'PackageSet' i.e. all constraints @@ -57,9 +57,9 @@ packageListToSet hLogger packages = getPackageListByOs hLogger packages OS.currentOs -- | Prints the package list to a file. -printPackageList :: Logging.Handle -> Maybe OsPath -> Maybe Os -> IO () -printPackageList hLogger msnapshotPath mOs = do - response <- getStackageResponse hLogger msnapshotPath +printPackageList :: Logging.Handle -> Maybe OsPath -> Maybe String -> Maybe Os -> IO () +printPackageList hLogger msnapshotPath msnapshotUrl mOs = do + response <- getStackageResponse hLogger msnapshotPath msnapshotUrl case mOs of Just os -> printOsList response os Nothing -> for_ [minBound .. maxBound] (printOsList response) @@ -134,10 +134,10 @@ getPackageListByOs hLogger packageList os = do Osx -> (.osx) Windows -> (.windows) -getStackageResponse :: Logging.Handle -> Maybe OsPath -> IO StackageResponse -getStackageResponse hLogger msnapshotPath = do +getStackageResponse :: Logging.Handle -> Maybe OsPath -> Maybe String -> IO StackageResponse +getStackageResponse hLogger msnapshotPath msnapshotUrl = do response <- case msnapshotPath of - Nothing -> API.getStackage hLogger + Nothing -> API.getStackage hLogger msnapshotUrl Just snapshotPath -> CabalConfig.parseCabalConfig <$> IO.readFileUtf8 snapshotPath diff --git a/src/CLC/Stackage/Parser/API.hs b/src/CLC/Stackage/Parser/API.hs index 5db283c..86814df 100644 --- a/src/CLC/Stackage/Parser/API.hs +++ b/src/CLC/Stackage/Parser/API.hs @@ -9,7 +9,7 @@ module CLC.Stackage.Parser.API ExceptionReason (..), -- * Misc - stackageSnapshot, + defaultSnapshotUrl, ) where @@ -23,20 +23,22 @@ import CLC.Stackage.Parser.API.Common ), StackageException (MkStackageException), StackageResponse (MkStackageResponse, ghc, packages, snapshot), + Url (MkUrl), ) import CLC.Stackage.Parser.API.JSON qualified as JSON import CLC.Stackage.Utils.Exception qualified as Ex import CLC.Stackage.Utils.Logging qualified as Logging import Control.Exception (Exception (displayException), throwIO) +import Data.List qualified as L import Data.Text qualified as T import Network.HTTP.Client.TLS qualified as TLS import System.Exit (ExitCode (ExitFailure)) -- | Returns the 'StackageResponse' corresponding to the given snapshot. -getStackage :: Logging.Handle -> IO StackageResponse -getStackage hLogger = do +getStackage :: Logging.Handle -> Maybe String -> IO StackageResponse +getStackage hLogger msnapshotUrl = do manager <- TLS.newTlsManager - Ex.tryAny (JSON.getStackage manager stackageSnapshot) >>= \case + Ex.tryAny (JSON.getStackage manager snapshotUrl) >>= \case Right r1 -> pure r1 Left jsonEx -> do let e1 = @@ -47,7 +49,7 @@ getStackage hLogger = do Logging.putTimeWarnStr hLogger e1 - Ex.tryAny (CabalConfig.getStackage manager stackageSnapshot) >>= \case + Ex.tryAny (CabalConfig.getStackage manager snapshotUrl) >>= \case Right r2 -> pure r2 Left ex -> do let e2 = @@ -56,10 +58,25 @@ getStackage hLogger = do T.pack $ displayException ex ] - Logging.putTimeErrStr hLogger e2 + Logging.putTimeErrLongStr hLogger e2 throwIO $ ExitFailure 1 + where + snapshotUrl = mkStackageUrl msnapshotUrl --- | Stackage snapshot. Currently just 'nightly' to hopefully allow clc-stackage --- to be more flexible. -stackageSnapshot :: String -stackageSnapshot = "nightly" +-- | Stackage snapshot. Nightly is often okay, but we seem to run into +-- issues a few times a month. +defaultSnapshotUrl :: Url +defaultSnapshotUrl = MkUrl $ stackageDomain <> defaultSnapshot + +defaultSnapshot :: String +defaultSnapshot = "nightly" + +mkStackageUrl :: Maybe String -> Url +mkStackageUrl Nothing = defaultSnapshotUrl +mkStackageUrl (Just s) + | "lts" `L.isPrefixOf` s = MkUrl $ stackageDomain <> s + | "nightly" `L.isPrefixOf` s = MkUrl $ stackageDomain <> s + | otherwise = MkUrl s + +stackageDomain :: String +stackageDomain = "https://stackage.org/" diff --git a/src/CLC/Stackage/Parser/API/CabalConfig.hs b/src/CLC/Stackage/Parser/API/CabalConfig.hs index a7c285d..d1a30c5 100644 --- a/src/CLC/Stackage/Parser/API/CabalConfig.hs +++ b/src/CLC/Stackage/Parser/API/CabalConfig.hs @@ -15,6 +15,7 @@ import CLC.Stackage.Parser.API.Common ), StackageException (MkStackageException), StackageResponse (MkStackageResponse, ghc, packages, snapshot), + Url (unUrl), getStatusCode, ) import CLC.Stackage.Utils.Exception qualified as Ex @@ -34,8 +35,8 @@ import Network.HTTP.Client qualified as HttpClient -- | Given http manager and snapshot string, queries the cabal config -- endpoint. This is intended as a backup, for when the primary endpoint fails. -getStackage :: Manager -> String -> IO StackageResponse -getStackage manager stackageSnapshot = do +getStackage :: Manager -> Url -> IO StackageResponse +getStackage manager stackageUrl = do req <- getRequest HttpClient.withResponse req manager readStackageResponse where @@ -44,7 +45,7 @@ getStackage manager stackageSnapshot = do let bodyReader = HttpClient.responseBody res status = HttpClient.responseStatus res statusCode = getStatusCode res - mkEx = MkStackageException stackageSnapshot + mkEx = MkStackageException stackageConfigUrl when (statusCode /= 200) $ throwIO $ @@ -63,14 +64,11 @@ getStackage manager stackageSnapshot = do pure $ parseCabalConfig bodyTxt getRequest :: IO Request - getRequest = HttpClient.parseRequest stackageUrl + getRequest = HttpClient.parseRequest stackageConfigUrl.unUrl -- Url for the stackage snapshot. - stackageUrl :: String - stackageUrl = - "https://stackage.org/" - <> stackageSnapshot - <> "/cabal.config" + stackageConfigUrl :: Url + stackageConfigUrl = stackageUrl <> "/cabal.config" parseCabalConfig :: Text -> StackageResponse parseCabalConfig txt = diff --git a/src/CLC/Stackage/Parser/API/Common.hs b/src/CLC/Stackage/Parser/API/Common.hs index 3a225f2..acea19d 100644 --- a/src/CLC/Stackage/Parser/API/Common.hs +++ b/src/CLC/Stackage/Parser/API/Common.hs @@ -8,6 +8,7 @@ module CLC.Stackage.Parser.API.Common ExceptionReason (..), -- * Misc + Url (..), getStatusCode, ) where @@ -19,6 +20,7 @@ import Control.Exception SomeException, ) import Data.ByteString (ByteString) +import Data.String (IsString) import Data.Text (Text) import Data.Text.Encoding.Error (UnicodeException) import GHC.Generics (Generic) @@ -52,7 +54,7 @@ data ExceptionReason -- | General network exception. data StackageException = MkStackageException - { snapshot :: String, + { snapshot :: Url, reason :: ExceptionReason } deriving stock (Show) @@ -65,7 +67,7 @@ instance Exception StackageException where then mconcat [ "Received 404 for snapshot '", - snapshot, + snapshot.unUrl, "'. Is the snapshot correct? ", statusMessage status ] @@ -74,14 +76,14 @@ instance Exception StackageException where [ "Received ", show $ Status.statusCode status, " for snapshot '", - snapshot, + snapshot.unUrl, "'. ", statusMessage status ] ReasonReadBody readBodyEx -> mconcat [ "Exception reading body for snapshot '", - snapshot, + snapshot.unUrl, "':\n\n", displayException readBodyEx ] @@ -111,3 +113,11 @@ instance Exception StackageException where getStatusCode :: Response body -> Int getStatusCode = Status.statusCode . HttpClient.responseStatus + +-- | Simple newtype for a url that is parsed from the CLI, before being +-- handled by http-client. No URL invariants are checked, hence there is +-- no guarantee this is a valid URL. This type exists merely for +-- documentation. +newtype Url = MkUrl {unUrl :: String} + deriving stock (Show) + deriving newtype (IsString, Monoid, Semigroup) diff --git a/src/CLC/Stackage/Parser/API/JSON.hs b/src/CLC/Stackage/Parser/API/JSON.hs index 9854200..8bda234 100644 --- a/src/CLC/Stackage/Parser/API/JSON.hs +++ b/src/CLC/Stackage/Parser/API/JSON.hs @@ -7,6 +7,7 @@ where import CLC.Stackage.Parser.API.Common ( ExceptionReason (ReasonDecodeJson, ReasonReadBody, ReasonStatus), StackageException (MkStackageException), + Url, getStatusCode, ) import CLC.Stackage.Parser.API.Common qualified as Common @@ -23,8 +24,8 @@ import Network.HTTP.Client qualified as HttpClient -- | Given http manager and snapshot string, queries the primary json -- endpoint. -getStackage :: Manager -> String -> IO Common.StackageResponse -getStackage manager stackageSnapshot = do +getStackage :: Manager -> Url -> IO Common.StackageResponse +getStackage manager stackageUrl = do req <- getRequest HttpClient.withResponse req manager readStackageResponse where @@ -33,7 +34,7 @@ getStackage manager stackageSnapshot = do let bodyReader = HttpClient.responseBody res status = HttpClient.responseStatus res statusCode = getStatusCode res - mkEx = MkStackageException stackageSnapshot + mkEx = MkStackageException stackageUrl when (statusCode /= 200) $ throwIO $ @@ -51,7 +52,7 @@ getStackage manager stackageSnapshot = do getRequest :: IO Request getRequest = updateReq <$> mkReq where - mkReq = HttpClient.parseRequest stackageUrl + mkReq = HttpClient.parseRequest stackageUrl.unUrl updateReq r = r { HttpClient.requestHeaders = @@ -59,10 +60,6 @@ getStackage manager stackageSnapshot = do ] } - -- Url for the stackage snapshot. - stackageUrl :: String - stackageUrl = "https://stackage.org/" <> stackageSnapshot - toSnapshotCommon :: StackageResponse -> Common.StackageResponse toSnapshotCommon (MkStackageResponse snapshot pkgs) = Common.MkStackageResponse diff --git a/src/CLC/Stackage/Runner/Args.hs b/src/CLC/Stackage/Runner/Args.hs index 797fae1..2bf09ed 100644 --- a/src/CLC/Stackage/Runner/Args.hs +++ b/src/CLC/Stackage/Runner/Args.hs @@ -91,6 +91,8 @@ data Args = MkArgs -- | Optional path to snapshot file. If given, we use the file's contents -- as the package set, rather than the stackage server. snapshotPath :: Maybe OsPath, + -- | Optional snapshot url, overrides default. + snapshotUrl :: Maybe String, -- | Determines what logs to write. writeLogs :: Maybe WriteLogs } @@ -195,7 +197,7 @@ parseCliArgs = ~(cabalGlobalOpts, cabalOpts, cabalPath, cabalUpdate) <- parseCabalGroup ~(cache, retryFailures) <- parseCacheGroup ~(groupFailFast, packageFailFast) <- parseFailuresGroup - ~(batch, batchIndex, printPackageSet, snapshotPath) <- parseMiscGroup + ~(batch, batchIndex, printPackageSet, snapshotPath, snapshotUrl) <- parseMiscGroup ~(cleanup, colorLogs, writeLogs) <- parseOutputGroup pure $ @@ -214,6 +216,7 @@ parseCliArgs = printPackageSet, retryFailures, snapshotPath, + snapshotUrl, writeLogs } ) @@ -241,11 +244,12 @@ parseCliArgs = parseMiscGroup = OA.parserOptionGroup "Misc options:" $ - (,,,) + (,,,,) <$> parseBatch <*> parseBatchIndex <*> parsePrintPackageSet <*> parseSnapshotPath + <*> parseSnapshotUrl parseOutputGroup = OA.parserOptionGroup "Output options:" $ @@ -419,7 +423,7 @@ parsePackageFailFast = mkSwitch opts [ "If on, the first package that fails _within_ a batch group ", "will cause the entire group to fail. We then move to the next ", "group, as normal. The default 'off' behavior is equivalent to ", - "cabal's --keep-going)." + "cabal's --keep-going." ] -- Notice that unlike other on/off switches, this is an actual flag @@ -471,7 +475,7 @@ parseSnapshotPath = [ OA.long "snapshot-path", OA.metavar "PATH", OA.completer compgenCwdPathsCompleter, - mkHelpNoLine $ + mkHelp $ mconcat [ "Optional path to snapshot file. This overrides ", "the stackage snapshot; that is, we use the file's contents, ", @@ -480,7 +484,26 @@ parseSnapshotPath = "https://www.stackage.org//cabal.config i.e. each ", "line should be ' ==' e.g. 'lens ==5.3.4'. Note ", "that the snapshot is still filtered according to ", - "package_index.jsonc." + "package_index.jsonc. Overrides --snapshot-url." + ] + ] + ) + +parseSnapshotUrl :: Parser (Maybe String) +parseSnapshotUrl = + OA.optional $ + OA.option + OA.str + ( mconcat + [ OA.long "snapshot-url", + OA.metavar "(lts-VERS | nightly-DATE | URL)", + OA.completeWith ["lts", "nightly"], + mkHelpNoLine $ + mconcat + [ "Optional snapshot url that overrides the built-in default. ", + "Can be a snapshot 'lts-24.38', 'nightly-2026-04-23', which ", + "is assumed to refer to https://www.stackage.org/, or an ", + "arbitrary URL, which is interpreted literally." ] ] ) diff --git a/src/CLC/Stackage/Runner/Env.hs b/src/CLC/Stackage/Runner/Env.hs index 2def88a..c410ca7 100644 --- a/src/CLC/Stackage/Runner/Env.hs +++ b/src/CLC/Stackage/Runner/Env.hs @@ -106,7 +106,7 @@ setup hLoggerRaw modifyPackages = do when cliArgs.printPackageSet $ do Logging.putTimeInfoStr hLogger "Printing package set" - Parser.printPackageList hLogger cliArgs.snapshotPath Nothing + Parser.printPackageList hLogger cliArgs.snapshotPath cliArgs.snapshotUrl Nothing throwIO ExitSuccess -- Set up build args for cabal, filling in missing defaults @@ -145,7 +145,7 @@ setup hLoggerRaw modifyPackages = do (completePackageSet, pkgsList) <- case cache of Nothing -> do -- if no cache exists, query stackage - packageSet <- Parser.getPackageList hLogger cliArgs.snapshotPath + packageSet <- Parser.getPackageList hLogger cliArgs.snapshotPath cliArgs.snapshotUrl let pkgs = modifyPackages packageSet.packageList pure (packageSet, pkgs) Just oldResults -> do diff --git a/src/CLC/Stackage/Utils/Logging.hs b/src/CLC/Stackage/Utils/Logging.hs index 217d93a..1c7d5c9 100644 --- a/src/CLC/Stackage/Utils/Logging.hs +++ b/src/CLC/Stackage/Utils/Logging.hs @@ -8,6 +8,7 @@ module CLC.Stackage.Utils.Logging putTimeSuccessStr, putTimeWarnStr, putTimeErrStr, + putTimeErrLongStr, -- ** ANSI Colors colorBlue, @@ -79,6 +80,13 @@ putTimeErrStr hLogger s = do where s' = truncateIfNeeded hLogger.terminalWidth s +putTimeErrLongStr :: Handle -> Text -> IO () +putTimeErrLongStr hLogger s = do + timeStr <- getLocalTimeString hLogger + hLogger.logStrErrLn $ colorRed hLogger.color $ "[" <> timeStr <> "][Error] " <> s' + where + s' = truncateIfNeeded 200 s + getLocalTimeString :: Handle -> IO Text getLocalTimeString hLogger = formatLocalTime <$> hLogger.getLocalTime diff --git a/test/unit/Unit/CLC/Stackage/Parser/API.hs b/test/unit/Unit/CLC/Stackage/Parser/API.hs index 2f84921..bdae311 100644 --- a/test/unit/Unit/CLC/Stackage/Parser/API.hs +++ b/test/unit/Unit/CLC/Stackage/Parser/API.hs @@ -22,14 +22,14 @@ tests = testCabalConfigEndpoint :: TestTree testCabalConfigEndpoint = testCase desc $ do manager <- TLS.newTlsManager - eval =<< CabalConfig.getStackage manager API.stackageSnapshot + eval =<< CabalConfig.getStackage manager API.defaultSnapshotUrl where desc = "Queries stackage cabal.config endpoint" testJsonEndpoint :: TestTree testJsonEndpoint = testCase desc $ do manager <- TLS.newTlsManager - eval =<< JSON.getStackage manager API.stackageSnapshot + eval =<< JSON.getStackage manager API.defaultSnapshotUrl where desc = "Queries stackage json endpoint"