cabal-cache 1.0.1.3 → 1.0.1.4

raw patch · 4 files changed

+37/−22 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cabal-cache.cabal +3/−2
• src/App/Commands/Options/Types.hs +1/−1
• src/App/Commands/SyncFromArchive.hs +23/−19
• src/HaskellWorks/CabalCache/Data/List.hs +10/−0

@@ -1,7 +1,7 @@ cabal-version:          2.2  name:                   cabal-cache-version:                1.0.1.3+version:                1.0.1.4 synopsis:               CI Assistant for Haskell projects description:            CI Assistant for Haskell projects.  Implements package caching. homepage:               https://github.com/haskell-works/cabal-cache@@ -28,8 +28,8 @@ common antiope-s3                     { build-depends: antiope-s3                     >= 7.4.4      && < 8      } common bytestring                     { build-depends: bytestring                     >= 0.10.8.2   && < 0.11   } common conduit-extra                  { build-depends: conduit-extra                  >= 1.3.1.1    && < 1.4    }-common cryptonite                     { build-depends: cryptonite                     >= 0.25       && < 1      } common containers                     { build-depends: containers                     >= 0.6.0.1    && < 0.7    }+common cryptonite                     { build-depends: cryptonite                     >= 0.25       && < 1      } common deepseq                        { build-depends: deepseq                        >= 1.4.4.0    && < 1.5    } common directory                      { build-depends: directory                      >= 1.3.3.0    && < 1.4    } common exceptions                     { build-depends: exceptions                     >= 0.10.1     && < 0.11   }@@ -116,6 +116,7 @@       HaskellWorks.CabalCache.Concurrent.Fork       HaskellWorks.CabalCache.Concurrent.Type       HaskellWorks.CabalCache.Core+      HaskellWorks.CabalCache.Data.List       HaskellWorks.CabalCache.Error       HaskellWorks.CabalCache.GhcPkg       HaskellWorks.CabalCache.Hash

@@ -20,7 +20,7 @@  data SyncFromArchiveOptions = SyncFromArchiveOptions   { region        :: Region-  , archiveUri    :: Location+  , archiveUris   :: [Location]   , storePath     :: FilePath   , storePathHash :: Maybe String   , threads       :: Int

@@ -27,7 +27,7 @@ import Foreign.C.Error                  (eXDEV) import HaskellWorks.CabalCache.AppError import HaskellWorks.CabalCache.IO.Error (catchErrno, exceptWarn, maybeToExcept)-import HaskellWorks.CabalCache.Location (Location (..), toLocation, (<.>), (</>))+import HaskellWorks.CabalCache.Location (toLocation, (<.>), (</>)) import HaskellWorks.CabalCache.Metadata (loadMetadata) import HaskellWorks.CabalCache.Show import HaskellWorks.CabalCache.Version  (archiveVersion)@@ -38,6 +38,7 @@ import qualified Control.Concurrent.STM                           as STM import qualified Data.ByteString.Char8                            as C8 import qualified Data.ByteString.Lazy                             as LBS+import qualified Data.List                                        as L import qualified Data.Map                                         as M import qualified Data.Map.Strict                                  as Map import qualified Data.Text                                        as T@@ -45,6 +46,7 @@ import qualified HaskellWorks.CabalCache.Concurrent.DownloadQueue as DQ import qualified HaskellWorks.CabalCache.Concurrent.Fork          as IO import qualified HaskellWorks.CabalCache.Core                     as Z+import qualified HaskellWorks.CabalCache.Data.List                as L import qualified HaskellWorks.CabalCache.GhcPkg                   as GhcPkg import qualified HaskellWorks.CabalCache.Hash                     as H import qualified HaskellWorks.CabalCache.IO.Console               as CIO@@ -64,17 +66,18 @@  runSyncFromArchive :: Z.SyncFromArchiveOptions -> IO () runSyncFromArchive opts = do-  let storePath           = opts ^. the @"storePath"-  let archiveUri          = opts ^. the @"archiveUri"-  let threads             = opts ^. the @"threads"-  let awsLogLevel         = opts ^. the @"awsLogLevel"-  let versionedArchiveUri = archiveUri </> archiveVersion-  let storePathHash       = opts ^. the @"storePathHash" & fromMaybe (H.hashStorePath storePath)-  let scopedArchiveUri    = versionedArchiveUri </> T.pack storePathHash+  let storePath             = opts ^. the @"storePath"+  let archiveUris           = opts ^. the @"archiveUris"+  let threads               = opts ^. the @"threads"+  let awsLogLevel           = opts ^. the @"awsLogLevel"+  let versionedArchiveUris  = archiveUris & each %~ (</> archiveVersion)+  let storePathHash         = opts ^. the @"storePathHash" & fromMaybe (H.hashStorePath storePath)+  let scopedArchiveUris     = versionedArchiveUris & each %~ (</> T.pack storePathHash)    CIO.putStrLn $ "Store path: "       <> toText storePath   CIO.putStrLn $ "Store path hash: "  <> T.pack storePathHash-  CIO.putStrLn $ "Archive URI: "      <> toText archiveUri+  forM_ archiveUris $ \archiveUri -> do+    CIO.putStrLn $ "Archive URI: "      <> toText archiveUri   CIO.putStrLn $ "Archive version: "  <> archiveVersion   CIO.putStrLn $ "Threads: "          <> tshow threads   CIO.putStrLn $ "AWS Log level: "    <> tshow awsLogLevel@@ -127,10 +130,10 @@              IO.forkThreadsWait threads $ DQ.runQueue downloadQueue $ \packageId -> case M.lookup packageId pInfos of               Just pInfo -> do-                let archiveBaseName   = Z.packageDir pInfo <.> ".tar.gz"-                let archiveFile       = versionedArchiveUri </> T.pack archiveBaseName-                let scopedArchiveFile = scopedArchiveUri </> T.pack archiveBaseName-                let packageStorePath  = storePath </> Z.packageDir pInfo+                let archiveBaseName     = Z.packageDir pInfo <.> ".tar.gz"+                let archiveFiles        = versionedArchiveUris & each %~ (</> T.pack archiveBaseName)+                let scopedArchiveFiles  = scopedArchiveUris & each %~ (</> T.pack archiveBaseName)+                let packageStorePath    = storePath </> Z.packageDir pInfo                 storeDirectoryExists <- doesDirectoryExist packageStorePath                 let maybePackage = M.lookup packageId planPackages @@ -145,7 +148,7 @@                     else if storeDirectoryExists                       then return True                       else runResAws envAws $ onError (cleanupStorePath packageStorePath packageId) False $ do-                        (existingArchiveFileContents, existingArchiveFile) <- ExceptT $ IO.readFirstAvailableResource envAws [archiveFile, scopedArchiveFile]+                        (existingArchiveFileContents, existingArchiveFile) <- ExceptT $ IO.readFirstAvailableResource envAws (foldMap L.tuple2ToList (L.zip archiveFiles scopedArchiveFiles))                         CIO.putStrLn $ "Extracting: " <> toText existingArchiveFile                          let tempArchiveFile = tempPath </> archiveBaseName@@ -204,11 +207,12 @@       <> showDefault <> value Oregon       <> help "The AWS region in which to operate"       )-  <*> option (maybeReader (toLocation . T.pack))-      (   long "archive-uri"-      <>  help "Archive URI to sync to"-      <>  metavar "S3_URI"-      <>  value (Local $ homeDirectory </> ".cabal" </> "archive")+  <*> some+      (  option (maybeReader (toLocation . T.pack))+        (   long "archive-uri"+        <>  help "Archive URI to sync to"+        <>  metavar "S3_URI"+        )       )   <*> strOption       (   long "store-path"

@@ -0,0 +1,10 @@+module HaskellWorks.CabalCache.Data.List+  ( tuple2ToDL+  , tuple2ToList+  ) where++tuple2ToDL :: (a, a) -> [a] -> [a]+tuple2ToDL (a, b) = (a:) . (b:)++tuple2ToList :: (a, a) -> [a]+tuple2ToList ab = tuple2ToDL ab []