Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add threads #10

Merged
merged 1 commit into from
Apr 12, 2019
Merged

Add threads #10

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 11 additions & 8 deletions hw-ci-assist.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@ common stringsearch { build-depends: stringsearch >= 0.3.6.6
common tar { build-depends: tar >= 0.5.1.0 && < 0.6 }
common text { build-depends: text >= 1.2.3.1 && < 1.3 }
common time { build-depends: time >= 1.4 && < 1.10 }
common unliftio { build-depends: unliftio >= 0.2.10 && < 0.3 }
common zlib { build-depends: zlib >= 0.6.2 && < 0.7 }

common config
Expand Down Expand Up @@ -80,6 +81,7 @@ library
, tar
, text
, time
, unliftio
, zlib
exposed-modules:
App.Commands
Expand All @@ -102,6 +104,7 @@ executable hw-ci-assist
build-depends: hw-ci-assist
main-is: Main.hs
hs-source-dirs: app
ghc-options: -threaded -rtsopts -with-rtsopts=-N
if os(linux)
ghc-options: -static
cc-options: -static
Expand All @@ -120,11 +123,11 @@ test-suite hw-ci-assist-test
, hw-hspec-hedgehog
, lens
, raw-strings-qq
type: exitcode-stdio-1.0
main-is: Spec.hs
build-depends: hw-ci-assist
other-modules: HaskellWorks.Assist.AwsSpec
HaskellWorks.Assist.QuerySpec
hs-source-dirs: test
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-tools: hspec-discover
type: exitcode-stdio-1.0
main-is: Spec.hs
build-depends: hw-ci-assist
other-modules: HaskellWorks.Assist.AwsSpec
HaskellWorks.Assist.QuerySpec
hs-source-dirs: test
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-tools: hspec-discover
8 changes: 6 additions & 2 deletions src/App/Commands/Options/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,14 @@ import Data.Text (Text)
import GHC.Generics
import GHC.Word (Word8)

newtype SyncToArchiveOptions = SyncToArchiveOptions
data SyncToArchiveOptions = SyncToArchiveOptions
{ archiveUri :: Text
, storePath :: Text
, threads :: Int
} deriving (Eq, Show, Generic)

newtype SyncFromArchiveOptions = SyncFromArchiveOptions
data SyncFromArchiveOptions = SyncFromArchiveOptions
{ archiveUri :: Text
, storePath :: Text
, threads :: Int
} deriving (Eq, Show, Generic)
32 changes: 23 additions & 9 deletions src/App/Commands/SyncFromArchive.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ import qualified System.Directory as IO
import qualified System.Exit as IO
import qualified System.IO as IO
import qualified System.Process as IO
import qualified UnliftIO.Async as IO

{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
{-# ANN module ("HLint: ignore Redundant do" :: String) #-}
Expand Down Expand Up @@ -63,7 +64,7 @@ runSyncFromArchive opts = do
Right (planJson :: Z.PlanJson) -> do
env <- mkEnv Oregon logger
let archivePath = archiveUri <> "/" <> (planJson ^. the @"compilerId")
let baseDir = homeDirectory <> "/.cabal/store"
let baseDir = opts ^. the @"storePath"
let storeCompilerPath = baseDir <> "/" <> (planJson ^. the @"compilerId")
let storeCompilerPackageDbPath = storeCompilerPath <> "/package.db"
let storeCompilerLibPath = storeCompilerPath <> "/lib"
Expand All @@ -75,7 +76,7 @@ runSyncFromArchive opts = do

packages <- getPackages baseDir planJson

forM_ packages $ \pInfo -> do
IO.pooledForConcurrentlyN_ (opts ^. the @"threads") packages $ \pInfo -> do
let archiveFile = archiveUri <> "/" <> packageDir pInfo <> ".tar.gz"
let packageStorePath = baseDir <> "/" <> packageDir pInfo
storeDirectoryExists <- IO.doesDirectoryExist (T.unpack packageStorePath)
Expand All @@ -94,13 +95,14 @@ runSyncFromArchive opts = do
liftIO $ F.unpack (T.unpack baseDir) entries'
Nothing -> do
liftIO $ T.putStrLn $ "Archive unavilable: " <> archiveFile
hGhcPkg2 <- IO.spawnProcess "ghc-pkg" ["recache", "--package-db", T.unpack storeCompilerPackageDbPath]
exitCodeGhcPkg2 <- IO.waitForProcess hGhcPkg2
case exitCodeGhcPkg2 of
IO.ExitFailure _ -> do
IO.hPutStrLn IO.stderr "ERROR: Unable to recache package db"
IO.exitWith (IO.ExitFailure 1)
_ -> return ()
IO.putStrLn "Recaching package database"
hGhcPkg2 <- IO.spawnProcess "ghc-pkg" ["recache", "--package-db", T.unpack storeCompilerPackageDbPath]
exitCodeGhcPkg2 <- IO.waitForProcess hGhcPkg2
case exitCodeGhcPkg2 of
IO.ExitFailure _ -> do
IO.hPutStrLn IO.stderr "ERROR: Unable to recache package db"
IO.exitWith (IO.ExitFailure 1)
_ -> return ()

Left errorMessage -> do
IO.putStrLn $ "ERROR: Unable to parse plan.json file: " <> errorMessage
Expand All @@ -115,6 +117,18 @@ optsSyncFromArchive = Z.SyncFromArchiveOptions
<> metavar "S3_URI"
<> value (homeDirectory <> "/.cabal/archive")
)
<*> strOption
( long "store-path"
<> help "Path to cabal store"
<> metavar "DIRECTORY"
<> value (homeDirectory <> "/.cabal/store")
)
<*> option auto
( long "threads"
<> help "Number of concurrent threads"
<> metavar "NUM_THREADS"
<> value 4
)

cmdSyncFromArchive :: Mod CommandFields (IO ())
cmdSyncFromArchive = command "sync-from-archive" $ flip info idm $ runSyncFromArchive <$> optsSyncFromArchive
17 changes: 15 additions & 2 deletions src/App/Commands/SyncToArchive.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,7 @@ import qualified HaskellWorks.Ci.Assist.IO.Lazy as IO
import qualified HaskellWorks.Ci.Assist.Types as Z
import qualified System.Directory as IO
import qualified System.IO as IO
import qualified UnliftIO.Async as IO

{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
{-# ANN module ("HLint: ignore Redundant do" :: String) #-}
Expand All @@ -50,10 +51,10 @@ runSyncToArchive opts = do
envAws <- mkEnv Oregon logger
let archivePath = homeDirectory <> "/.cabal/archive/" <> (planJson ^. the @"compilerId")
IO.createDirectoryIfMissing True (T.unpack archivePath)
let baseDir = homeDirectory <> "/.cabal/store"
let baseDir = opts ^. the @"storePath"
packages <- getPackages baseDir planJson

forM_ packages $ \pInfo -> do
IO.pooledForConcurrentlyN_ (opts ^. the @"threads") packages $ \pInfo -> do
let archiveFile = archiveUri <> "/" <> packageDir pInfo <> ".tar.gz"
let packageStorePath = baseDir <> "/" <> packageDir pInfo
packageStorePathExists <- IO.doesDirectoryExist (T.unpack packageStorePath)
Expand Down Expand Up @@ -81,6 +82,18 @@ optsSyncToArchive = Z.SyncToArchiveOptions
<> metavar "S3_URI"
<> value (homeDirectory <> "/.cabal/archive")
)
<*> strOption
( long "store-path"
<> help "Path to cabal store"
<> metavar "DIRECTORY"
<> value (homeDirectory <> "/.cabal/store")
)
<*> option auto
( long "threads"
<> help "Number of concurrent threads"
<> metavar "NUM_THREADS"
<> value 4
)

cmdSyncToArchive :: Mod CommandFields (IO ())
cmdSyncToArchive = command "sync-to-archive" $ flip info idm $ runSyncToArchive <$> optsSyncToArchive