cabal-cache 1.0.2.1 → 1.0.3.0

raw patch · 11 files changed

+136/−16 lines, 11 filesdep ~aesondep ~bytestringdep ~generic-lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, bytestring, generic-lens, http-client, lens, selective

API changes (from Hackage documentation)

Files

• cabal-cache.cabal +3/−2
• src/App/Commands.hs +4/−0
• src/App/Commands/Options/Parser.hs +0/−2
• src/App/Commands/Options/Types.hs +7/−0
• src/App/Commands/Plan.hs +107/−0
• src/App/Commands/SyncFromArchive.hs +6/−4
• src/App/Commands/SyncToArchive.hs +4/−3
• src/App/Static/Base.hs +2/−2
• src/HaskellWorks/CabalCache/Core.hs +3/−1
• test/HaskellWorks/CabalCache/AwsSpec.hs +0/−1
• test/HaskellWorks/CabalCache/QuerySpec.hs +0/−1

@@ -1,7 +1,7 @@ cabal-version:          2.2  name:                   cabal-cache-version:                1.0.2.1+version:                1.0.3.0 synopsis:               CI Assistant for Haskell projects description:            CI Assistant for Haskell projects.  Implements package caching. homepage:               https://github.com/haskell-works/cabal-cache@@ -9,7 +9,7 @@ license-file:           LICENSE author:                 John Ky maintainer:             newhoggy@gmail.com-copyright:              John Ky 2019+copyright:              John Ky 2019-2020 category:               Development extra-source-files:     CHANGELOG.md, README.md @@ -106,6 +106,7 @@       App.Commands       App.Commands.Options.Parser       App.Commands.Options.Types+      App.Commands.Plan       App.Commands.SyncFromArchive       App.Commands.SyncToArchive       App.Commands.Version

@@ -1,16 +1,20 @@ module App.Commands where  import App.Commands.SyncFromArchive+import App.Commands.Plan import App.Commands.SyncToArchive import App.Commands.Version import Options.Applicative +{- HLINT ignore "Monoid law, left identity" -}+ commands :: Parser (IO ()) commands = commandsGeneral  commandsGeneral :: Parser (IO ()) commandsGeneral = subparser $ mempty   <>  commandGroup "Commands:"+  <>  cmdPlan   <>  cmdSyncFromArchive   <>  cmdSyncToArchive   <>  cmdVersion

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- module App.Commands.Options.Parser where  import Antiope.Core               (FromText, fromText)

@@ -19,6 +19,13 @@   , awsLogLevel   :: Maybe AWS.LogLevel   } deriving (Eq, Show, Generic) +data PlanOptions = PlanOptions+  { buildPath     :: FilePath+  , storePath     :: FilePath+  , storePathHash :: Maybe String+  , outputFile    :: FilePath+  } deriving (Eq, Show, Generic)+ data SyncFromArchiveOptions = SyncFromArchiveOptions   { region        :: Region   , archiveUris   :: [Location]

@@ -0,0 +1,107 @@+{-# LANGUAGE BlockArguments      #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++module App.Commands.Plan+  ( cmdPlan+  ) where++import Antiope.Core                     (toText)+import App.Commands.Options.Types       (PlanOptions (PlanOptions))+import Control.Applicative+import Control.Lens                     hiding ((<.>))+import Control.Monad.Except+import Data.Generics.Product.Any        (the)+import Data.Maybe+import HaskellWorks.CabalCache.AppError+import HaskellWorks.CabalCache.Location (Location (..), (<.>), (</>))+import HaskellWorks.CabalCache.Show+import HaskellWorks.CabalCache.Version  (archiveVersion)+import Options.Applicative              hiding (columns)++import qualified App.Commands.Options.Types         as Z+import qualified App.Static                         as AS+import qualified Control.Concurrent.STM             as STM+import qualified Data.ByteString.Lazy               as LBS+import qualified Data.Text                          as T+import qualified HaskellWorks.CabalCache.Core       as Z+import qualified HaskellWorks.CabalCache.Hash       as H+import qualified HaskellWorks.CabalCache.IO.Console as CIO+import qualified System.IO                          as IO+import qualified Data.Aeson as J++{- HLINT ignore "Monoid law, left identity" -}+{- HLINT ignore "Redundant do"              -}+{- HLINT ignore "Reduce duplication"        -}++runPlan :: Z.PlanOptions -> IO ()+runPlan opts = do+  let storePath             = opts ^. the @"storePath"+  let archiveUris           = [Local ""]+  let storePathHash         = opts ^. the @"storePathHash" & fromMaybe (H.hashStorePath storePath)+  let versionedArchiveUris  = archiveUris & each %~ (</> archiveVersion)+  let outputFile            = opts ^. the @"outputFile"++  CIO.putStrLn $ "Store path: "       <> toText storePath+  CIO.putStrLn $ "Store path hash: "  <> T.pack storePathHash+  CIO.putStrLn $ "Archive URIs: "     <> tshow archiveUris+  CIO.putStrLn $ "Archive version: "  <> archiveVersion++  tEarlyExit <- STM.newTVarIO False++  mbPlan <- Z.loadPlan $ opts ^. the @"buildPath"++  case mbPlan of+    Right planJson -> do+      packages <- Z.getPackages storePath planJson++      plan <- forM packages $ \pInfo -> do+        let archiveFileBasename = Z.packageDir pInfo <.> ".tar.gz"+        let archiveFiles         = versionedArchiveUris <&> (</> T.pack archiveFileBasename)+        let scopedArchiveFiles   = versionedArchiveUris <&> (</> T.pack storePathHash </> T.pack archiveFileBasename)++        return $ archiveFiles <> scopedArchiveFiles++      if outputFile == "-"+        then LBS.putStr $ J.encode (fmap (fmap toText) plan)+        else LBS.writeFile outputFile $ J.encode (fmap (fmap toText) plan)++    Left (appError :: AppError) -> do+      CIO.hPutStrLn IO.stderr $ "ERROR: Unable to parse plan.json file: " <> displayAppError appError++  earlyExit <- STM.readTVarIO tEarlyExit++  when earlyExit $ CIO.hPutStrLn IO.stderr "Early exit due to error"++optsPlan :: Parser PlanOptions+optsPlan = PlanOptions+  <$> strOption+      (   long "build-path"+      <>  help ("Path to cabal build directory.  Defaults to " <> show AS.buildPath)+      <>  metavar "DIRECTORY"+      <>  value AS.buildPath+      )+  <*> strOption+      (   long "store-path"+      <>  help "Path to cabal store"+      <>  metavar "DIRECTORY"+      <>  value (AS.cabalDirectory </> "store")+      )+  <*> optional+      ( strOption+        (   long "store-path-hash"+        <>  help "Store path hash (do not use)"+        <>  metavar "HASH"+        )+      )+  <*> strOption+      (   long "output-file"+      <>  help "Output file"+      <>  metavar "FILE"+      <>  value "-"+      )++cmdPlan :: Mod CommandFields (IO ())+cmdPlan = command "plan"  $ flip info idm $ runPlan <$> optsPlan

@@ -55,11 +55,12 @@ import qualified System.IO.Temp                                   as IO import qualified System.IO.Unsafe                                 as IO -{- HLINT ignore "Redundant do"        -}-{- HLINT ignore "Reduce duplication"  -}+{- HLINT ignore "Monoid law, left identity" -}+{- HLINT ignore "Reduce duplication"        -}+{- HLINT ignore "Redundant do"              -}  skippable :: Z.Package -> Bool-skippable package = (package ^. the @"packageType" == "pre-existing")+skippable package = package ^. the @"packageType" == "pre-existing"  runSyncFromArchive :: Z.SyncFromArchiveOptions -> IO () runSyncFromArchive opts = do@@ -131,8 +132,9 @@                 let archiveFiles        = versionedArchiveUris & each %~ (</> T.pack archiveBaseName)                 let scopedArchiveFiles  = scopedArchiveUris & each %~ (</> T.pack archiveBaseName)                 let packageStorePath    = storePath </> Z.packageDir pInfo+                let maybePackage        = M.lookup packageId planPackages+                 storeDirectoryExists <- doesDirectoryExist packageStorePath-                let maybePackage = M.lookup packageId planPackages                  case maybePackage of                   Nothing -> do

@@ -53,8 +53,9 @@ import qualified System.IO.Unsafe                   as IO import qualified UnliftIO.Async                     as IO -{- HLINT ignore "Redundant do"        -}-{- HLINT ignore "Reduce duplication"  -}+{- HLINT ignore "Monoid law, left identity" -}+{- HLINT ignore "Redundant do"              -}+{- HLINT ignore "Reduce duplication"        -}  runSyncToArchive :: Z.SyncToArchiveOptions -> IO () runSyncToArchive opts = do@@ -153,7 +154,7 @@    earlyExit <- STM.readTVarIO tEarlyExit -  when earlyExit $ CIO.hPutStrLn IO.stderr $ "Early exit due to error"+  when earlyExit $ CIO.hPutStrLn IO.stderr "Early exit due to error"  isShareable :: MonadIO m => FilePath -> Z.PackageInfo -> m Bool isShareable storePath pkg =

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

@@ -41,6 +41,8 @@ import qualified System.Directory               as IO import qualified System.Process                 as IO +{- HLINT ignore "Monoid law, left identity" -}+ type PackageDir = FilePath type ConfPath   = FilePath type Library    = FilePath@@ -104,7 +106,7 @@         packages = planJson ^. the @"installPlan"  loadPlan :: FilePath -> IO (Either AppError Z.PlanJson)-loadPlan buildPath = (first fromString . eitherDecode) <$> LBS.readFile (buildPath </> "cache" </> "plan.json")+loadPlan buildPath = first fromString . eitherDecode <$> LBS.readFile (buildPath </> "cache" </> "plan.json")  ------------------------------------------------------------------------------- mkPackageInfo :: FilePath -> Z.CompilerId -> Z.Package -> IO PackageInfo

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds         #-} {-# LANGUAGE OverloadedStrings #-}  module HaskellWorks.CabalCache.AwsSpec

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds             #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE QuasiQuotes           #-}