Add --build-path

haskell · Sep 29, 2020 · dc27ad3 · dc27ad3
1 parent cc03409
commit dc27ad3
Show file tree

Hide file tree

Showing 5 changed files with 28 additions and 10 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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