cabal-cache 1.0.1.8 → 1.0.1.9

raw patch · 15 files changed

+101/−44 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• app/Main.hs +0/−1
• cabal-cache.cabal +6/−3
• src/App/Commands.hs +0/−1
• src/App/Commands/SyncFromArchive.hs +4/−5
• src/App/Commands/SyncToArchive.hs +5/−6
• src/App/Commands/Version.hs +2/−3
• src/App/Static.hs +5/−5
• src/App/Static/Base.hs +13/−0
• src/App/Static/Posix.hs +8/−0
• src/App/Static/Windows.hs +15/−0
• src/HaskellWorks/CabalCache/Core.hs +31/−7
• src/HaskellWorks/CabalCache/IO/Lazy.hs +3/−4
• test/HaskellWorks/CabalCache/AwsSpec.hs +3/−3
• test/HaskellWorks/CabalCache/LocationSpec.hs +3/−3
• test/HaskellWorks/CabalCache/QuerySpec.hs +3/−3

@@ -2,7 +2,6 @@  import App.Commands import Control.Monad-import Data.Semigroup      ((<>)) import Options.Applicative  main :: IO ()

@@ -1,7 +1,7 @@ cabal-version:          2.2  name:                   cabal-cache-version:                1.0.1.8+version:                1.0.1.9 synopsis:               CI Assistant for Haskell projects description:            CI Assistant for Haskell projects.  Implements package caching. homepage:               https://github.com/haskell-works/cabal-cache@@ -34,7 +34,7 @@ common directory                      { build-depends: directory                      >= 1.3.3.0    && < 1.4    } common exceptions                     { build-depends: exceptions                     >= 0.10.1     && < 0.11   } common filepath                       { build-depends: filepath                       >= 1.3        && < 1.5    }-common generic-lens                   { build-depends: generic-lens                   >= 1.1.0.0    && < 1.3    }+common generic-lens                   { build-depends: generic-lens                   >= 1.1.0.0    && < 2.1    } common hedgehog                       { build-depends: hedgehog                       >= 1.0        && < 1.1    } common hspec                          { build-depends: hspec                          >= 2.4        && < 3      } common http-client                    { build-depends: http-client                    >= 0.5.14     && < 0.7    }@@ -43,7 +43,7 @@ common hw-hspec-hedgehog              { build-depends: hw-hspec-hedgehog              >= 0.1.0.4    && < 0.2    } common lens                           { build-depends: lens                           >= 4.17       && < 5      } common mtl                            { build-depends: mtl                            >= 2.2.2      && < 2.3    }-common optparse-applicative           { build-depends: optparse-applicative           >= 0.14       && < 0.16   }+common optparse-applicative           { build-depends: optparse-applicative           >= 0.14       && < 0.17   } 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    }@@ -110,6 +110,9 @@       App.Commands.SyncToArchive       App.Commands.Version       App.Static+      App.Static.Base+      App.Static.Posix+      App.Static.Windows       HaskellWorks.CabalCache.AppError       HaskellWorks.CabalCache.AWS.Env       HaskellWorks.CabalCache.Concurrent.DownloadQueue

@@ -3,7 +3,6 @@ import App.Commands.SyncFromArchive import App.Commands.SyncToArchive import App.Commands.Version-import Data.Semigroup               ((<>)) import Options.Applicative  commands :: Parser (IO ())

@@ -13,7 +13,7 @@ import Antiope.Options.Applicative import App.Commands.Options.Parser      (text) import App.Commands.Options.Types       (SyncFromArchiveOptions (SyncFromArchiveOptions))-import App.Static                       (homeDirectory)+import App.Static                       (cabalDirectory) import Control.Applicative import Control.Lens                     hiding ((<.>)) import Control.Monad                    (unless, void, when)@@ -23,7 +23,6 @@ import Data.ByteString.Lazy.Search      (replace) import Data.Generics.Product.Any        (the) import Data.Maybe-import Data.Semigroup                   ((<>)) import Foreign.C.Error                  (eXDEV) import HaskellWorks.CabalCache.AppError import HaskellWorks.CabalCache.IO.Error (catchErrno, exceptWarn, maybeToExcept)@@ -58,8 +57,8 @@ import qualified System.IO.Temp                                   as IO import qualified System.IO.Unsafe                                 as IO -{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{- HLINT ignore "Redundant do"        -}+{- HLINT ignore "Reduce duplication"  -}  skippable :: Z.Package -> Bool skippable package = (package ^. the @"packageType" == "pre-existing")@@ -218,7 +217,7 @@       (   long "store-path"       <>  help "Path to cabal store"       <>  metavar "DIRECTORY"-      <>  value (homeDirectory </> ".cabal" </> "store")+      <>  value (cabalDirectory </> "store")       )   <*> optional       ( strOption

@@ -14,7 +14,7 @@ import Antiope.Options.Applicative import App.Commands.Options.Parser      (text) import App.Commands.Options.Types       (SyncToArchiveOptions (SyncToArchiveOptions))-import App.Static                       (homeDirectory)+import App.Static                       (cabalDirectory) import Control.Applicative import Control.Lens                     hiding ((<.>)) import Control.Monad                    (filterM, unless, when)@@ -23,7 +23,6 @@ import Data.Generics.Product.Any        (the) import Data.List                        ((\\)) import Data.Maybe-import Data.Semigroup                   ((<>)) import HaskellWorks.CabalCache.AppError import HaskellWorks.CabalCache.Location (Location (..), toLocation, (<.>), (</>)) import HaskellWorks.CabalCache.Metadata (createMetadata)@@ -55,8 +54,8 @@ import qualified System.IO.Unsafe                   as IO import qualified UnliftIO.Async                     as IO -{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{- HLINT ignore "Redundant do"        -}+{- HLINT ignore "Reduce duplication"  -}  runSyncToArchive :: Z.SyncToArchiveOptions -> IO () runSyncToArchive opts = do@@ -173,13 +172,13 @@       (   long "archive-uri"       <>  help "Archive URI to sync to"       <>  metavar "S3_URI"-      <>  value (Local $ homeDirectory </> ".cabal" </> "archive")+      <>  value (Local $ cabalDirectory </> "archive")       )   <*> strOption       (   long "store-path"       <>  help "Path to cabal store"       <>  metavar "DIRECTORY"-      <>  value (homeDirectory </> ".cabal" </> "store")+      <>  value (cabalDirectory </> "store")       )   <*> optional       ( strOption

@@ -9,7 +9,6 @@  import App.Commands.Options.Parser (optsVersion) import Data.List-import Data.Semigroup              ((<>)) import Options.Applicative         hiding (columns)  import qualified App.Commands.Options.Types         as Z@@ -18,8 +17,8 @@ import qualified HaskellWorks.CabalCache.IO.Console as CIO import qualified Paths_cabal_cache                  as P -{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{- HLINT ignore "Redundant do"        -}+{- HLINT ignore "Reduce duplication"  -}  runVersion :: Z.VersionOptions -> IO () runVersion _ = do

@@ -1,8 +1,8 @@ module App.Static where -import qualified System.Directory as IO-import qualified System.IO.Unsafe as IO+import qualified App.Static.Base    as S+import qualified App.Static.Posix   as P+import qualified App.Static.Windows as W -homeDirectory :: FilePath-homeDirectory = IO.unsafePerformIO $ IO.getHomeDirectory-{-# NOINLINE homeDirectory #-}+cabalDirectory :: FilePath+cabalDirectory = if S.isPosix then P.cabalDirectory else W.cabalDirectory

@@ -0,0 +1,13 @@+module App.Static.Base where++import qualified System.Directory as IO+import qualified System.IO.Unsafe as IO+import qualified System.Info as I++homeDirectory :: FilePath+homeDirectory = IO.unsafePerformIO $ IO.getHomeDirectory+{-# NOINLINE homeDirectory #-}++isPosix :: Bool+isPosix = I.os /= "mingw32"+{-# NOINLINE isPosix #-}

@@ -0,0 +1,8 @@+module App.Static.Posix where++import HaskellWorks.CabalCache.Location ((</>))++import qualified App.Static.Base as S++cabalDirectory :: FilePath+cabalDirectory = S.homeDirectory </> ".cabal"

@@ -0,0 +1,15 @@+module App.Static.Windows where++import Data.Maybe+import HaskellWorks.CabalCache.Location ((</>))++import qualified App.Static.Base    as S+import qualified System.Environment as IO+import qualified System.IO.Unsafe   as IO++appDataDirectory :: FilePath+appDataDirectory = IO.unsafePerformIO $ fmap (fromMaybe S.homeDirectory) (IO.lookupEnv "APPDATA")+{-# NOINLINE appDataDirectory #-}++cabalDirectory :: FilePath+cabalDirectory = appDataDirectory </> "cabal"

@@ -4,7 +4,9 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeApplications      #-}+ module HaskellWorks.CabalCache.Core   ( PackageInfo(..)   , Tagged(..)@@ -18,25 +20,27 @@ import Control.DeepSeq                  (NFData) import Control.Lens                     hiding ((<.>)) import Control.Monad                    (forM)+import Control.Monad.Catch import Control.Monad.Except import Data.Aeson                       (eitherDecode) import Data.Bifunctor                   (first) import Data.Bool                        (bool) import Data.Generics.Product.Any        (the)-import Data.Semigroup                   ((<>)) import Data.String import Data.Text                        (Text) import GHC.Generics                     (Generic) import HaskellWorks.CabalCache.AppError import HaskellWorks.CabalCache.Error+import HaskellWorks.CabalCache.Show import System.FilePath                  ((<.>), (</>))  import qualified Data.ByteString.Lazy           as LBS-import qualified Data.List                      as List+import qualified Data.List                      as L import qualified Data.Text                      as T import qualified HaskellWorks.CabalCache.IO.Tar as IO import qualified HaskellWorks.CabalCache.Types  as Z import qualified System.Directory               as IO+import qualified System.Process                 as IO  type PackageDir = FilePath type ConfPath   = FilePath@@ -57,12 +61,32 @@   , libs       :: [Library]   } deriving (Show, Eq, Generic, NFData) -mkCompilerContext :: MonadIO m => Z.PlanJson -> ExceptT Text m Z.CompilerContext+(<||>) :: Monad m => ExceptT e m a -> ExceptT e m a -> ExceptT e m a+(<||>) f g = f `catchError` const g++findExecutable :: MonadIO m => Text -> ExceptT Text m Text+findExecutable exe = fmap T.pack $+  liftIO (IO.findExecutable (T.unpack exe)) >>= nothingToError (exe <> " is not in path")++runGhcPkg :: (MonadIO m, MonadCatch m) => Text -> [Text] -> ExceptT Text m Text+runGhcPkg cmdExe args = catch (liftIO $ T.pack <$> IO.readProcess (T.unpack cmdExe) (fmap T.unpack args) "") $+  \(e :: IOError) -> throwError $ "Unable to run " <> cmdExe <> " " <> T.unwords args <> ": " <> tshow e++verifyGhcPkgVersion :: (MonadIO m, MonadCatch m) => Text -> Text -> ExceptT Text m Text+verifyGhcPkgVersion version cmdExe = do+  stdout <- runGhcPkg cmdExe ["--version"]+  if T.isSuffixOf (" " <> version) (mconcat (L.take 1 (T.lines stdout)))+    then return cmdExe+    else throwError $ cmdExe <> "has is not of version " <> version++mkCompilerContext :: (MonadIO m, MonadCatch m) => Z.PlanJson -> ExceptT Text m Z.CompilerContext mkCompilerContext plan = do   compilerVersion <- T.stripPrefix "ghc-" (plan ^. the @"compilerId") & nothingToError "No compiler version available in plan"-  let ghcPkgCmd = "ghc-pkg-" <> compilerVersion-  ghcPkgCmdPath <- liftIO (IO.findExecutable (T.unpack ghcPkgCmd)) >>= nothingToError (ghcPkgCmd <> " is not in path")-  return (Z.CompilerContext [ghcPkgCmdPath])+  let versionedGhcPkgCmd = "ghc-pkg-" <> compilerVersion+  ghcPkgCmdPath <-+          (findExecutable versionedGhcPkgCmd  >>= verifyGhcPkgVersion compilerVersion)+    <||>  (findExecutable "ghc-pkg"           >>= verifyGhcPkgVersion compilerVersion)+  return (Z.CompilerContext [T.unpack ghcPkgCmdPath])  relativePaths :: FilePath -> PackageInfo -> [IO.TarGroup] relativePaths basePath pInfo =@@ -107,5 +131,5 @@ getLibFiles relativeLibPath libPath libPrefix = do   libExists <- IO.doesDirectoryExist libPath   if libExists-     then fmap (relativeLibPath </>) . filter (List.isPrefixOf (T.unpack libPrefix)) <$> IO.listDirectory libPath+     then fmap (relativeLibPath </>) . filter (L.isPrefixOf (T.unpack libPrefix)) <$> IO.listDirectory libPath      else pure []

@@ -27,7 +27,6 @@ import HaskellWorks.CabalCache.Show  import qualified Antiope.S3.Lazy                    as AWS-import qualified Antiope.S3.Types                   as AWS import qualified Control.Concurrent                 as IO import qualified Data.ByteString.Lazy               as LBS import qualified Data.Text                          as T@@ -43,9 +42,9 @@ import qualified System.IO                          as IO import qualified System.IO.Error                    as IO -{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}+{- HLINT ignore "Redundant do"        -}+{- HLINT ignore "Reduce duplication"  -}+{- HLINT ignore "Redundant bracket"   -}  handleAwsError :: MonadCatch m => m a -> m (Either AppError a) handleAwsError f = catch (Right <$> f) $ \(e :: AWS.Error) ->

@@ -22,9 +22,9 @@ import qualified Network.HTTP.Types         as HTTP import qualified System.Environment         as IO -{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}+{- HLINT ignore "Redundant do"        -}+{- HLINT ignore "Reduce duplication"  -}+{- HLINT ignore "Redundant bracket"   -}  spec :: Spec spec = describe "HaskellWorks.CabalCache.QuerySpec" $ do

@@ -18,9 +18,9 @@ import qualified Hedgehog.Range  as Range import qualified System.FilePath as FP -{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}+{- HLINT ignore "Redundant do"        -}+{- HLINT ignore "Reduce duplication"  -}+{- HLINT ignore "Redundant bracket"   -}  s3Uri :: MonadGen m => m S3Uri s3Uri = do

@@ -16,9 +16,9 @@ import qualified Data.ByteString.Lazy          as LBS import qualified HaskellWorks.CabalCache.Types as Z -{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: ignore Redundant bracket"   :: String) #-}+{- HLINT ignore "Redundant do"        -}+{- HLINT ignore "Reduce duplication"  -}+{- HLINT ignore "Redundant bracket"   -}  spec :: Spec spec = describe "HaskellWorks.Assist.QuerySpec" $ do