Fix some directories to be more logical

This commit is contained in:
Michael Snoyman 2014-12-12 14:05:03 +02:00
parent b804e37845
commit c6f62c5f8e
2 changed files with 17 additions and 5 deletions

View File

@ -32,6 +32,7 @@ data Settings = Settings
{ plan :: BuildPlan
, planFile :: FilePath
, buildDir :: FilePath
, logDir :: FilePath
, title :: Text -> Text -- ^ GHC version -> title
, slug :: Text
, setArgs :: Text -> UploadBundle -> UploadBundle
@ -45,7 +46,8 @@ getSettings Nightly = do
plan' <- defaultBuildConstraints >>= newBuildPlan
return Settings
{ planFile = fpFromText ("nightly-" ++ day) <.> "yaml"
, buildDir = fpFromText $ "/tmp/stackage-nightly-" ++ day
, buildDir = fpFromText $ "builds/stackage-nightly-" ++ day
, logDir = fpFromText $ "logs/stackage-nightly-" ++ day
, title = \ghcVer -> concat
[ "Stackage Nightly "
, day
@ -82,7 +84,8 @@ getSettings (LTS bumpType) = do
return Settings
{ planFile = newfile
, buildDir = fpFromText $ "/tmp/stackage-lts-" ++ tshow new
, buildDir = fpFromText $ "builds/stackage-lts-" ++ tshow new
, logDir = fpFromText $ "logs/stackage-lts-" ++ tshow new
, title = \ghcVer -> concat
[ "LTS Haskell "
, tshow new
@ -142,7 +145,7 @@ completeBuild buildType = withManager defaultManagerSettings $ \man -> do
let pb = PerformBuild
{ pbPlan = plan
, pbInstallDest = buildDir
, pbLogDir = buildDir </> "logs"
, pbLogDir = logDir
, pbLog = hPut stdout
, pbJobs = 8
}

View File

@ -21,7 +21,7 @@ import Control.Concurrent.STM.TSem
import Data.NonNull (fromNullable)
import Control.Concurrent.Async (async)
import System.IO.Temp (withSystemTempDirectory)
import Filesystem (createTree, removeTree, isDirectory, rename, canonicalizePath)
import Filesystem (createTree, removeTree, isDirectory, rename, canonicalizePath, getWorkingDirectory)
import System.IO (withBinaryFile, IOMode (WriteMode))
import Filesystem.Path (parent)
import qualified Filesystem.Path as F
@ -113,10 +113,19 @@ pbDataDir pb = pbInstallDest pb </> "share"
pbDocDir pb = pbInstallDest pb </> "doc"
performBuild :: PerformBuild -> IO [Text]
performBuild pb@PerformBuild {..} = withBuildDir $ \builddir -> do
performBuild pb = do
cwd <- getWorkingDirectory
performBuild' pb
{ pbInstallDest = cwd </> pbInstallDest pb
, pbLogDir = cwd </> pbLogDir pb
}
performBuild' :: PerformBuild -> IO [Text]
performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do
let removeTree' fp = whenM (isDirectory fp) (removeTree fp)
mapM_ removeTree' [pbInstallDest, pbLogDir]
createTree $ parent $ pbDatabase pb
withCheckedProcess (proc "ghc-pkg" ["init", fpToString (pbDatabase pb)])
$ \ClosedStream Inherited Inherited -> return ()
pbLog $ encodeUtf8 "Copying built-in Haddocks\n"