Skip to content

Commit 3f53933

Browse files
committed
Add stackage cabal.config fallback
When the default stackage json endpoint fails, fallback to trying the <snapshot>/cabal.config endpoint. The latter seems more reliable. This also allows us to easily add a --snapshot-path CLI arg, giving users the ability to pass in a snapshot file manually.
1 parent 6da8b92 commit 3f53933

File tree

27 files changed

+635
-195
lines changed

27 files changed

+635
-195
lines changed

.github/workflows/ci.yaml

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,11 @@ jobs:
4343

4444
- name: Functional Tests
4545
id: functional
46+
# We want to run these tests even if the unit tests fail, because
47+
# it is useful to know if e.g. the unit tests fail due to one
48+
# stackage endpoint failing, but the functional tests pass due to
49+
# a backup working.
50+
if: always()
4651
shell: bash
4752
run: NO_CLEANUP=1 cabal test functional
4853

README.md

Lines changed: 32 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -61,23 +61,50 @@ The procedure is as follows:
6161
6262
### The clc-stackage exe
6363
64-
Previously, this project was just a single (massive) cabal file that had to be manually updated. Usage was fairly simple: `cabal build clc-stackage --keep-going` to build the project, `--keep-going` so that as many packages as possible are built.
64+
`clc-stackage` is an executable that will:
6565
66-
This has been updated so that `clc-stackage` is now an executable that will automatically generate the desired cabal file based on the results of querying stackage directly. This streamlines updates, provides a more flexible build process, and potentially has prettier output (with `--batch` arg):
66+
1. Download the stackage snapshot from the stackage server.
67+
2. Divide the snapshot into groups (determined by `--batch` argument).
68+
3. For each group, generate a cabal file and attempt to build it.
6769
68-
![demo](example_output.png)
70+
#### Querying stackage
6971
70-
In particular, the `clc-stackage` exe allows for splitting the entire package set into subset groups of size `N` with the `--batch N` option. Each group is then built sequentially. Not only can this be useful for situations where building the entire package set in one go is infeasible, but it also provides a "cache" functionality, that allows us to interrupt the program at any point (e.g. `CTRL-C`), and pick up where we left off. For example:
72+
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:
7173
74+
```sh
75+
$ ./bin/clc-stackage --snapshot-path=path/to/snapshot
7276
```
77+
78+
This snapshot should be formatted similar to the `cabal.config` endpoint on the stackage server (e.g. https://www.stackage.org/nightly/cabal.config). That is, package lines should be formatted `<pkgs> ==<vers>`:
79+
80+
```
81+
abstract-deque ==0.3
82+
abstract-deque-tests ==0.3
83+
abstract-par ==0.3.3
84+
AC-Angle ==1.0
85+
acc ==0.2.0.3
86+
...
87+
```
88+
89+
The stackage config itself is valid, so trailing commas and other extraneous lines are allowed (and ignored).
90+
91+
#### Investigating failures
92+
93+
By default (`--write-logs save-failures`), the build logs are saved to the `./output/logs/` directory, with `./output/logs/current-build/` streaming the current build logs.
94+
95+
#### Group batching
96+
97+
The `clc-stackage` exe allows for splitting the entire package set into subset groups of size `N` with the `--batch N` option. Each group is then built sequentially. Not only can this be useful for situations where building the entire package set in one go is infeasible, but it also provides a "cache" functionality, that allows us to interrupt the program at any point (e.g. `CTRL-C`), and pick up where we left off. For example:
98+
99+
```sh
73100
$ ./bin/clc-stackage --batch 100
74101
```
75102

76103
This will split the entire downloaded package set into groups of size 100. Each time a group finishes (success or failure), stdout/err will be updated, and then the next group will start. If the group failed to build and we have `--write-logs save-failures` (the default), then the logs and error output will be in `./output/logs/<pkg>/`, where `<pkg>` is the name of the first package in the group.
77104

78105
See `./bin/clc-stackage --help` for more info.
79106

80-
#### Optimal performance
107+
##### Optimal performance
81108

82109
On the one hand, splitting the entire package set into `--batch` groups makes the output easier to understand and offers a nice workflow for interrupting/restarting the build. On the other hand, there is a question of what the best value of `N` is for `--batch N`, with respect to performance.
83110

app/Main.hs

Lines changed: 3 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -2,26 +2,15 @@ module Main (main) where
22

33
import CLC.Stackage.Runner qualified as Runner
44
import CLC.Stackage.Utils.Logging qualified as Logging
5-
import Data.Text qualified as T
6-
import Data.Time.LocalTime qualified as Local
75
import System.Console.Terminal.Size qualified as TermSize
8-
import System.IO (hPutStrLn, stderr)
96

107
main :: IO ()
118
main = do
129
mWidth <- (fmap . fmap) TermSize.width TermSize.size
1310

11+
let hLogger = Logging.mkDefaultLogger
1412
case mWidth of
15-
Just w -> Runner.run $ mkLogger w
13+
Just w -> Runner.run $ hLogger {Logging.terminalWidth = w}
1614
Nothing -> do
17-
let hLogger = mkLogger 80
18-
Logging.putTimeInfoStr hLogger False "Failed detecting terminal width"
15+
Logging.putTimeInfoStr hLogger "Failed detecting terminal width"
1916
Runner.run hLogger
20-
where
21-
mkLogger w =
22-
Logging.MkHandle
23-
{ Logging.getLocalTime = Local.zonedTimeToLocalTime <$> Local.getZonedTime,
24-
Logging.logStrErrLn = hPutStrLn stderr . T.unpack,
25-
Logging.logStrLn = putStrLn . T.unpack,
26-
Logging.terminalWidth = w
27-
}

clc-stackage.cabal

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -55,13 +55,15 @@ library parser
5555
exposed-modules:
5656
CLC.Stackage.Parser
5757
CLC.Stackage.Parser.API
58-
CLC.Stackage.Parser.Data.Response
59-
CLC.Stackage.Parser.Query
58+
CLC.Stackage.Parser.API.CabalConfig
59+
CLC.Stackage.Parser.API.Common
60+
CLC.Stackage.Parser.API.JSON
6061

6162
build-depends:
6263
, aeson
6364
, bytestring
6465
, containers >=0.6.3.1 && <0.9
66+
, deepseq >=1.4.6.0 && <1.6
6567
, filepath
6668
, http-client >=0.5.9 && <0.8
6769
, http-client-tls ^>=0.3
@@ -121,8 +123,6 @@ executable clc-stackage
121123
build-depends:
122124
, runner
123125
, terminal-size ^>=0.3.4
124-
, text
125-
, time
126126
, utils
127127

128128
hs-source-dirs: ./app
@@ -143,6 +143,7 @@ test-suite unit
143143
type: exitcode-stdio-1.0
144144
main-is: Main.hs
145145
other-modules:
146+
Unit.CLC.Stackage.Parser.API
146147
Unit.CLC.Stackage.Runner.Env
147148
Unit.CLC.Stackage.Runner.Report
148149
Unit.Prelude
@@ -151,11 +152,14 @@ test-suite unit
151152
, base
152153
, builder
153154
, containers
155+
, deepseq
154156
, filepath
157+
, http-client-tls
158+
, parser
155159
, runner
156160
, tasty
157161
, tasty-golden
158-
, tasty-hunit >=0.9 && <0.11
162+
, tasty-hunit >=0.9 && <0.11
159163
, test-utils
160164
, time
161165
, utils

dev.md

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -96,9 +96,11 @@ The executable that actually runs. This is a very thin wrapper over `runner`, wh
9696
1. `ghc-version` in [.github/workflows/ci.yaml](.github/workflows/ci.yaml).
9797
2. [README.md](README.md).
9898

99-
5. Optional: Update `clc-stackage.cabal`'s dependencies (i.e. `cabal outdated`).
99+
5. Update functional tests as needed i.e. exact package versions in `*golden` and `test/functional/snapshot.txt`.
100100

101-
6. Optional: Update nix inputs (`nix flake update`).
101+
6. Optional: Update `clc-stackage.cabal`'s dependencies (i.e. `cabal outdated`).
102+
103+
7. Optional: Update nix inputs (`nix flake update`).
102104

103105
## Testing
104106

example_output.png

-157 KB
Binary file not shown.

src/builder/CLC/Stackage/Builder/Env.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,8 +38,6 @@ data BuildEnv = MkBuildEnv
3838
buildArgs :: [String],
3939
-- | Optional path to cabal executable.
4040
cabalPath :: FilePath,
41-
-- | If true, colors logs.
42-
colorLogs :: Bool,
4341
-- | If true, the first group that fails to completely build stops
4442
-- clc-stackage. Defaults to false.
4543
groupFailFast :: Bool,

src/builder/CLC/Stackage/Builder/Process.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ import CLC.Stackage.Builder.Batch (PackageGroup (unPackageGroup))
99
import CLC.Stackage.Builder.Env
1010
( BuildEnv
1111
( cabalPath,
12-
colorLogs,
1312
groupFailFast,
1413
hLogger,
1514
progress,
@@ -101,11 +100,11 @@ buildProject env idx pkgs = do
101100
ExitSuccess -> do
102101
-- save results
103102
modifyIORef' env.progress.successesRef addPackages
104-
Logging.putTimeSuccessStr env.hLogger env.colorLogs msg
103+
Logging.putTimeSuccessStr env.hLogger msg
105104
ExitFailure _ -> do
106105
-- save results
107106
modifyIORef' env.progress.failuresRef addPackages
108-
Logging.putTimeErrStr env.hLogger env.colorLogs msg
107+
Logging.putTimeErrStr env.hLogger msg
109108

110109
-- throw error if fail fast
111110
when env.groupFailFast $ throwIO exitCode

src/parser/CLC/Stackage/Parser.hs

Lines changed: 29 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE QuasiQuotes #-}
32

43
module CLC.Stackage.Parser
@@ -11,28 +10,32 @@ module CLC.Stackage.Parser
1110
)
1211
where
1312

14-
import CLC.Stackage.Parser.Data.Response
13+
import CLC.Stackage.Parser.API
1514
( PackageResponse (name, version),
1615
StackageResponse (packages),
1716
)
18-
import CLC.Stackage.Parser.Query qualified as Query
17+
import CLC.Stackage.Parser.API qualified as API
18+
import CLC.Stackage.Parser.API.CabalConfig qualified as CabalConfig
1919
import CLC.Stackage.Utils.IO qualified as IO
2020
import CLC.Stackage.Utils.JSON qualified as JSON
21+
import CLC.Stackage.Utils.Logging qualified as Logging
2122
import CLC.Stackage.Utils.OS (Os (Linux, Osx, Windows))
2223
import CLC.Stackage.Utils.OS qualified as OS
24+
import Control.Monad (when)
2325
import Data.Aeson (FromJSON, ToJSON)
2426
import Data.Foldable (for_)
2527
import Data.Set (Set)
2628
import Data.Set qualified as Set
2729
import Data.Text (Text)
2830
import Data.Text qualified as T
2931
import GHC.Generics (Generic)
30-
import System.OsPath (osp)
32+
import System.OsPath (OsPath, osp)
3133

3234
-- | Retrieves the list of packages, based on
3335
-- 'CLC.Stackage.Parser.API.stackageUrl'.
34-
getPackageList :: IO [PackageResponse]
35-
getPackageList = getPackageListByOs OS.currentOs
36+
getPackageList :: Logging.Handle -> Maybe OsPath -> IO [PackageResponse]
37+
getPackageList hLogger msnapshotPath =
38+
getPackageListByOs hLogger msnapshotPath OS.currentOs
3639

3740
-- | Prints the package list to a file.
3841
printPackageList :: Bool -> Maybe Os -> IO ()
@@ -52,20 +55,36 @@ printPackageList incVers mOs = do
5255

5356
-- | Retrieves the package list formatted to text.
5457
getPackageListByOsFmt :: Bool -> Os -> IO [Text]
55-
getPackageListByOsFmt incVers = (fmap . fmap) toText . getPackageListByOs
58+
getPackageListByOsFmt incVers =
59+
(fmap . fmap) toText
60+
. getPackageListByOs Logging.mkDefaultLogger Nothing
5661
where
5762
toText r =
5863
if incVers
5964
then r.name <> "-" <> r.version
6065
else r.name
6166

6267
-- | Helper in case we want to see what the package set for a given OS is.
63-
getPackageListByOs :: Os -> IO [PackageResponse]
64-
getPackageListByOs os = do
68+
getPackageListByOs :: Logging.Handle -> Maybe OsPath -> Os -> IO [PackageResponse]
69+
getPackageListByOs hLogger msnapshotPath os = do
6570
excludedPkgs <- getExcludedPkgs os
6671
let filterExcluded = flip Set.notMember excludedPkgs . (.name)
6772

68-
response <- Query.getStackage
73+
response <- case msnapshotPath of
74+
Nothing -> API.getStackage hLogger
75+
Just snapshotPath ->
76+
CabalConfig.parseCabalConfig
77+
<$> IO.readFileUtf8 snapshotPath
78+
79+
let numPackages = length response.packages
80+
when (numPackages < 2000) $ do
81+
let msg =
82+
mconcat
83+
[ "Only found ",
84+
T.pack $ show numPackages,
85+
" packages. Is that right?"
86+
]
87+
Logging.putTimeWarnStr hLogger msg
6988

7089
let packages = filter filterExcluded response.packages
7190

src/parser/CLC/Stackage/Parser/API.hs

Lines changed: 40 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,54 @@
11
-- | REST API for stackage.org.
22
module CLC.Stackage.Parser.API
3-
( withResponse,
3+
( -- * Querying stackage
4+
StackageResponse (..),
5+
PackageResponse (..),
6+
getStackage,
7+
8+
-- ** Exceptions
9+
StackageException (..),
10+
ExceptionReason (..),
11+
12+
-- * Misc
413
stackageSnapshot,
514
)
615
where
716

8-
import Network.HTTP.Client (BodyReader, Request, Response)
9-
import Network.HTTP.Client qualified as HttpClient
17+
import CLC.Stackage.Parser.API.CabalConfig qualified as CabalConfig
18+
import CLC.Stackage.Parser.API.Common
19+
( ExceptionReason
20+
( ReasonDecodeJson,
21+
ReasonDecodeUtf8,
22+
ReasonReadBody,
23+
ReasonStatus
24+
),
25+
PackageResponse (name, version),
26+
StackageException (MkStackageException),
27+
StackageResponse (MkStackageResponse, packages),
28+
)
29+
import CLC.Stackage.Parser.API.JSON qualified as JSON
30+
import CLC.Stackage.Utils.Exception qualified as Ex
31+
import CLC.Stackage.Utils.Logging qualified as Logging
32+
import Control.Exception (Exception (displayException))
33+
import Data.Text qualified as T
1034
import Network.HTTP.Client.TLS qualified as TLS
1135

12-
-- | Hits the stackage endpoint, invoking the callback on the result.
13-
withResponse :: (Response BodyReader -> IO a) -> IO a
14-
withResponse onResponse = do
36+
-- | Returns the 'StackageResponse' corresponding to the given snapshot.
37+
getStackage :: Logging.Handle -> IO StackageResponse
38+
getStackage hLogger = do
1539
manager <- TLS.newTlsManager
16-
req <- getRequest
17-
HttpClient.withResponse req manager onResponse
40+
Ex.tryAny (JSON.getStackage manager stackageSnapshot) >>= \case
41+
Right r1 -> pure $ r1
42+
Left jsonEx -> do
43+
let msg =
44+
mconcat
45+
[ "Json endpoint failed. Trying cabal config next: ",
46+
T.pack $ displayException jsonEx
47+
]
1848

19-
getRequest :: IO Request
20-
getRequest = updateReq <$> mkReq
21-
where
22-
mkReq = HttpClient.parseRequest stackageUrl
23-
updateReq r =
24-
r
25-
{ HttpClient.requestHeaders =
26-
[ ("Accept", "application/json;charset=utf-8,application/json")
27-
]
28-
}
49+
Logging.putTimeWarnStr hLogger msg
2950

30-
-- | Url for the stackage snapshot.
31-
stackageUrl :: String
32-
stackageUrl = "https://stackage.org/" <> stackageSnapshot
51+
CabalConfig.getStackage manager stackageSnapshot
3352

3453
-- | Stackage snapshot. Note that picking a "good" snapshot is something of
3554
-- an art i.e. not all valid snapshots return json output at the

0 commit comments

Comments
 (0)