From e4972418cb6125fdd06f1a1310d706dfb6938e6a Mon Sep 17 00:00:00 2001 From: John Ky Date: Sun, 24 Nov 2024 12:04:00 +1100 Subject: [PATCH] Adopt hw-prelude --- .github/workflows/ci.yml | 2 +- app/App/Commands.hs | 1 + app/App/Commands/Debug.hs | 1 + app/App/Commands/Debug/S3.hs | 1 + app/App/Commands/Debug/S3/Cp.hs | 8 +--- app/App/Commands/Options/Parser.hs | 4 +- app/App/Commands/Options/Types.hs | 3 +- app/App/Commands/Plan.hs | 8 +--- app/App/Commands/SyncFromArchive.hs | 41 ++++++++----------- app/App/Commands/SyncToArchive.hs | 13 ++---- app/App/Commands/Version.hs | 1 + app/App/Static.hs | 3 +- app/App/Static/Base.hs | 2 + app/App/Static/Posix.hs | 1 + app/App/Static/Windows.hs | 2 +- app/Main.hs | 3 +- cabal-cache.cabal | 19 +++++---- src/HaskellWorks/CabalCache/AWS/Env.hs | 9 ++-- src/HaskellWorks/CabalCache/AWS/Error.hs | 1 + src/HaskellWorks/CabalCache/AWS/S3.hs | 9 ++-- src/HaskellWorks/CabalCache/AWS/S3/URI.hs | 6 +-- src/HaskellWorks/CabalCache/AppError.hs | 4 +- .../CabalCache/Concurrent/DownloadQueue.hs | 16 ++++---- .../CabalCache/Concurrent/Fork.hs | 2 +- src/HaskellWorks/CabalCache/Core.hs | 14 +++---- src/HaskellWorks/CabalCache/Data/List.hs | 1 + src/HaskellWorks/CabalCache/Error.hs | 3 +- src/HaskellWorks/CabalCache/GhcPkg.hs | 12 +++--- src/HaskellWorks/CabalCache/Hash.hs | 5 ++- src/HaskellWorks/CabalCache/IO/File.hs | 2 +- src/HaskellWorks/CabalCache/IO/Lazy.hs | 9 ++-- src/HaskellWorks/CabalCache/IO/Tar.hs | 7 +--- src/HaskellWorks/CabalCache/Location.hs | 7 +--- src/HaskellWorks/CabalCache/Metadata.hs | 4 +- src/HaskellWorks/CabalCache/Options.hs | 9 ++-- src/HaskellWorks/CabalCache/Show.hs | 10 ----- src/HaskellWorks/CabalCache/Store.hs | 4 +- src/HaskellWorks/CabalCache/Topology.hs | 12 +++--- src/HaskellWorks/CabalCache/URI.hs | 3 +- test/HaskellWorks/CabalCache/AwsSpec.hs | 6 +-- .../CabalCache/IntegrationSpec.hs | 2 +- test/HaskellWorks/CabalCache/LocationSpec.hs | 1 + test/HaskellWorks/CabalCache/QuerySpec.hs | 1 + test/Test/Base.hs | 4 +- 44 files changed, 111 insertions(+), 165 deletions(-) delete mode 100644 src/HaskellWorks/CabalCache/Show.hs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f454ae08..d0a7f61c 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -17,7 +17,7 @@ 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" diff --git a/app/App/Commands.hs b/app/App/Commands.hs index 014efd67..4a66dbe1 100644 --- a/app/App/Commands.hs +++ b/app/App/Commands.hs @@ -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 diff --git a/app/App/Commands/Debug.hs b/app/App/Commands/Debug.hs index baa1fd7a..dd19e871 100644 --- a/app/App/Commands/Debug.hs +++ b/app/App/Commands/Debug.hs @@ -3,6 +3,7 @@ module App.Commands.Debug ) where import App.Commands.Debug.S3 (cmdS3) +import HaskellWorks.Prelude import qualified Options.Applicative as OA diff --git a/app/App/Commands/Debug/S3.hs b/app/App/Commands/Debug/S3.hs index 4c6bc5b5..f5ef75b7 100644 --- a/app/App/Commands/Debug/S3.hs +++ b/app/App/Commands/Debug/S3.hs @@ -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 diff --git a/app/App/Commands/Debug/S3/Cp.hs b/app/App/Commands/Debug/S3/Cp.hs index a2639ce6..d492f03a 100644 --- a/app/App/Commands/Debug/S3/Cp.hs +++ b/app/App/Commands/Debug/S3/Cp.hs @@ -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 diff --git a/app/App/Commands/Options/Parser.hs b/app/App/Commands/Options/Parser.hs index b5f6c6c4..53760c9d 100644 --- a/app/App/Commands/Options/Parser.hs +++ b/app/App/Commands/Options/Parser.hs @@ -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 diff --git a/app/App/Commands/Options/Types.hs b/app/App/Commands/Options/Types.hs index 0ede54e6..ce4a9e26 100644 --- a/app/App/Commands/Options/Types.hs +++ b/app/App/Commands/Options/Types.hs @@ -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 diff --git a/app/App/Commands/Plan.hs b/app/App/Commands/Plan.hs index aa59f87e..b0d494c6 100644 --- a/app/App/Commands/Plan.hs +++ b/app/App/Commands/Plan.hs @@ -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 diff --git a/app/App/Commands/SyncFromArchive.hs b/app/App/Commands/SyncFromArchive.hs index f40cbaca..1cabb5d4 100644 --- a/app/App/Commands/SyncFromArchive.hs +++ b/app/App/Commands/SyncFromArchive.hs @@ -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,17 +165,17 @@ 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) @@ -192,19 +183,19 @@ runSyncFromArchive opts = OO.runOops $ OO.catchAndExitFailure @ExitFailure do (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" diff --git a/app/App/Commands/SyncToArchive.hs b/app/App/Commands/SyncToArchive.hs index db65a6e8..b5fb5c09 100644 --- a/app/App/Commands/SyncToArchive.hs +++ b/app/App/Commands/SyncToArchive.hs @@ -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" diff --git a/app/App/Commands/Version.hs b/app/App/Commands/Version.hs index 423666bb..874e7b2d 100644 --- a/app/App/Commands/Version.hs +++ b/app/App/Commands/Version.hs @@ -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 diff --git a/app/App/Static.hs b/app/App/Static.hs index eac6386c..73fb7396 100644 --- a/app/App/Static.hs +++ b/app/App/Static.hs @@ -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 diff --git a/app/App/Static/Base.hs b/app/App/Static/Base.hs index d92e54bf..4abdef30 100644 --- a/app/App/Static/Base.hs +++ b/app/App/Static/Base.hs @@ -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 diff --git a/app/App/Static/Posix.hs b/app/App/Static/Posix.hs index 6547a077..096af107 100644 --- a/app/App/Static/Posix.hs +++ b/app/App/Static/Posix.hs @@ -3,6 +3,7 @@ module App.Static.Posix ) where import HaskellWorks.CabalCache.Location (()) +import HaskellWorks.Prelude import qualified App.Static.Base as S diff --git a/app/App/Static/Windows.hs b/app/App/Static/Windows.hs index 1cfa37ce..14e79478 100644 --- a/app/App/Static/Windows.hs +++ b/app/App/Static/Windows.hs @@ -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 diff --git a/app/Main.hs b/app/Main.hs index 6a42655b..7453aadd 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/cabal-cache.cabal b/cabal-cache.cabal index e234a477..c01a5761 100644 --- a/cabal-cache.cabal +++ b/cabal-cache.cabal @@ -11,7 +11,7 @@ author: John Ky maintainer: newhoggy@gmail.com copyright: John Ky 2019-2023 category: Development -tested-with: GHC == 9.4.8, GHC == 9.2.8, GHC == 8.10.7 +tested-with: GHC == 9.6.6, GHC == 9.4.8, GHC == 9.2.8 extra-source-files: README.md source-repository head @@ -36,7 +36,7 @@ common exceptions { build-depends: exceptions common filepath { build-depends: filepath >= 1.3 && < 1.6 } common generic-lens { build-depends: generic-lens >= 1.1.0.0 && < 2.3 } common Glob { build-depends: Glob >= 0.10.2 && < 0.11 } -common hedgehog { build-depends: hedgehog >= 1.0 && < 1.5 } +common hedgehog { build-depends: hedgehog >= 1.5 && < 1.6 } common hedgehog-extras { build-depends: hedgehog-extras >= 0.4 && < 0.7 } common hspec { build-depends: hspec >= 2.4 && < 3 } common http-client { build-depends: http-client >= 0.5.14 && < 0.8 } @@ -44,11 +44,13 @@ common http-client-tls { build-depends: http-client-tls common http-types { build-depends: http-types >= 0.12.3 && < 0.13 } common hw-hedgehog { build-depends: hw-hedgehog >= 0.1.0.3 && < 0.2 } common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } +common hw-prelude { build-depends: hw-prelude >= 0.0.4.0 && < 0.1 } common lens { build-depends: lens >= 4.17 && < 6 } common mtl { build-depends: mtl >= 2.2.2 && < 2.4 } common network-uri { build-depends: network-uri >= 2.6.4.1 && < 2.8 } common oops { build-depends: oops >= 0.2 && < 0.3 } common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.19 } +common microlens { build-depends: microlens >= 0.4.13.1 && < 0.5 } common process { build-depends: process >= 1.6.5.0 && < 1.7 } common raw-strings-qq { build-depends: raw-strings-qq >= 1.1 && < 2 } common relation { build-depends: relation >= 0.5 && < 0.6 } @@ -72,11 +74,13 @@ common project-config FlexibleContexts LambdaCase MonoLocalBinds + NoImplicitPrelude TypeOperators ghc-options: -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wtabs + -Wunused-packages if impl(ghc >= 8.10.1) ghc-options: -Wunused-packages @@ -100,7 +104,8 @@ library http-client, http-client-tls, http-types, - lens, + hw-prelude, + microlens, mtl, network-uri, oops, @@ -111,7 +116,6 @@ library stm, text, topograph, - transformers, other-modules: Paths_cabal_cache autogen-modules: Paths_cabal_cache hs-source-dirs: src @@ -135,7 +139,6 @@ library HaskellWorks.CabalCache.Location HaskellWorks.CabalCache.Metadata HaskellWorks.CabalCache.Options - HaskellWorks.CabalCache.Show HaskellWorks.CabalCache.Store HaskellWorks.CabalCache.Text HaskellWorks.CabalCache.Topology @@ -155,8 +158,9 @@ executable cabal-cache exceptions, filepath, generic-lens, + hw-prelude, + microlens, lens, - mtl, network-uri, oops, optparse-applicative, @@ -201,8 +205,7 @@ test-suite cabal-cache-test hspec, http-types, hw-hspec-hedgehog, - lens, - mtl, + hw-prelude, network-uri, oops, raw-strings-qq, diff --git a/src/HaskellWorks/CabalCache/AWS/Env.hs b/src/HaskellWorks/CabalCache/AWS/Env.hs index f3558166..ad292e49 100644 --- a/src/HaskellWorks/CabalCache/AWS/Env.hs +++ b/src/HaskellWorks/CabalCache/AWS/Env.hs @@ -9,14 +9,11 @@ module HaskellWorks.CabalCache.AWS.Env ) where import Control.Concurrent (myThreadId) -import Control.Lens ((.~), (%~)) -import Control.Monad (when, forM_) -import Data.ByteString (ByteString) import Data.ByteString.Builder (toLazyByteString) -import HaskellWorks.CabalCache.Show (tshow) -import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..)) import Data.Generics.Product.Any (the) -import Data.Function ((&)) +import HaskellWorks.Prelude +import Lens.Micro +import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..)) import qualified Amazonka as AWS import qualified Data.ByteString as BS diff --git a/src/HaskellWorks/CabalCache/AWS/Error.hs b/src/HaskellWorks/CabalCache/AWS/Error.hs index 7f830743..99a7eade 100644 --- a/src/HaskellWorks/CabalCache/AWS/Error.hs +++ b/src/HaskellWorks/CabalCache/AWS/Error.hs @@ -7,6 +7,7 @@ module HaskellWorks.CabalCache.AWS.Error import Control.Monad.Catch (MonadCatch(..), MonadThrow(throwM)) import Control.Monad.Except (MonadError) import HaskellWorks.CabalCache.AppError (AwsError(..)) +import HaskellWorks.Prelude import qualified Amazonka as AWS import qualified Control.Monad.Oops as OO diff --git a/src/HaskellWorks/CabalCache/AWS/S3.hs b/src/HaskellWorks/CabalCache/AWS/S3.hs index e24fe2ec..32b59e9b 100644 --- a/src/HaskellWorks/CabalCache/AWS/S3.hs +++ b/src/HaskellWorks/CabalCache/AWS/S3.hs @@ -16,19 +16,16 @@ module HaskellWorks.CabalCache.AWS.S3 import Amazonka (ResponseBody) import Amazonka.Data (ToText(..), fromText) -import Control.Lens ((^.)) -import Control.Monad (void, unless) import Control.Monad.Catch (MonadCatch(..)) import Control.Monad.Except (MonadError) -import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Resource (MonadResource, MonadUnliftIO, liftResourceT, runResourceT) import Data.Conduit.Lazy (lazyConsume) +import Data.Generics.Product.Any (the) import HaskellWorks.CabalCache.AppError (AwsError(..)) import HaskellWorks.CabalCache.Error (CopyFailed(..), UnsupportedUri(..)) -import HaskellWorks.CabalCache.Show (tshow) +import HaskellWorks.Prelude +import Lens.Micro import Network.URI (URI) -import Data.Generics.Product.Any (the) import qualified Amazonka as AWS -- import qualified Amazonka.Data.Body as AWS diff --git a/src/HaskellWorks/CabalCache/AWS/S3/URI.hs b/src/HaskellWorks/CabalCache/AWS/S3/URI.hs index 9b375d7f..fcf18fcd 100644 --- a/src/HaskellWorks/CabalCache/AWS/S3/URI.hs +++ b/src/HaskellWorks/CabalCache/AWS/S3/URI.hs @@ -7,12 +7,10 @@ module HaskellWorks.CabalCache.AWS.S3.URI ( S3Uri(..) ) where -import Control.Applicative (Alternative(many), optional) import Control.DeepSeq (NFData) -import Control.Lens ((^.)) import Data.Generics.Product.Any (HasAny(the)) -import Data.Text (Text) -import GHC.Generics (Generic) +import HaskellWorks.Prelude +import Lens.Micro import qualified Amazonka.Data.Text as AWS import qualified Amazonka.S3 as AWS diff --git a/src/HaskellWorks/CabalCache/AppError.hs b/src/HaskellWorks/CabalCache/AppError.hs index 1129c468..24ca8970 100644 --- a/src/HaskellWorks/CabalCache/AppError.hs +++ b/src/HaskellWorks/CabalCache/AppError.hs @@ -11,9 +11,7 @@ module HaskellWorks.CabalCache.AppError displayHttpError, ) where -import Data.Text (Text) -import GHC.Generics (Generic) -import HaskellWorks.CabalCache.Show (tshow) +import HaskellWorks.Prelude import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Types as HTTP diff --git a/src/HaskellWorks/CabalCache/Concurrent/DownloadQueue.hs b/src/HaskellWorks/CabalCache/Concurrent/DownloadQueue.hs index 5fe0eb8a..acc5542b 100644 --- a/src/HaskellWorks/CabalCache/Concurrent/DownloadQueue.hs +++ b/src/HaskellWorks/CabalCache/Concurrent/DownloadQueue.hs @@ -7,17 +7,15 @@ module HaskellWorks.CabalCache.Concurrent.DownloadQueue ( DownloadStatus(..), createDownloadQueue, runQueue, - succeed, - fail, + downloadSucceed, + downloadFail, ) where import Control.Monad.Catch (MonadMask(..)) import Control.Monad.Except (MonadError) -import Control.Monad.IO.Class (MonadIO(liftIO)) -import Data.Function ((&)) import Data.Set ((\\)) -import HaskellWorks.CabalCache.Show (tshow) import Prelude hiding (fail) +import HaskellWorks.Prelude import qualified Control.Concurrent.STM as STM import qualified Control.Monad.Catch as CMC @@ -30,17 +28,17 @@ import qualified System.IO as IO data DownloadStatus = DownloadSuccess | DownloadFailure deriving (Eq, Show) -succeed :: forall e a m. () +downloadSucceed :: forall e a m. () => MonadError (OO.Variant e) m => e `OO.CouldBe` DownloadStatus => m a -succeed = OO.throw DownloadSuccess +downloadSucceed = OO.throw DownloadSuccess -fail :: forall e a m. () +downloadFail :: forall e a m. () => MonadError (OO.Variant e) m => e `OO.CouldBe` DownloadStatus => m a -fail = OO.throw DownloadFailure +downloadFail = OO.throw DownloadFailure createDownloadQueue :: [(Z.ProviderId, Z.ConsumerId)] -> STM.STM Z.DownloadQueue createDownloadQueue dependencies = do diff --git a/src/HaskellWorks/CabalCache/Concurrent/Fork.hs b/src/HaskellWorks/CabalCache/Concurrent/Fork.hs index 8b8dface..6a256da4 100644 --- a/src/HaskellWorks/CabalCache/Concurrent/Fork.hs +++ b/src/HaskellWorks/CabalCache/Concurrent/Fork.hs @@ -3,7 +3,7 @@ module HaskellWorks.CabalCache.Concurrent.Fork ) where import Control.Exception (finally) -import Control.Monad (when, forM_) +import HaskellWorks.Prelude import qualified Control.Concurrent as IO import qualified Control.Concurrent.STM as STM diff --git a/src/HaskellWorks/CabalCache/Core.hs b/src/HaskellWorks/CabalCache/Core.hs index c446322e..0adbb1c9 100644 --- a/src/HaskellWorks/CabalCache/Core.hs +++ b/src/HaskellWorks/CabalCache/Core.hs @@ -17,17 +17,13 @@ module HaskellWorks.CabalCache.Core ) where import Control.DeepSeq (NFData) -import Control.Lens ((<&>), (&), (^.)) import Control.Monad.Catch (MonadCatch(..)) -import Control.Monad.Except (ExceptT, forM, MonadIO(..), MonadError(..)) +import Control.Monad.Except (MonadError(..)) import Data.Aeson (eitherDecode) -import Data.Bifunctor (first) -import Data.Bool (bool) import Data.Generics.Product.Any (the) -import Data.Text (Text) -import GHC.Generics (Generic) import HaskellWorks.CabalCache.Error (DecodeError(..)) -import HaskellWorks.CabalCache.Show (tshow) +import HaskellWorks.Prelude +import Lens.Micro import System.FilePath ((<.>), ()) import qualified Control.Monad.Oops as OO @@ -135,7 +131,7 @@ relativePaths basePath pInfo = <> (pInfo ^. the @"libs") <> [packageDir pInfo] , IO.TarGroup basePath $ mempty - <> ([pInfo ^. the @"confPath"] & filter ((== Present) . (^. the @"tag")) <&> (^. the @"value")) + <> ([pInfo ^. the @"confPath"] & L.filter ((== Present) . (^. the @"tag")) <&> (^. the @"value")) ] getPackages :: FilePath -> Z.PlanJson -> IO [PackageInfo] @@ -181,5 +177,5 @@ getLibFiles :: FilePath -> FilePath -> Text -> IO [Library] getLibFiles relativeLibPath libPath libPrefix = do libExists <- IO.doesDirectoryExist libPath if libExists - then fmap (relativeLibPath ) . filter (L.isPrefixOf (T.unpack libPrefix)) <$> IO.listDirectory libPath + then fmap (relativeLibPath ) . L.filter (L.isPrefixOf (T.unpack libPrefix)) <$> IO.listDirectory libPath else pure [] diff --git a/src/HaskellWorks/CabalCache/Data/List.hs b/src/HaskellWorks/CabalCache/Data/List.hs index 0cd5a370..74952312 100644 --- a/src/HaskellWorks/CabalCache/Data/List.hs +++ b/src/HaskellWorks/CabalCache/Data/List.hs @@ -5,6 +5,7 @@ module HaskellWorks.CabalCache.Data.List ) where import Data.List.NonEmpty (NonEmpty(..)) +import HaskellWorks.Prelude tuple2ToDL :: (a, a) -> [a] -> [a] tuple2ToDL (a, b) = (a:) . (b:) diff --git a/src/HaskellWorks/CabalCache/Error.hs b/src/HaskellWorks/CabalCache/Error.hs index f332d958..71f6b9f4 100644 --- a/src/HaskellWorks/CabalCache/Error.hs +++ b/src/HaskellWorks/CabalCache/Error.hs @@ -12,8 +12,7 @@ module HaskellWorks.CabalCache.Error UnsupportedUri(UnsupportedUri), ) where -import Data.Text (Text) -import GHC.Generics (Generic) +import HaskellWorks.Prelude import Network.URI (URI) data DecodeError = DecodeError Text deriving (Eq, Show, Generic) diff --git a/src/HaskellWorks/CabalCache/GhcPkg.hs b/src/HaskellWorks/CabalCache/GhcPkg.hs index 7fc5f1f3..bc95d683 100644 --- a/src/HaskellWorks/CabalCache/GhcPkg.hs +++ b/src/HaskellWorks/CabalCache/GhcPkg.hs @@ -5,13 +5,13 @@ module HaskellWorks.CabalCache.GhcPkg runGhcPkg, testAvailability, recache, - init, + contextInit, ) where -import Prelude hiding (init) - -import Control.Lens ((^.)) import Data.Generics.Product.Any (HasAny(the)) +import HaskellWorks.Prelude +import HaskellWorks.Unsafe +import Lens.Micro import System.Exit (ExitCode (..), exitWith) import System.Process (waitForProcess) @@ -39,5 +39,5 @@ testAvailability cc = runGhcPkg cc ["--version"] recache :: Z.CompilerContext -> FilePath -> IO () recache cc packageDb = runGhcPkg cc ["recache", "--package-db", packageDb] -init :: Z.CompilerContext -> FilePath -> IO () -init cc packageDb = runGhcPkg cc ["init", packageDb] +contextInit :: Z.CompilerContext -> FilePath -> IO () +contextInit cc packageDb = runGhcPkg cc ["init", packageDb] diff --git a/src/HaskellWorks/CabalCache/Hash.hs b/src/HaskellWorks/CabalCache/Hash.hs index a977a81c..73dd9f93 100644 --- a/src/HaskellWorks/CabalCache/Hash.hs +++ b/src/HaskellWorks/CabalCache/Hash.hs @@ -2,9 +2,12 @@ module HaskellWorks.CabalCache.Hash ( hashStorePath ) where +import HaskellWorks.Prelude + import qualified Crypto.Hash as CH +import qualified Data.List as L import qualified Data.Text as T import qualified Data.Text.Encoding as T hashStorePath :: String -> String -hashStorePath = take 10 . show . CH.hashWith CH.SHA256 . T.encodeUtf8 . T.pack +hashStorePath = L.take 10 . show . CH.hashWith CH.SHA256 . T.encodeUtf8 . T.pack diff --git a/src/HaskellWorks/CabalCache/IO/File.hs b/src/HaskellWorks/CabalCache/IO/File.hs index 39ca9c2f..e03f1397 100644 --- a/src/HaskellWorks/CabalCache/IO/File.hs +++ b/src/HaskellWorks/CabalCache/IO/File.hs @@ -6,7 +6,7 @@ module HaskellWorks.CabalCache.IO.File ) where import Control.Monad.Except (MonadError) -import Control.Monad.IO.Class (MonadIO(..)) +import HaskellWorks.Prelude import qualified Control.Monad.Oops as OO import qualified Data.Text as T diff --git a/src/HaskellWorks/CabalCache/IO/Lazy.hs b/src/HaskellWorks/CabalCache/IO/Lazy.hs index 13c7adf0..836e16a3 100644 --- a/src/HaskellWorks/CabalCache/IO/Lazy.hs +++ b/src/HaskellWorks/CabalCache/IO/Lazy.hs @@ -17,19 +17,16 @@ module HaskellWorks.CabalCache.IO.Lazy retryOnE, ) where -import Control.Lens ((&), (^.)) -import Control.Monad (unless) import Control.Monad.Catch (MonadCatch(..)) -import Control.Monad.Except (ExceptT, MonadError) -import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Except (MonadError) import Control.Monad.Trans.Resource (MonadResource, runResourceT, MonadUnliftIO) -import Data.Functor.Identity (Identity(..)) import Data.Generics.Product.Any (HasAny(the)) import Data.List.NonEmpty (NonEmpty ((:|))) import HaskellWorks.CabalCache.AppError (AwsError(..), HttpError(..), statusCodeOf) import HaskellWorks.CabalCache.Error (CopyFailed(..), InvalidUrl(..), NotFound(..), NotImplemented(..), UnsupportedUri(..)) import HaskellWorks.CabalCache.Location (Location (..)) -import HaskellWorks.CabalCache.Show (tshow) +import HaskellWorks.Prelude +import Lens.Micro import Network.URI (URI) import qualified Amazonka as AWS diff --git a/src/HaskellWorks/CabalCache/IO/Tar.hs b/src/HaskellWorks/CabalCache/IO/Tar.hs index 54328973..3d2671c7 100644 --- a/src/HaskellWorks/CabalCache/IO/Tar.hs +++ b/src/HaskellWorks/CabalCache/IO/Tar.hs @@ -11,13 +11,10 @@ module HaskellWorks.CabalCache.IO.Tar ) where import Control.DeepSeq (NFData) -import Control.Lens ((^.)) import Control.Monad.Except (MonadError) -import Control.Monad.IO.Class (MonadIO(..)) import Data.Generics.Product.Any (HasAny(the)) -import Data.Text (Text) -import GHC.Generics (Generic) -import HaskellWorks.CabalCache.Show (tshow) +import HaskellWorks.Prelude +import Lens.Micro import qualified Control.Monad.Oops as OO import qualified System.Exit as IO diff --git a/src/HaskellWorks/CabalCache/Location.hs b/src/HaskellWorks/CabalCache/Location.hs index 5f22d88d..5a54b567 100644 --- a/src/HaskellWorks/CabalCache/Location.hs +++ b/src/HaskellWorks/CabalCache/Location.hs @@ -12,13 +12,10 @@ module HaskellWorks.CabalCache.Location ) where -import Control.Lens ((&), (%~)) import Data.Generics.Product.Any (HasAny(the)) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import GHC.Generics (Generic) import HaskellWorks.CabalCache.AWS.S3.URI (S3Uri (..)) -import HaskellWorks.CabalCache.Show (tshow) +import HaskellWorks.Prelude +import Lens.Micro import Network.URI (URI) import qualified Amazonka.Data as AWS diff --git a/src/HaskellWorks/CabalCache/Metadata.hs b/src/HaskellWorks/CabalCache/Metadata.hs index 22648e77..53c2e9a8 100644 --- a/src/HaskellWorks/CabalCache/Metadata.hs +++ b/src/HaskellWorks/CabalCache/Metadata.hs @@ -7,11 +7,9 @@ module HaskellWorks.CabalCache.Metadata deleteMetadata, ) where -import Control.Lens ((<&>)) -import Control.Monad (forM_) -import Control.Monad.IO.Class (MonadIO, liftIO) import HaskellWorks.CabalCache.Core (PackageInfo (..)) import HaskellWorks.CabalCache.IO.Tar (TarGroup (..)) +import HaskellWorks.Prelude import System.FilePath (takeFileName, ()) import qualified Data.ByteString.Lazy as LBS diff --git a/src/HaskellWorks/CabalCache/Options.hs b/src/HaskellWorks/CabalCache/Options.hs index d4abdcfb..bd9aea72 100644 --- a/src/HaskellWorks/CabalCache/Options.hs +++ b/src/HaskellWorks/CabalCache/Options.hs @@ -3,14 +3,17 @@ module HaskellWorks.CabalCache.Options ) where import Amazonka.Data.Text (FromText (..), fromText) -import Control.Applicative (Alternative(..)) +import HaskellWorks.Prelude import Options.Applicative (Parser, Mod, OptionFields) -import Text.Read (readEither) import qualified Data.Text as T import qualified Options.Applicative as OA +orElse :: Either e a -> Either e a -> Either e a +orElse a b = + either (const b) Right a + readOrFromTextOption :: (Read a, FromText a) => Mod OptionFields a -> Parser a readOrFromTextOption = - let fromStr s = readEither s <|> fromText (T.pack s) + let fromStr s = readEither s `orElse` fromText (T.pack s) in OA.option $ OA.eitherReader fromStr diff --git a/src/HaskellWorks/CabalCache/Show.hs b/src/HaskellWorks/CabalCache/Show.hs deleted file mode 100644 index 6109fd65..00000000 --- a/src/HaskellWorks/CabalCache/Show.hs +++ /dev/null @@ -1,10 +0,0 @@ -module HaskellWorks.CabalCache.Show - ( tshow, - ) where - -import Data.Text (Text) - -import qualified Data.Text as T - -tshow :: Show a => a -> Text -tshow = T.pack . show diff --git a/src/HaskellWorks/CabalCache/Store.hs b/src/HaskellWorks/CabalCache/Store.hs index 5daf881e..7538ed6f 100644 --- a/src/HaskellWorks/CabalCache/Store.hs +++ b/src/HaskellWorks/CabalCache/Store.hs @@ -2,10 +2,8 @@ module HaskellWorks.CabalCache.Store ( cleanupStorePath, ) where -import Control.Monad (when, void) import Control.Monad.Catch (MonadCatch) -import Control.Monad.IO.Class (MonadIO(liftIO)) -import Control.Monad.Trans.Except (ExceptT) +import HaskellWorks.Prelude import qualified Control.Monad.Oops as OO import qualified HaskellWorks.CabalCache.IO.Lazy as IO diff --git a/src/HaskellWorks/CabalCache/Topology.hs b/src/HaskellWorks/CabalCache/Topology.hs index 74b6cacc..3962052d 100644 --- a/src/HaskellWorks/CabalCache/Topology.hs +++ b/src/HaskellWorks/CabalCache/Topology.hs @@ -9,16 +9,16 @@ module HaskellWorks.CabalCache.Topology ) where import Control.Arrow ((&&&)) -import Control.Lens (view, (&), (<&>), (^.)) -import Control.Monad (join) -import Data.Either (fromRight) import Data.Generics.Product.Any (the) import Data.Map.Strict (Map) -import Data.Maybe (fromMaybe) import Data.Set (Set) -import GHC.Generics (Generic) import HaskellWorks.CabalCache.Types (Package, PackageId, PlanJson) +import HaskellWorks.Prelude +import HaskellWorks.Unsafe +import Lens.Micro +import Lens.Micro.Extras (view) +import qualified Data.List as L import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Topograph as TG @@ -51,7 +51,7 @@ buildPlanData' plan knownNonShareable = fromRight (error "Could not process dependencies") $ TG.runG plan $ \g -> let tg = TG.transpose g - nsPaths = concatMap (fromMaybe [] . paths tg) knownNonShareable + nsPaths = L.concatMap (fromMaybe [] . paths tg) knownNonShareable nsAll = S.fromList (join nsPaths) in PlanData { nonShareable = nsAll } where paths g x = (fmap . fmap . fmap) (TG.gFromVertex g) $ TG.dfs g <$> TG.gToVertex g x diff --git a/src/HaskellWorks/CabalCache/URI.hs b/src/HaskellWorks/CabalCache/URI.hs index 8753928d..182b4334 100644 --- a/src/HaskellWorks/CabalCache/URI.hs +++ b/src/HaskellWorks/CabalCache/URI.hs @@ -5,8 +5,9 @@ module HaskellWorks.CabalCache.URI ( reslashUri, ) where -import Control.Lens ((&), (%~)) import Data.Generics.Product.Any (HasAny(the)) +import HaskellWorks.Prelude +import Lens.Micro import Network.URI (URI) reslashUri :: URI -> URI diff --git a/test/HaskellWorks/CabalCache/AwsSpec.hs b/test/HaskellWorks/CabalCache/AwsSpec.hs index 8a403562..63232b44 100644 --- a/test/HaskellWorks/CabalCache/AwsSpec.hs +++ b/test/HaskellWorks/CabalCache/AwsSpec.hs @@ -8,14 +8,10 @@ module HaskellWorks.CabalCache.AwsSpec ( spec ) where -import Control.Lens -import Control.Monad -import Control.Monad.Except (runExceptT) -import Control.Monad.IO.Class -import Data.Maybe (isJust) import HaskellWorks.CabalCache.AppError (AwsError(..)) import HaskellWorks.CabalCache.Error (UnsupportedUri) import HaskellWorks.Hspec.Hedgehog +import HaskellWorks.Prelude import Hedgehog import Test.Hspec diff --git a/test/HaskellWorks/CabalCache/IntegrationSpec.hs b/test/HaskellWorks/CabalCache/IntegrationSpec.hs index 9bb3a5fe..252217dd 100644 --- a/test/HaskellWorks/CabalCache/IntegrationSpec.hs +++ b/test/HaskellWorks/CabalCache/IntegrationSpec.hs @@ -7,7 +7,7 @@ module HaskellWorks.CabalCache.IntegrationSpec ( spec ) where -import Control.Monad (forM_) +import HaskellWorks.Prelude import System.FilePath (()) import Test.Hspec (Spec, describe, it) diff --git a/test/HaskellWorks/CabalCache/LocationSpec.hs b/test/HaskellWorks/CabalCache/LocationSpec.hs index c4718e02..a3d1417e 100644 --- a/test/HaskellWorks/CabalCache/LocationSpec.hs +++ b/test/HaskellWorks/CabalCache/LocationSpec.hs @@ -7,6 +7,7 @@ module HaskellWorks.CabalCache.LocationSpec import Data.Maybe (fromJust) import HaskellWorks.CabalCache.Location import HaskellWorks.Hspec.Hedgehog +import HaskellWorks.Prelude import Hedgehog import Network.URI (URI) import Test.Hspec diff --git a/test/HaskellWorks/CabalCache/QuerySpec.hs b/test/HaskellWorks/CabalCache/QuerySpec.hs index 0c2cc8fe..23f0a1c2 100644 --- a/test/HaskellWorks/CabalCache/QuerySpec.hs +++ b/test/HaskellWorks/CabalCache/QuerySpec.hs @@ -7,6 +7,7 @@ module HaskellWorks.CabalCache.QuerySpec ) where import HaskellWorks.Hspec.Hedgehog +import HaskellWorks.Prelude import Hedgehog import Test.Hspec import Text.RawString.QQ diff --git a/test/Test/Base.hs b/test/Test/Base.hs index d5cd4e64..b97e6335 100644 --- a/test/Test/Base.hs +++ b/test/Test/Base.hs @@ -5,10 +5,8 @@ module Test.Base , integration ) where -import Control.Monad (void) import Control.Monad.Catch (MonadCatch) -import Control.Monad.IO.Class (MonadIO) -import GHC.Stack (HasCallStack) +import HaskellWorks.Prelude import Hedgehog (MonadTest) import Hedgehog.Extras.Test.Process (ExecConfig)