Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Adopt hw-prelude #240

Merged
merged 2 commits into from
Nov 24, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
File renamed without changes.
11 changes: 7 additions & 4 deletions .github/workflows/ci.yml
Original file line number Diff line number Diff line change
@@ -17,16 +17,16 @@ jobs:
strategy:
fail-fast: false
matrix:
ghc: ["9.4.8", "9.2.8", "8.10.7"]
ghc: ["9.6.6", "9.4.8", "9.2.8"]
os: [ubuntu-latest, windows-latest]
include:
- ghc: "8.10.7"
- ghc: "9.6.6"
os: macOS-latest

steps:
- uses: actions/checkout@v4

- uses: haskell/actions/setup@v2
- uses: haskell-actions/setup@v2
id: setup-haskell
with:
ghc-version: ${{ matrix.ghc }}
@@ -36,6 +36,9 @@ jobs:
if: matrix.os == 'windows-latest'
run: echo 'EXE_EXT=.exe' >> $GITHUB_ENV

- name: Cabal update
run: cabal update

- name: Configure project
run: |
cabal configure --enable-tests --enable-benchmarks --write-ghc-environment-files=ghc8.4.4+
@@ -229,7 +232,7 @@ jobs:
strategy:
fail-fast: false
matrix:
ghc: ["8.10.7"]
ghc: ["9.6.6"]
os: [ubuntu-latest, macOS-latest, windows-latest]

steps:
1 change: 1 addition & 0 deletions app/App/Commands.hs
Original file line number Diff line number Diff line change
@@ -5,6 +5,7 @@ import App.Commands.Plan (cmdPlan)
import App.Commands.SyncFromArchive (cmdSyncFromArchive)
import App.Commands.SyncToArchive (cmdSyncToArchive)
import App.Commands.Version (cmdVersion)
import HaskellWorks.Prelude
import Options.Applicative (Parser)

import qualified Options.Applicative as OA
1 change: 1 addition & 0 deletions app/App/Commands/Debug.hs
Original file line number Diff line number Diff line change
@@ -3,6 +3,7 @@ module App.Commands.Debug
) where

import App.Commands.Debug.S3 (cmdS3)
import HaskellWorks.Prelude

import qualified Options.Applicative as OA

1 change: 1 addition & 0 deletions app/App/Commands/Debug/S3.hs
Original file line number Diff line number Diff line change
@@ -3,6 +3,7 @@ module App.Commands.Debug.S3
) where

import App.Commands.Debug.S3.Cp (cmdCp)
import HaskellWorks.Prelude

import qualified Options.Applicative as OA

8 changes: 2 additions & 6 deletions app/App/Commands/Debug/S3/Cp.hs
Original file line number Diff line number Diff line change
@@ -9,15 +9,11 @@ module App.Commands.Debug.S3.Cp

import App.Commands.Options.Parser (text)
import App.Commands.Options.Types (CpOptions (CpOptions))
import Control.Applicative (Alternative(..), optional)
import Control.Lens ((&), (^.), (.~), (%~))
import Control.Monad.Except (MonadIO(..))
import Data.ByteString (ByteString)
import Data.Functor ((<&>))
import Data.Generics.Product.Any (the)
import HaskellWorks.CabalCache.AppError (AwsError(..), displayAwsError)
import HaskellWorks.CabalCache.Error (CopyFailed(..), ExitFailure(..), UnsupportedUri)
import HaskellWorks.CabalCache.Show (tshow)
import HaskellWorks.Prelude
import Lens.Micro
import Network.URI (parseURI)

import qualified Amazonka as AWS
4 changes: 1 addition & 3 deletions app/App/Commands/Options/Parser.hs
Original file line number Diff line number Diff line change
@@ -5,10 +5,8 @@ module App.Commands.Options.Parser
) where

import App.Commands.Options.Types (VersionOptions (..))
import Control.Applicative (Alternative(..))
import Control.Monad (join)
import Data.Set (Set)
import Data.Text (Text)
import HaskellWorks.Prelude
import Options.Applicative (Parser, ReadM)

import qualified Amazonka.Data as AWS
3 changes: 1 addition & 2 deletions app/App/Commands/Options/Types.hs
Original file line number Diff line number Diff line change
@@ -9,11 +9,10 @@ module App.Commands.Options.Types
VersionOptions(..),
) where

import Data.ByteString (ByteString)
import Data.Set (Set)
import GHC.Generics (Generic)
import HaskellWorks.CabalCache.Location (Location)
import HaskellWorks.CabalCache.Types (PackageId)
import HaskellWorks.Prelude
import Network.URI (URI)

import qualified Amazonka as AWS
8 changes: 2 additions & 6 deletions app/App/Commands/Plan.hs
Original file line number Diff line number Diff line change
@@ -8,16 +8,12 @@ module App.Commands.Plan
) where

import App.Commands.Options.Types (PlanOptions (PlanOptions))
import Control.Applicative (optional)
import Control.Lens ((<&>), (&), (^.), (%~), Each(each))
import Control.Monad (forM)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Lens ((^.), (%~), Each(each))
import Data.Generics.Product.Any (the)
import Data.Maybe (fromMaybe)
import HaskellWorks.CabalCache.Error (DecodeError, ExitFailure(..))
import HaskellWorks.CabalCache.Location (Location (..), (<.>), (</>))
import HaskellWorks.CabalCache.Show (tshow)
import HaskellWorks.CabalCache.Version (archiveVersion)
import HaskellWorks.Prelude
import Options.Applicative (Parser, Mod, CommandFields)

import qualified Amazonka.Data as AWS
41 changes: 16 additions & 25 deletions app/App/Commands/SyncFromArchive.hs
Original file line number Diff line number Diff line change
@@ -9,30 +9,21 @@ module App.Commands.SyncFromArchive

import App.Commands.Options.Parser (optsPackageIds, text)
import App.Commands.Options.Types (SyncFromArchiveOptions (SyncFromArchiveOptions))
import Control.Applicative (optional, Alternative(..))
import Control.Lens ((^..), (%~), (&), (^.), (.~), Each(each))
import Control.Lens ((^..), (%~), (^.), (.~), Each(each))
import Control.Lens.Combinators (traverse1)
import Control.Monad (when, unless, forM_)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Except (ExceptT)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Resource (runResourceT)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy.Search (replace)
import Data.Functor ((<&>))
import Data.Generics.Product.Any (the)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import HaskellWorks.CabalCache.AppError (AwsError, HttpError (..), displayAwsError, displayHttpError)
import HaskellWorks.CabalCache.Error (DecodeError(..), ExitFailure(..), InvalidUrl(..), NotFound, UnsupportedUri(..))
import HaskellWorks.CabalCache.IO.Lazy (readFirstAvailableResource)
import HaskellWorks.CabalCache.IO.Tar (ArchiveError(..))
import HaskellWorks.CabalCache.Location (toLocation, (<.>), (</>), Location)
import HaskellWorks.CabalCache.Metadata (loadMetadata)
import HaskellWorks.CabalCache.Show (tshow)
import HaskellWorks.CabalCache.Version (archiveVersion)
import HaskellWorks.Prelude
import Options.Applicative (CommandFields, Mod, Parser)
import Options.Applicative.NonEmpty (some1)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
@@ -135,7 +126,7 @@ runSyncFromArchive opts = OO.runOops $ OO.catchAndExitFailure @ExitFailure do

unless storeCompilerPackageDbPathExists do
CIO.putStrLn "Package DB missing. Creating Package DB"
liftIO $ GhcPkg.init compilerContext storeCompilerPackageDbPath
liftIO $ GhcPkg.contextInit compilerContext storeCompilerPackageDbPath

packages <- liftIO $ Z.getPackages storePath planJson

@@ -161,7 +152,7 @@ runSyncFromArchive opts = OO.runOops $ OO.catchAndExitFailure @ExitFailure do
pInfo <- pure (M.lookup packageId pInfos)
& do OO.onNothing do
CIO.hPutStrLn IO.stderr $ "Warning: Invalid package id: " <> packageId
DQ.succeed
DQ.downloadSucceed

let archiveBaseName = Z.packageDir pInfo <.> ".tar.gz"
let archiveFiles = versionedArchiveUris & traverse1 %~ (</> T.pack archiveBaseName)
@@ -174,37 +165,37 @@ runSyncFromArchive opts = OO.runOops $ OO.catchAndExitFailure @ExitFailure do
package <- pure (M.lookup packageId planPackages)
& do OO.onNothing do
CIO.hPutStrLn IO.stderr $ "Warning: package not found" <> packageName
DQ.succeed
DQ.downloadSucceed

when (skippable package) do
CIO.putStrLn $ "Skipping: " <> packageName
DQ.succeed
DQ.downloadSucceed

when (packageName `S.member` ignorePackages) do
CIO.putStrLn $ "Ignoring: " <> packageName
DQ.fail
DQ.downloadFail

when storeDirectoryExists DQ.succeed
when storeDirectoryExists DQ.downloadSucceed

OO.suspend runResourceT $ ensureStorePathCleanup packageStorePath do
let locations = sconcat $ fmap L.tuple2ToNel (NEL.zip archiveFiles scopedArchiveFiles)

(existingArchiveFileContents, existingArchiveFile) <- readFirstAvailableResource envAws locations maxRetries
& do OO.catch @AwsError \e -> do
CIO.putStrLn $ "Unable to download any of: " <> tshow locations <> " because: " <> displayAwsError e
DQ.fail
DQ.downloadFail
& do OO.catch @HttpError \e -> do
CIO.putStrLn $ "Unable to download any of: " <> tshow locations <> " because: " <> displayHttpError e
DQ.fail
DQ.downloadFail
& do OO.catch @NotFound \_ -> do
CIO.putStrLn $ "Not found: " <> tshow locations
DQ.fail
DQ.downloadFail
& do OO.catch @InvalidUrl \(InvalidUrl url' reason') -> do
CIO.hPutStrLn IO.stderr $ "Invalid URL: " <> tshow url' <> ", " <> reason'
DQ.fail
DQ.downloadFail
& do OO.catch @UnsupportedUri \e -> do
CIO.hPutStrLn IO.stderr $ tshow e
DQ.fail
DQ.downloadFail

CIO.putStrLn $ "Extracting: " <> AWS.toText existingArchiveFile

@@ -214,13 +205,13 @@ runSyncFromArchive opts = OO.runOops $ OO.catchAndExitFailure @ExitFailure do
IO.extractTar tempArchiveFile storePath
& do OO.catch @ArchiveError \(ArchiveError reason') -> do
CIO.putStrLn $ "Unable to extract tar at " <> tshow tempArchiveFile <> " because: " <> reason'
DQ.fail
DQ.downloadFail

meta <- loadMetadata packageStorePath
oldStorePath <- pure (Map.lookup "store-path" meta)
& do OO.onNothing do
CIO.putStrLn "store-path is missing from Metadata"
DQ.fail
DQ.downloadFail

let Z.Tagged conf _ = Z.confPath pInfo

@@ -232,7 +223,7 @@ runSyncFromArchive opts = OO.runOops $ OO.catchAndExitFailure @ExitFailure do
liftIO $ LBS.writeFile tempConfPath (replace (LBS.toStrict oldStorePath) (C8.pack storePath) confContents)
liftIO $ IO.copyFile tempConfPath theConfPath >> IO.removeFile tempConfPath

DQ.succeed
DQ.downloadSucceed

CIO.putStrLn "Recaching package database"

13 changes: 3 additions & 10 deletions app/App/Commands/SyncToArchive.hs
Original file line number Diff line number Diff line change
@@ -8,25 +8,18 @@ module App.Commands.SyncToArchive

import App.Commands.Options.Parser (optsPackageIds, text)
import App.Commands.Options.Types (SyncToArchiveOptions (SyncToArchiveOptions))
import Control.Applicative (Alternative(..), optional)
import Control.Concurrent.STM (TVar)
import Control.Lens ((<&>), (&), (^..), (^.), (.~), (%~), Each(each))
import Control.Monad (filterM, when, unless)
import Control.Monad.Except (ExceptT)
import Control.Monad.IO.Class (MonadIO(..))
import Data.ByteString (ByteString)
import Control.Lens ((^..), (^.), (.~), (%~), Each(each))
import Data.Generics.Product.Any (the)
import Data.List ((\\))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import HaskellWorks.CabalCache.AppError (AwsError, HttpError (..), displayAwsError, displayHttpError)
import HaskellWorks.CabalCache.Error (DecodeError, ExitFailure(..), InvalidUrl(..), NotImplemented(..), UnsupportedUri(..))
import HaskellWorks.CabalCache.Location (Location (..), toLocation, (<.>), (</>))
import HaskellWorks.CabalCache.IO.Tar (ArchiveError)
import HaskellWorks.CabalCache.Metadata (createMetadata)
import HaskellWorks.CabalCache.Show (tshow)
import HaskellWorks.CabalCache.Topology (buildPlanData, canShare)
import HaskellWorks.CabalCache.Version (archiveVersion)
import HaskellWorks.Prelude
import Options.Applicative (Parser, Mod, CommandFields)
import System.Directory (doesDirectoryExist)
import System.FilePath (takeDirectory)
@@ -131,7 +124,7 @@ runSyncToArchive opts = do
storeCompilerPackageDbPathExists <- liftIO $ doesDirectoryExist storeCompilerPackageDbPath

unless storeCompilerPackageDbPathExists $
liftIO $ GhcPkg.init compilerContext storeCompilerPackageDbPath
liftIO $ GhcPkg.contextInit compilerContext storeCompilerPackageDbPath

CIO.putStrLn $ "Syncing " <> tshow (length packages) <> " packages"

1 change: 1 addition & 0 deletions app/App/Commands/Version.hs
Original file line number Diff line number Diff line change
@@ -7,6 +7,7 @@ module App.Commands.Version
) where

import App.Commands.Options.Parser (optsVersion)
import HaskellWorks.Prelude
import Options.Applicative (Mod, CommandFields)

import qualified App.Commands.Options.Types as Z
3 changes: 1 addition & 2 deletions app/App/Static.hs
Original file line number Diff line number Diff line change
@@ -7,8 +7,7 @@ module App.Static
) where

import Control.Monad.Catch (handle)
import Control.Exception (IOException)
import Control.Monad.Identity (Identity(..))
import HaskellWorks.Prelude

import qualified App.Static.Base as S
import qualified App.Static.Posix as P
2 changes: 2 additions & 0 deletions app/App/Static/Base.hs
Original file line number Diff line number Diff line change
@@ -3,6 +3,8 @@ module App.Static.Base
isPosix,
) where

import HaskellWorks.Prelude

import qualified System.Directory as IO
import qualified System.IO.Unsafe as IO
import qualified System.Info as I
1 change: 1 addition & 0 deletions app/App/Static/Posix.hs
Original file line number Diff line number Diff line change
@@ -3,6 +3,7 @@ module App.Static.Posix
) where

import HaskellWorks.CabalCache.Location ((</>))
import HaskellWorks.Prelude

import qualified App.Static.Base as S

2 changes: 1 addition & 1 deletion app/App/Static/Windows.hs
Original file line number Diff line number Diff line change
@@ -3,8 +3,8 @@ module App.Static.Windows
cabalDirectory,
) where

import Data.Maybe (fromMaybe)
import HaskellWorks.CabalCache.Location ((</>))
import HaskellWorks.Prelude

import qualified App.Static.Base as S
import qualified System.Environment as IO
3 changes: 1 addition & 2 deletions app/Main.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,7 @@
module Main where

import App.Commands (commands)
import Control.Applicative ((<**>))
import Control.Monad (join)
import HaskellWorks.Prelude

import qualified Options.Applicative as OA

Loading