git.iko.soy/stackage
on b6b1d14 help sign in
stackage/Stackage/Util.hs
123 lines 4.7 kB history raw
1{-# LANGUAGE CPP #-}
2module Stackage.Util where
4import qualified Codec.Archive.Tar as Tar
5import qualified Codec.Archive.Tar.Entry as TarEntry
6import Control.Monad (guard, when)
7import Data.List (stripPrefix)
8import qualified Data.Map as Map
9import qualified Data.Set as Set
10import Data.Version (showVersion)
11import Distribution.Text (simpleParse, display)
12import Distribution.Version (thisVersion)
13import Stackage.Types
14import System.Directory (doesDirectoryExist,
15 removeDirectoryRecursive)
16import System.Directory (getAppUserDataDirectory)
17import System.Environment (getEnvironment)
18import System.FilePath ((</>))
19import qualified Distribution.Package as P
20import qualified Distribution.PackageDescription as PD
21import Distribution.License (License (..))
23-- | Allow only packages with permissive licenses.
24allowPermissive :: [String] -- ^ list of explicitly allowed packages
25 -> PD.GenericPackageDescription
26 -> Either String ()
27allowPermissive allowed gpd
28 | P.pkgName (PD.package $ PD.packageDescription gpd) `elem` map PackageName allowed = Right ()
29 | otherwise =
30 case PD.license $ PD.packageDescription gpd of
31 BSD3 -> Right ()
32 MIT -> Right ()
33 PublicDomain -> Right ()
34 l -> Left $ "Non-permissive license: " ++ display l
36identsToRanges :: Set PackageIdentifier -> Map PackageName (VersionRange, Maintainer)
37identsToRanges =
38 Map.unions . map go . Set.toList
39 where
40 go (PackageIdentifier package version) = Map.singleton package (thisVersion version, Maintainer "Haskell Platform")
42packageVersionString :: (PackageName, Version) -> String
43packageVersionString (PackageName p, v) = concat [p, "-", showVersion v]
45rm_r :: FilePath -> IO ()
46rm_r fp = do
47 exists <- doesDirectoryExist fp
48 when exists $ removeDirectoryRecursive fp
50getCabalRoot :: IO FilePath
51getCabalRoot = getAppUserDataDirectory "cabal"
53-- | Name of the 00-index.tar downloaded from Hackage.
54getTarballName :: IO FilePath
55getTarballName = do
56 c <- getCabalRoot
57 return $ c </> "packages" </> "hackage.haskell.org" </> "00-index.tar"
59stableRepoName, extraRepoName :: String
60stableRepoName = "stackage"
61extraRepoName = "stackage-extra"
63-- | Locations for the stackage and stackage-extra tarballs
64getStackageTarballNames :: IO (FilePath, FilePath)
65getStackageTarballNames = do
66 c <- getCabalRoot
67 let f x = c </> "packages" </> x </> "00-index.tar"
68 return (f stableRepoName, f extraRepoName)
70getPackageVersion :: Tar.Entry -> Maybe (PackageName, Version)
71getPackageVersion e = do
72 let (package', s1) = break (== '/') fp
73 package = PackageName package'
74 s2 <- stripPrefix "/" s1
75 let (version', s3) = break (== '/') s2
76 version <- simpleParse version'
77 s4 <- stripPrefix "/" s3
78 guard $ s4 == package' ++ ".cabal"
79 Just (package, version)
80 where
81 fp = TarEntry.fromTarPathToPosixPath $ TarEntry.entryTarPath e
83-- | If a package cannot be parsed or is not found, the default value for
84-- whether it has a test suite. We default to @True@ since, worst case
85-- scenario, this just means a little extra time trying to run a suite that's
86-- not there. Defaulting to @False@ would result in silent failures.
87defaultHasTestSuites :: Bool
88defaultHasTestSuites = True
90packageDir, libDir, binDir, dataDir, docDir :: BuildSettings -> FilePath
91packageDir = (</> "package-db") . sandboxRoot
92libDir = (</> "lib") . sandboxRoot
93binDir = (</> "bin") . sandboxRoot
94dataDir = (</> "share") . sandboxRoot
95docDir x = sandboxRoot x </> "share" </> "doc" </> "$pkgid"
97addCabalArgs :: BuildSettings -> [String] -> [String]
98addCabalArgs settings rest
99 = "--package-db=clear"
100 : "--package-db=global"
101 : ("--package-db=" ++ packageDir settings)
102 : ("--libdir=" ++ libDir settings)
103 : ("--bindir=" ++ binDir settings)
104 : ("--datadir=" ++ dataDir settings)
105 : ("--docdir=" ++ docDir settings)
106 : extraArgs settings ++ rest
108-- | Modified environment that adds our sandboxed bin folder to PATH.
109getModifiedEnv :: BuildSettings -> IO [(String, String)]
110getModifiedEnv settings = do
111 fmap (map $ fixEnv $ binDir settings) getEnvironment
112 where
113 fixEnv :: FilePath -> (String, String) -> (String, String)
114 fixEnv bin (p@"PATH", x) = (p, bin ++ pathSep : x)
115 fixEnv _ x = x
117 -- | Separate for the PATH environment variable
118 pathSep :: Char
119#ifdef mingw32_HOST_OS
120 pathSep = ';'
121#else
122 pathSep = ':'
123#endif