haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-02-04 10:30:25 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Fix some directories to be more logical

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Stackage2/CompleteBuild.hs
View File

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

13
Stackage2/PerformBuild.hs
View File

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