module Distribution.Simple.SrcDist (
sdist,
printPackageProblems,
prepareTree,
createArchive,
prepareSnapshotTree,
snapshotPackage,
snapshotVersion,
dateToSnapshotNumber,
) where
import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..), Executable(..), Library(..)
, TestSuite(..), TestSuiteInterface(..) )
import Distribution.PackageDescription.Check
( PackageCheck(..), checkConfiguredPackage, checkPackageFiles )
import Distribution.Package
( PackageIdentifier(pkgVersion), Package(..), packageVersion )
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.Version
( Version(versionBranch) )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, withUTF8FileContents, writeUTF8File
, installOrdinaryFile, installOrdinaryFiles, setFileExecutable
, findFile, findFileWithExtension, matchFileGlob
, withTempDirectory, defaultPackageDesc
, die, warn, notice, setupMessage )
import Distribution.Simple.Setup (SDistFlags(..), fromFlag, flagToMaybe)
import Distribution.Simple.PreProcess (PPSuffixHandler, ppSuffixes, preprocessComponent)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), withComponentsLBI )
import Distribution.Simple.BuildPaths ( autogenModuleName )
import Distribution.Simple.Program ( defaultProgramConfiguration, requireProgram,
rawSystemProgram, tarProgram )
import Distribution.Text
( display )
import Control.Monad(when, unless)
import Data.Char (toLower)
import Data.List (partition, isPrefixOf)
import Data.Maybe (isNothing, catMaybes)
import System.Time (getClockTime, toCalendarTime, CalendarTime(..))
import System.Directory
( doesFileExist, Permissions(executable), getPermissions )
import Distribution.Verbosity (Verbosity)
import System.FilePath
( (</>), (<.>), takeDirectory, dropExtension, isAbsolute )
sdist :: PackageDescription
-> Maybe LocalBuildInfo
-> SDistFlags
-> (FilePath -> FilePath)
-> [PPSuffixHandler]
-> IO ()
sdist pkg mb_lbi flags mkTmpDir pps = do
printPackageProblems :: Verbosity -> PackageDescription -> IO ()printPackageProblems verbosity :: Verbosityverbosity pkg :: PackageDescriptionpkg
when :: Monad m => Bool -> m () -> m ()when (isNothing :: Maybe a -> BoolisNothing mb_lbi :: Maybe LocalBuildInfomb_lbi) ($) :: (a -> b) -> a -> b$
warn :: Verbosity -> String -> IO ()warn verbosity :: Verbosityverbosity "Cannot run preprocessors. Run 'configure' command first."
date <- toCalendarTime :: ClockTime -> IO CalendarTimetoCalendarTime (=<<) :: Monad m => (a -> m b) -> m a -> m b=<< getClockTime :: IO ClockTimegetClockTime
let pkg' | snapshot :: Boolsnapshot = snapshotPackage ::
CalendarTime -> PackageDescription -> PackageDescriptionsnapshotPackage date :: CalendarTimedate pkg :: PackageDescriptionpkg
| otherwise :: Boolotherwise = pkg :: PackageDescriptionpkg
case flagToMaybe :: Flag a -> Maybe aflagToMaybe (sDistDirectory :: SDistFlags -> Flag FilePathsDistDirectory flags :: SDistFlagsflags) of
Just targetDir -> do
generateSourceDir :: FilePath -> PackageDescription -> IO ()generateSourceDir targetDir :: FilePathtargetDir pkg' :: PackageDescriptionpkg'
notice :: Verbosity -> String -> IO ()notice verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "Source directory created: " (++) :: [a] -> [a] -> [a]++ targetDir :: FilePathtargetDir
Nothing -> do
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue tmpTargetDir :: FilePathtmpTargetDir
withTempDirectory ::
Verbosity -> FilePath -> String -> (FilePath -> IO a) -> IO awithTempDirectory verbosity :: Verbosityverbosity tmpTargetDir :: FilePathtmpTargetDir "sdist." ($) :: (a -> b) -> a -> b$ \tmpDir -> do
let targetDir = tmpDir :: FilePathtmpDir (</>) :: FilePath -> FilePath -> FilePath</> tarBallName :: PackageDescription -> StringtarBallName pkg' :: PackageDescriptionpkg'
generateSourceDir :: FilePath -> PackageDescription -> IO ()generateSourceDir targetDir :: FilePathtargetDir pkg' :: PackageDescriptionpkg'
targzFile <- createArchive ::
Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> FilePath
-> IO FilePathcreateArchive verbosity :: Verbosityverbosity pkg' :: PackageDescriptionpkg' mb_lbi :: Maybe LocalBuildInfomb_lbi tmpDir :: FilePathtmpDir targetPref :: FilePathtargetPref
notice :: Verbosity -> String -> IO ()notice verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "Source tarball created: " (++) :: [a] -> [a] -> [a]++ targzFile :: FilePathtargzFile
where
generateSourceDir targetDir pkg' = do
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()setupMessage verbosity :: Verbosityverbosity "Building source dist for" (packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg' :: PackageDescriptionpkg')
prepareTree ::
Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> IO ()prepareTree verbosity :: Verbosityverbosity pkg' :: PackageDescriptionpkg' mb_lbi :: Maybe LocalBuildInfomb_lbi distPref :: FilePathdistPref targetDir :: FilePathtargetDir pps :: [PPSuffixHandler]pps
when :: Monad m => Bool -> m () -> m ()when snapshot :: Boolsnapshot ($) :: (a -> b) -> a -> b$
overwriteSnapshotPackageDesc ::
Verbosity -> PackageDescription -> FilePath -> IO ()overwriteSnapshotPackageDesc verbosity :: Verbosityverbosity pkg' :: PackageDescriptionpkg' targetDir :: FilePathtargetDir
verbosity = fromFlag :: Flag a -> afromFlag (sDistVerbosity :: SDistFlags -> Flag VerbositysDistVerbosity flags :: SDistFlagsflags)
snapshot = fromFlag :: Flag a -> afromFlag (sDistSnapshot :: SDistFlags -> Flag BoolsDistSnapshot flags :: SDistFlagsflags)
distPref = fromFlag :: Flag a -> afromFlag ($) :: (a -> b) -> a -> b$ sDistDistPref :: SDistFlags -> Flag FilePathsDistDistPref flags :: SDistFlagsflags
targetPref = distPref :: FilePathdistPref
tmpTargetDir = mkTmpDir :: FilePath -> FilePathmkTmpDir distPref :: FilePathdistPref
prepareTree :: Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareTree verbosity pkg_descr0 mb_lbi distPref targetDir pps = do
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue targetDir :: FilePathtargetDir
withLib :: (Library -> m ()) -> m ()withLib ($) :: (a -> b) -> a -> b$ \Library { exposedModules = modules, libBuildInfo = libBi } ->
prepareDir ::
Verbosity
-> PackageDescription
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> [ModuleName]
-> BuildInfo
-> IO ()prepareDir verbosity :: Verbosityverbosity pkg_descr :: PackageDescriptionpkg_descr distPref :: FilePathdistPref targetDir :: FilePathtargetDir pps :: [PPSuffixHandler]pps modules :: [ModuleName]modules libBi :: BuildInfolibBi
withExe :: (Executable -> m b) -> m ()withExe ($) :: (a -> b) -> a -> b$ \Executable { modulePath = mainPath, buildInfo = exeBi } -> do
prepareDir ::
Verbosity
-> PackageDescription
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> [ModuleName]
-> BuildInfo
-> IO ()prepareDir verbosity :: Verbosityverbosity pkg_descr :: PackageDescriptionpkg_descr distPref :: FilePathdistPref targetDir :: FilePathtargetDir pps :: [PPSuffixHandler]pps [] :: [a][] exeBi :: BuildInfoexeBi
srcMainFile <- do
ppFile <- findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension (ppSuffixes :: [PPSuffixHandler] -> [String]ppSuffixes pps :: [PPSuffixHandler]pps) (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs exeBi :: BuildInfoexeBi) (dropExtension :: FilePath -> FilePathdropExtension mainPath :: FilePathmainPath)
case ppFile :: Maybe FilePathppFile of
Nothing -> findFile :: [FilePath] -> FilePath -> IO FilePathfindFile (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs exeBi :: BuildInfoexeBi) mainPath :: FilePathmainPath
Just pp -> return :: Monad m => forall a. a -> m areturn pp :: FilePathpp
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()copyFileTo verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir srcMainFile :: FilePathsrcMainFile
withTest :: (TestSuite -> m b) -> m ()withTest ($) :: (a -> b) -> a -> b$ \t -> do
let bi = testBuildInfo :: TestSuite -> BuildInfotestBuildInfo t :: TestSuitet
prep = prepareDir ::
Verbosity
-> PackageDescription
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> [ModuleName]
-> BuildInfo
-> IO ()prepareDir verbosity :: Verbosityverbosity pkg_descr :: PackageDescriptionpkg_descr distPref :: FilePathdistPref targetDir :: FilePathtargetDir pps :: [PPSuffixHandler]pps
case testInterface :: TestSuite -> TestSuiteInterfacetestInterface t :: TestSuitet of
TestSuiteExeV10 _ mainPath -> do
prep :: [ModuleName] -> BuildInfo -> IO ()prep [] :: [a][] bi :: BuildInfobi
srcMainFile <- do
ppFile <- findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension (ppSuffixes :: [PPSuffixHandler] -> [String]ppSuffixes pps :: [PPSuffixHandler]pps)
(hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi)
(dropExtension :: FilePath -> FilePathdropExtension mainPath :: FilePathmainPath)
case ppFile :: Maybe FilePathppFile of
Nothing -> findFile :: [FilePath] -> FilePath -> IO FilePathfindFile (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi) mainPath :: FilePathmainPath
Just pp -> return :: Monad m => forall a. a -> m areturn pp :: FilePathpp
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()copyFileTo verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir srcMainFile :: FilePathsrcMainFile
TestSuiteLibV09 _ m -> do
prep :: [ModuleName] -> BuildInfo -> IO ()prep [m :: ModuleNamem] bi :: BuildInfobi
TestSuiteUnsupported tp -> die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "Unsupported test suite type: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow tp :: TestTypetp
flip :: (a -> b -> c) -> b -> a -> cflip mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ (dataFiles :: PackageDescription -> [FilePath]dataFiles pkg_descr :: PackageDescriptionpkg_descr) ($) :: (a -> b) -> a -> b$ \ filename -> do
files <- matchFileGlob :: FilePath -> IO [FilePath]matchFileGlob (dataDir :: PackageDescription -> FilePathdataDir pkg_descr :: PackageDescriptionpkg_descr (</>) :: FilePath -> FilePath -> FilePath</> filename :: FilePathfilename)
let dir = takeDirectory :: FilePath -> FilePathtakeDirectory (dataDir :: PackageDescription -> FilePathdataDir pkg_descr :: PackageDescriptionpkg_descr (</>) :: FilePath -> FilePath -> FilePath</> filename :: FilePathfilename)
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> dir :: FilePathdir)
sequence_ :: Monad m => [m a] -> m ()sequence_ [ installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile verbosity :: Verbosityverbosity file :: FilePathfile (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> file :: FilePathfile)
| file <- files :: [FilePath]files ]
when :: Monad m => Bool -> m () -> m ()when (not :: Bool -> Boolnot (null :: [a] -> Boolnull (licenseFile :: PackageDescription -> FilePathlicenseFile pkg_descr :: PackageDescriptionpkg_descr))) ($) :: (a -> b) -> a -> b$
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()copyFileTo verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir (licenseFile :: PackageDescription -> FilePathlicenseFile pkg_descr :: PackageDescriptionpkg_descr)
flip :: (a -> b -> c) -> b -> a -> cflip mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ (extraSrcFiles :: PackageDescription -> [FilePath]extraSrcFiles pkg_descr :: PackageDescriptionpkg_descr) ($) :: (a -> b) -> a -> b$ \ fpath -> do
files <- matchFileGlob :: FilePath -> IO [FilePath]matchFileGlob fpath :: FilePathfpath
sequence_ :: Monad m => [m a] -> m ()sequence_
[ do copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()copyFileTo verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir file :: FilePathfile
perms <- getPermissions :: FilePath -> IO PermissionsgetPermissions file :: FilePathfile
when :: Monad m => Bool -> m () -> m ()when (executable :: Permissions -> Boolexecutable perms :: Permissionsperms)
(setFileExecutable :: FilePath -> IO ()setFileExecutable (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> file :: FilePathfile))
| file <- files :: [FilePath]files ]
withLib :: (Library -> m ()) -> m ()withLib ($) :: (a -> b) -> a -> b$ \ l -> do
let lbi = libBuildInfo :: Library -> BuildInfolibBuildInfo l :: Libraryl
relincdirs = "." (:) :: a -> [a] -> [a]: filter :: (a -> Bool) -> [a] -> [a]filter (not :: Bool -> Boolnot(.) :: (b -> c) -> (a -> b) -> a -> c.isAbsolute :: FilePath -> BoolisAbsolute) (includeDirs :: BuildInfo -> [FilePath]includeDirs lbi :: LocalBuildInfolbi)
incs <- mapM :: Monad m => (a -> m b) -> [a] -> m [b]mapM (findInc :: [FilePath] -> [Char] -> IO ([Char], FilePath)findInc relincdirs :: [[Char]]relincdirs) (installIncludes :: BuildInfo -> [FilePath]installIncludes lbi :: LocalBuildInfolbi)
flip :: (a -> b -> c) -> b -> a -> cflip mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ incs :: [([Char], FilePath)]incs ($) :: (a -> b) -> a -> b$ \(_,fpath) ->
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()copyFileTo verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir fpath :: FilePathfpath
case mb_lbi :: Maybe LocalBuildInfomb_lbi of
Just lbi | not :: Bool -> Boolnot (null :: [a] -> Boolnull pps :: [PPSuffixHandler]pps) -> do
let lbi' = lbi :: LocalBuildInfolbi{ buildDir = targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> buildDir :: LocalBuildInfo -> FilePathbuildDir lbi :: LocalBuildInfolbi }
withComponentsLBI ::
LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()withComponentsLBI lbi' :: LocalBuildInfolbi' ($) :: (a -> b) -> a -> b$ \c _ ->
preprocessComponent ::
PackageDescription
-> Component
-> LocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()preprocessComponent pkg_descr :: PackageDescriptionpkg_descr c :: Componentc lbi' :: LocalBuildInfolbi' True :: BoolTrue verbosity :: Verbosityverbosity pps :: [PPSuffixHandler]pps
_ -> return :: Monad m => forall a. a -> m areturn ()
hsExists <- doesFileExist :: FilePath -> IO BooldoesFileExist "Setup.hs"
lhsExists <- doesFileExist :: FilePath -> IO BooldoesFileExist "Setup.lhs"
if hsExists :: BoolhsExists then copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()copyFileTo verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir "Setup.hs"
else if lhsExists :: BoollhsExists then copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()copyFileTo verbosity :: Verbosityverbosity targetDir :: FilePathtargetDir "Setup.lhs"
else writeUTF8File :: FilePath -> String -> IO ()writeUTF8File (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> "Setup.hs") ($) :: (a -> b) -> a -> b$ unlines :: [String] -> Stringunlines [
"import Distribution.Simple",
"main = defaultMain"]
descFile <- defaultPackageDesc :: Verbosity -> IO FilePathdefaultPackageDesc verbosity :: Verbosityverbosity
installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile verbosity :: Verbosityverbosity descFile :: FilePathdescFile (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> descFile :: FilePathdescFile)
where
pkg_descr = mapAllBuildInfo ::
(BuildInfo -> BuildInfo)
-> PackageDescription
-> PackageDescriptionmapAllBuildInfo filterAutogenModule :: BuildInfo -> BuildInfofilterAutogenModule pkg_descr0 :: PackageDescriptionpkg_descr0
filterAutogenModule bi = bi :: BuildInfobi {
otherModules = filter :: (a -> Bool) -> [a] -> [a]filter ((/=) :: Eq a => a -> a -> Bool/=autogenModule :: ModuleNameautogenModule) (otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi)
}
autogenModule = autogenModuleName :: PackageDescription -> ModuleNameautogenModuleName pkg_descr0 :: PackageDescriptionpkg_descr0
findInc [] f = die :: String -> IO adie ("can't find include file " (++) :: [a] -> [a] -> [a]++ f :: [Char]f)
findInc (d:ds) f = do
let path = (d :: FilePathd (</>) :: FilePath -> FilePath -> FilePath</> f :: [Char]f)
b <- doesFileExist :: FilePath -> IO BooldoesFileExist path :: FilePathpath
if b :: Boolb then return :: Monad m => forall a. a -> m areturn (f :: [Char]f,path :: FilePathpath) else findInc :: [FilePath] -> [Char] -> IO ([Char], FilePath)findInc ds :: [FilePath]ds f :: [Char]f
withLib action = maybe :: b -> (a -> b) -> Maybe a -> bmaybe (return :: Monad m => forall a. a -> m areturn ()) action :: TestSuite -> m baction (library :: PackageDescription -> Maybe Librarylibrary pkg_descr :: PackageDescriptionpkg_descr)
withExe action = mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ action :: TestSuite -> m baction (executables :: PackageDescription -> [Executable]executables pkg_descr :: PackageDescriptionpkg_descr)
withTest action = mapM_ :: Monad m => (a -> m b) -> [a] -> m ()mapM_ action :: TestSuite -> m baction (testSuites :: PackageDescription -> [TestSuite]testSuites pkg_descr :: PackageDescriptionpkg_descr)
prepareSnapshotTree :: Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareSnapshotTree verbosity pkg mb_lbi distPref targetDir pps = do
prepareTree ::
Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> IO ()prepareTree verbosity :: Verbosityverbosity pkg :: PackageDescriptionpkg mb_lbi :: Maybe LocalBuildInfomb_lbi distPref :: FilePathdistPref targetDir :: FilePathtargetDir pps :: [PPSuffixHandler]pps
overwriteSnapshotPackageDesc ::
Verbosity -> PackageDescription -> FilePath -> IO ()overwriteSnapshotPackageDesc verbosity :: Verbosityverbosity pkg :: PackageDescriptionpkg targetDir :: FilePathtargetDir
overwriteSnapshotPackageDesc :: Verbosity
-> PackageDescription
-> FilePath
-> IO ()
overwriteSnapshotPackageDesc verbosity pkg targetDir = do
descFile <- defaultPackageDesc :: Verbosity -> IO FilePathdefaultPackageDesc verbosity :: Verbosityverbosity
withUTF8FileContents :: FilePath -> (String -> IO a) -> IO awithUTF8FileContents descFile :: FilePathdescFile ($) :: (a -> b) -> a -> b$
writeUTF8File :: FilePath -> String -> IO ()writeUTF8File (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> descFile :: FilePathdescFile)
(.) :: (b -> c) -> (a -> b) -> a -> c. unlines :: [String] -> Stringunlines (.) :: (b -> c) -> (a -> b) -> a -> c. map :: (a -> b) -> [a] -> [b]map (replaceVersion :: Version -> String -> StringreplaceVersion (packageVersion :: Package pkg => pkg -> VersionpackageVersion pkg :: PackageDescriptionpkg)) (.) :: (b -> c) -> (a -> b) -> a -> c. lines :: String -> [String]lines
where
replaceVersion :: Version -> String -> String
replaceVersion version line
| "version:" isPrefixOf :: Eq a => [a] -> [a] -> Bool`isPrefixOf` map :: (a -> b) -> [a] -> [b]map toLower :: Char -> ChartoLower line :: Stringline
= "version: " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay version :: Versionversion
| otherwise :: Boolotherwise = line :: Stringline
snapshotPackage :: CalendarTime -> PackageDescription -> PackageDescription
snapshotPackage date pkg =
pkg :: PackageDescriptionpkg {
package = pkgid :: PackageIdentifierpkgid { pkgVersion = snapshotVersion :: CalendarTime -> Version -> VersionsnapshotVersion date :: CalendarTimedate (pkgVersion :: PackageIdentifier -> VersionpkgVersion pkgid :: PackageIdentifierpkgid) }
}
where pkgid = packageId :: Package pkg => pkg -> PackageIdentifierpackageId pkg :: PackageDescriptionpkg
snapshotVersion :: CalendarTime -> Version -> Version
snapshotVersion date version = version :: Versionversion {
versionBranch = versionBranch :: Version -> [Int]versionBranch version :: Versionversion
(++) :: [a] -> [a] -> [a]++ [dateToSnapshotNumber :: CalendarTime -> IntdateToSnapshotNumber date :: CalendarTimedate]
}
dateToSnapshotNumber :: CalendarTime -> Int
dateToSnapshotNumber date = year :: Intyear (*) :: Num a => a -> a -> a* 10000
(+) :: Num a => a -> a -> a+ month :: Intmonth (*) :: Num a => a -> a -> a* 100
(+) :: Num a => a -> a -> a+ day :: Intday
where
year = ctYear :: CalendarTime -> IntctYear date :: CalendarTimedate
month = fromEnum :: Enum a => a -> IntfromEnum (ctMonth :: CalendarTime -> MonthctMonth date :: CalendarTimedate) (+) :: Num a => a -> a -> a+ 1
day = ctDay :: CalendarTime -> IntctDay date :: CalendarTimedate
createArchive :: Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> FilePath
-> IO FilePath
createArchive verbosity pkg_descr mb_lbi tmpDir targetPref = do
let tarBallFilePath = targetPref :: FilePathtargetPref (</>) :: FilePath -> FilePath -> FilePath</> tarBallName :: PackageDescription -> StringtarBallName pkg_descr :: PackageDescriptionpkg_descr (<.>) :: FilePath -> String -> FilePath<.> "tar.gz"
(tarProg, _) <- requireProgram ::
Verbosity
-> Program
-> ProgramDb
-> IO (ConfiguredProgram, ProgramDb)requireProgram verbosity :: Verbosityverbosity tarProgram :: ProgramtarProgram
(maybe :: b -> (a -> b) -> Maybe a -> bmaybe defaultProgramConfiguration :: ProgramConfigurationdefaultProgramConfiguration withPrograms :: LocalBuildInfo -> ProgramConfigurationwithPrograms mb_lbi :: Maybe LocalBuildInfomb_lbi)
rawSystemProgram ::
Verbosity -> ConfiguredProgram -> [ProgArg] -> IO ()rawSystemProgram verbosity :: Verbosityverbosity tarProg :: ConfiguredProgramtarProg
["-C", tmpDir :: FilePathtmpDir, "-czf", tarBallFilePath :: FilePathtarBallFilePath, tarBallName :: PackageDescription -> StringtarBallName pkg_descr :: PackageDescriptionpkg_descr]
return :: Monad m => forall a. a -> m areturn tarBallFilePath :: FilePathtarBallFilePath
prepareDir :: Verbosity
-> PackageDescription
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> [ModuleName]
-> BuildInfo
-> IO ()
prepareDir verbosity _pkg _distPref inPref pps modules bi
= do let searchDirs = hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi
sources <- sequence :: Monad m => [m a] -> m [a]sequence
[ let file = toFilePath :: ModuleName -> FilePathModuleName.toFilePath module_ :: ModuleNamemodule_
in findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension suffixes :: [String]suffixes searchDirs :: [FilePath]searchDirs file :: FilePathfile
(>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= maybe :: b -> (a -> b) -> Maybe a -> bmaybe (notFound :: a -> IO anotFound module_ :: ModuleNamemodule_) return :: Monad m => forall a. a -> m areturn
| module_ <- modules :: [ModuleName]modules (++) :: [a] -> [a] -> [a]++ otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi ]
bootFiles <- sequence :: Monad m => [m a] -> m [a]sequence
[ let file = toFilePath :: ModuleName -> FilePathModuleName.toFilePath module_ :: ModuleNamemodule_
fileExts = ["hs-boot", "lhs-boot"]
in findFileWithExtension ::
[String] -> [FilePath] -> FilePath -> IO (Maybe FilePath)findFileWithExtension fileExts :: [[Char]]fileExts (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi) file :: FilePathfile
| module_ <- modules :: [ModuleName]modules (++) :: [a] -> [a] -> [a]++ otherModules :: BuildInfo -> [ModuleName]otherModules bi :: BuildInfobi ]
let allSources = sources :: [FilePath]sources (++) :: [a] -> [a] -> [a]++ catMaybes :: [Maybe a] -> [a]catMaybes bootFiles :: [Maybe FilePath]bootFiles (++) :: [a] -> [a] -> [a]++ cSources :: BuildInfo -> [FilePath]cSources bi :: BuildInfobi
installOrdinaryFiles ::
Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()installOrdinaryFiles verbosity :: Verbosityverbosity inPref :: FilePathinPref (zip :: [a] -> [b] -> [(a, b)]zip (repeat :: a -> [a]repeat [] :: [a][]) allSources :: [FilePath]allSources)
where suffixes = ppSuffixes :: [PPSuffixHandler] -> [String]ppSuffixes pps :: [PPSuffixHandler]pps (++) :: [a] -> [a] -> [a]++ ["hs", "lhs"]
notFound m = die :: String -> IO adie ($) :: (a -> b) -> a -> b$ "Error: Could not find module: " (++) :: [a] -> [a] -> [a]++ display :: Text a => a -> Stringdisplay m :: ModuleNamem
(++) :: [a] -> [a] -> [a]++ " with any suffix: " (++) :: [a] -> [a] -> [a]++ show :: Show a => a -> Stringshow suffixes :: [String]suffixes
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()
copyFileTo verbosity dir file = do
let targetFile = dir :: FilePathdir (</>) :: FilePath -> FilePath -> FilePath</> file :: FilePathfile
createDirectoryIfMissingVerbose ::
Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue (takeDirectory :: FilePath -> FilePathtakeDirectory targetFile :: FilePathtargetFile)
installOrdinaryFile :: Verbosity -> FilePath -> FilePath -> IO ()installOrdinaryFile verbosity :: Verbosityverbosity file :: FilePathfile targetFile :: FilePathtargetFile
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems verbosity pkg_descr = do
ioChecks <- checkPackageFiles ::
PackageDescription -> FilePath -> IO [PackageCheck]checkPackageFiles pkg_descr :: PackageDescriptionpkg_descr "."
let pureChecks = checkConfiguredPackage :: PackageDescription -> [PackageCheck]checkConfiguredPackage pkg_descr :: PackageDescriptionpkg_descr
isDistError (PackageDistSuspicious _) = False :: BoolFalse
isDistError _ = True :: BoolTrue
(errors, warnings) = partition :: (a -> Bool) -> [a] -> ([a], [a])partition isDistError :: PackageCheck -> BoolisDistError (pureChecks :: [PackageCheck]pureChecks (++) :: [a] -> [a] -> [a]++ ioChecks :: [PackageCheck]ioChecks)
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull errors :: [PackageCheck]errors) ($) :: (a -> b) -> a -> b$
notice :: Verbosity -> String -> IO ()notice verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "Distribution quality errors:\n"
(++) :: [a] -> [a] -> [a]++ unlines :: [String] -> Stringunlines (map :: (a -> b) -> [a] -> [b]map explanation :: PackageCheck -> Stringexplanation errors :: [PackageCheck]errors)
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull warnings :: [PackageCheck]warnings) ($) :: (a -> b) -> a -> b$
notice :: Verbosity -> String -> IO ()notice verbosity :: Verbosityverbosity ($) :: (a -> b) -> a -> b$ "Distribution quality warnings:\n"
(++) :: [a] -> [a] -> [a]++ unlines :: [String] -> Stringunlines (map :: (a -> b) -> [a] -> [b]map explanation :: PackageCheck -> Stringexplanation warnings :: [PackageCheck]warnings)
unless :: Monad m => Bool -> m () -> m ()unless (null :: [a] -> Boolnull errors :: [PackageCheck]errors) ($) :: (a -> b) -> a -> b$
notice :: Verbosity -> String -> IO ()notice verbosity :: Verbosityverbosity
"Note: the public hackage server would reject this package."
tarBallName :: PackageDescription -> String
tarBallName = display :: Text a => a -> Stringdisplay (.) :: (b -> c) -> (a -> b) -> a -> c. packageId :: Package pkg => pkg -> PackageIdentifierpackageId
mapAllBuildInfo :: (BuildInfo -> BuildInfo)
-> (PackageDescription -> PackageDescription)
mapAllBuildInfo f pkg = pkg :: PackageDescriptionpkg {
library = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap mapLibBi :: Library -> LibrarymapLibBi (library :: PackageDescription -> Maybe Librarylibrary pkg :: PackageDescriptionpkg),
executables = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap mapExeBi :: Executable -> ExecutablemapExeBi (executables :: PackageDescription -> [Executable]executables pkg :: PackageDescriptionpkg)
}
where
mapLibBi lib = lib :: Librarylib { libBuildInfo = f :: [Char]f (libBuildInfo :: Library -> BuildInfolibBuildInfo lib :: Librarylib) }
mapExeBi exe = exe :: Executableexe { buildInfo = f :: [Char]f (buildInfo :: Executable -> BuildInfobuildInfo exe :: Executableexe) }