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

Warnings cleanup

Browse Source
This commit is contained in:
Michael Snoyman 2014-12-16 09:24:48 +02:00
parent 771e1967de
commit 29ebe5d88b
4 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Stackage/BuildConstraints.hs
View File

@ -20,7 +20,6 @@ import Distribution.Package (Dependency (..))
import Distribution.System (Arch, OS) import Distribution.System (Arch, OS)
import qualified Distribution.System import qualified Distribution.System
import Distribution.Version (anyVersion) import Distribution.Version (anyVersion)
import Distribution.Version (anyVersion)
import Filesystem (isFile) import Filesystem (isFile)
import Network.HTTP.Client (Manager, httpLbs, responseBody) import Network.HTTP.Client (Manager, httpLbs, responseBody)
import Stackage.CorePackages import Stackage.CorePackages
@ -144,8 +143,6 @@ getSystemInfo = do
siOS = Distribution.System.Linux siOS = Distribution.System.Linux
siArch = Distribution.System.X86_64 siArch = Distribution.System.X86_64
loadBuildConstraints fp = decodeFileEither fp >>= either throwIO toBC
data ConstraintFile = ConstraintFile data ConstraintFile = ConstraintFile
{ cfGlobalFlags :: Map FlagName Bool { cfGlobalFlags :: Map FlagName Bool
, cfPackageFlags :: Map PackageName (Map FlagName Bool) , cfPackageFlags :: Map PackageName (Map FlagName Bool)

14
Stackage/PerformBuild.hs
View File

@ -103,15 +103,21 @@ waitForDeps toolMap packageMap activeComps bp pi action = do
isCore = (`member` siCorePackages (bpSystemInfo bp)) isCore = (`member` siCorePackages (bpSystemInfo bp))
isCoreExe = (`member` siCoreExecutables (bpSystemInfo bp)) isCoreExe = (`member` siCoreExecutables (bpSystemInfo bp))
withCounter :: TVar Int -> IO a -> IO a
withCounter counter = bracket_ withCounter counter = bracket_
(atomically $ modifyTVar counter (+ 1)) (atomically $ modifyTVar counter (+ 1))
(atomically $ modifyTVar counter (subtract 1)) (atomically $ modifyTVar counter (subtract 1))
withTSem :: TSem -> IO a -> IO a
withTSem sem = bracket_ (atomically $ waitTSem sem) (atomically $ signalTSem sem) withTSem sem = bracket_ (atomically $ waitTSem sem) (atomically $ signalTSem sem)
-- | Returns @Nothing@ if installing to a global database
pbDatabase :: PerformBuild -> Maybe FilePath
pbDatabase pb pbDatabase pb
| pbGlobalInstall pb = Nothing | pbGlobalInstall pb = Nothing
| otherwise = Just $ pbInstallDest pb </> "pkgdb" | otherwise = Just $ pbInstallDest pb </> "pkgdb"
pbBinDir, pbLibDir, pbDataDir, pbDocDir :: PerformBuild -> FilePath
pbBinDir pb = pbInstallDest pb </> "bin" pbBinDir pb = pbInstallDest pb </> "bin"
pbLibDir pb = pbInstallDest pb </> "lib" pbLibDir pb = pbInstallDest pb </> "lib"
pbDataDir pb = pbInstallDest pb </> "share" pbDataDir pb = pbInstallDest pb </> "share"
@ -260,9 +266,9 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
testOut = pbLogDir </> fpFromText namever </> "test.out" testOut = pbLogDir </> fpFromText namever </> "test.out"
testRunOut = pbLogDir </> fpFromText namever </> "test-run.out" testRunOut = pbLogDir </> fpFromText namever </> "test-run.out"
wf fp inner = do wf fp inner' = do
createTree $ parent fp createTree $ parent fp
withBinaryFile (fpToString fp) WriteMode inner withBinaryFile (fpToString fp) WriteMode inner'
configArgs = ($ []) $ execWriter $ do configArgs = ($ []) $ execWriter $ do
tell' "--package-db=clear" tell' "--package-db=clear"
@ -279,9 +285,9 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
flags :: Text flags :: Text
flags = unwords $ map go $ mapToList pcFlagOverrides flags = unwords $ map go $ mapToList pcFlagOverrides
where where
go (name, isOn) = concat go (name', isOn) = concat
[ if isOn then "" else "-" [ if isOn then "" else "-"
, unFlagName name , unFlagName name'
] ]
PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo

1
Stackage/Prelude.hs
View File

@ -20,7 +20,6 @@ import Distribution.Version as X (Version (..),
VersionRange) VersionRange)
import Distribution.Version as X (withinRange) import Distribution.Version as X (withinRange)
import qualified Distribution.Version as C import qualified Distribution.Version as C
import System.Exit (ExitCode (ExitSuccess))
unPackageName :: PackageName -> Text unPackageName :: PackageName -> Text
unPackageName (PackageName str) = pack str unPackageName (PackageName str) = pack str

2
Stackage/Upload.hs
View File

@ -90,6 +90,7 @@ data UploadDocs = UploadDocs
, udSnapshot :: SnapshotIdent , udSnapshot :: SnapshotIdent
} }
uploadDocs :: UploadDocs -> Manager -> IO (Response LByteString)
uploadDocs (UploadDocs (StackageServer host) fp0 token ident) man = do uploadDocs (UploadDocs (StackageServer host) fp0 token ident) man = do
fe <- isFile fp0 fe <- isFile fp0
if fe if fe
@ -179,6 +180,7 @@ data UploadDocMap = UploadDocMap
, udmPlan :: BuildPlan , udmPlan :: BuildPlan
} }
uploadDocMap :: UploadDocMap -> Manager -> IO (Response LByteString)
uploadDocMap UploadDocMap {..} man = do uploadDocMap UploadDocMap {..} man = do
docmap <- docsListing udmPlan udmDocDir docmap <- docsListing udmPlan udmDocDir
req1 <- parseUrl $ unpack $ unStackageServer udmServer ++ "/upload-doc-map" req1 <- parseUrl $ unpack $ unStackageServer udmServer ++ "/upload-doc-map"