From dc27ad317397716dbcfd1af3e0411f987c1cd58f Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 29 Sep 2020 16:26:43 +1000 Subject: [PATCH] Add --build-path --- src/App/Commands/Options/Types.hs | 2 ++ src/App/Commands/SyncFromArchive.hs | 14 ++++++++++---- src/App/Commands/SyncToArchive.hs | 15 +++++++++++---- src/App/Static.hs | 3 +++ src/HaskellWorks/CabalCache/Core.hs | 4 ++-- 5 files changed, 28 insertions(+), 10 deletions(-) diff --git a/src/App/Commands/Options/Types.hs b/src/App/Commands/Options/Types.hs index 8a650378..7458d61d 100644 --- a/src/App/Commands/Options/Types.hs +++ b/src/App/Commands/Options/Types.hs @@ -12,6 +12,7 @@ import qualified Antiope.Env as AWS data SyncToArchiveOptions = SyncToArchiveOptions { region :: Region , archiveUri :: Location + , buildPath :: FilePath , storePath :: FilePath , storePathHash :: Maybe String , threads :: Int @@ -21,6 +22,7 @@ data SyncToArchiveOptions = SyncToArchiveOptions data SyncFromArchiveOptions = SyncFromArchiveOptions { region :: Region , archiveUris :: [Location] + , buildPath :: FilePath , storePath :: FilePath , storePathHash :: Maybe String , threads :: Int diff --git a/src/App/Commands/SyncFromArchive.hs b/src/App/Commands/SyncFromArchive.hs index 1f250b2c..53402e8d 100644 --- a/src/App/Commands/SyncFromArchive.hs +++ b/src/App/Commands/SyncFromArchive.hs @@ -13,7 +13,6 @@ import Antiope.Env (mkEnv) import Antiope.Options.Applicative import App.Commands.Options.Parser (text) import App.Commands.Options.Types (SyncFromArchiveOptions (SyncFromArchiveOptions)) -import App.Static (cabalDirectory) import Control.Applicative import Control.Lens hiding ((<.>)) import Control.Monad (unless, void, when) @@ -34,6 +33,7 @@ import Options.Applicative hiding (columns) import System.Directory (createDirectoryIfMissing, doesDirectoryExist) 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.Char8 as C8 import qualified Data.ByteString.Lazy as LBS @@ -81,7 +81,7 @@ runSyncFromArchive opts = do CIO.putStrLn $ "Threads: " <> tshow threads CIO.putStrLn $ "AWS Log level: " <> tshow awsLogLevel - mbPlan <- Z.loadPlan + mbPlan <- Z.loadPlan $ opts ^. the @"buildPath" case mbPlan of Right planJson -> do @@ -213,11 +213,17 @@ optsSyncFromArchive = SyncFromArchiveOptions <> metavar "S3_URI" ) ) + <*> 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" + <> help ("Path to cabal store. Defaults to " <> show AS.cabalDirectory) <> metavar "DIRECTORY" - <> value (cabalDirectory "store") + <> value (AS.cabalDirectory "store") ) <*> optional ( strOption diff --git a/src/App/Commands/SyncToArchive.hs b/src/App/Commands/SyncToArchive.hs index 3e5def21..00bd3e6a 100644 --- a/src/App/Commands/SyncToArchive.hs +++ b/src/App/Commands/SyncToArchive.hs @@ -14,7 +14,6 @@ import Antiope.Env (mkEnv) import Antiope.Options.Applicative import App.Commands.Options.Parser (text) import App.Commands.Options.Types (SyncToArchiveOptions (SyncToArchiveOptions)) -import App.Static (cabalDirectory) import Control.Applicative import Control.Lens hiding ((<.>)) import Control.Monad (filterM, unless, when) @@ -33,6 +32,7 @@ import Options.Applicative hiding (columns) import System.Directory (doesDirectoryExist) 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.ByteString.Lazy.Char8 as LC8 @@ -76,7 +76,8 @@ runSyncToArchive opts = do tEarlyExit <- STM.newTVarIO False - mbPlan <- Z.loadPlan + mbPlan <- Z.loadPlan $ opts ^. the @"buildPath" + case mbPlan of Right planJson -> do compilerContextResult <- runExceptT $ Z.mkCompilerContext planJson @@ -172,13 +173,19 @@ optsSyncToArchive = SyncToArchiveOptions ( long "archive-uri" <> help "Archive URI to sync to" <> metavar "S3_URI" - <> value (Local $ cabalDirectory "archive") + <> value (Local $ AS.cabalDirectory "archive") + ) + <*> 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 (cabalDirectory "store") + <> value (AS.cabalDirectory "store") ) <*> optional ( strOption diff --git a/src/App/Static.hs b/src/App/Static.hs index 201d7429..35f936f3 100644 --- a/src/App/Static.hs +++ b/src/App/Static.hs @@ -6,3 +6,6 @@ import qualified App.Static.Windows as W cabalDirectory :: FilePath cabalDirectory = if S.isPosix then P.cabalDirectory else W.cabalDirectory + +buildPath :: FilePath +buildPath = "dist-newstyle" diff --git a/src/HaskellWorks/CabalCache/Core.hs b/src/HaskellWorks/CabalCache/Core.hs index db351bfd..6cc79a45 100644 --- a/src/HaskellWorks/CabalCache/Core.hs +++ b/src/HaskellWorks/CabalCache/Core.hs @@ -104,8 +104,8 @@ getPackages basePath planJson = forM packages (mkPackageInfo basePath compilerId packages :: [Z.Package] packages = planJson ^. the @"installPlan" -loadPlan :: IO (Either AppError Z.PlanJson) -loadPlan = (first fromString . eitherDecode) <$> LBS.readFile ("dist-newstyle" "cache" "plan.json") +loadPlan :: FilePath -> IO (Either AppError Z.PlanJson) +loadPlan buildPath = (first fromString . eitherDecode) <$> LBS.readFile (buildPath "cache" "plan.json") ------------------------------------------------------------------------------- mkPackageInfo :: FilePath -> Z.CompilerId -> Z.Package -> IO PackageInfo