-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.SrcDist
-- Copyright   :  Simon Marlow 2004
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This handles the @sdist@ command. The module exports an 'sdist' action but
-- also some of the phases that make it up so that other tools can use just the
-- bits they need. In particular the preparation of the tree of files to go
-- into the source tarball is separated from actually building the source
-- tarball.
--
-- The 'createArchive' action uses the external @tar@ program and assumes that
-- it accepts the @-z@ flag. Neither of these assumptions are valid on Windows.
-- The 'sdist' action now also does some distribution QA checks.

{- Copyright (c) 2003-2004, Simon Marlow
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

-- NOTE: FIX: we don't have a great way of testing this module, since
-- we can't easily look inside a tarball once its created.

module Distribution.Simple.SrcDist (
  -- * The top level action
  sdist,

  -- ** Parts of 'sdist'
  printPackageProblems,
  prepareTree,
  createArchive,

  -- ** Snaphots
  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 )

-- |Create a source distribution.
sdist :: PackageDescription -- ^information from the tarball
      -> Maybe LocalBuildInfo -- ^Information from configure
      -> SDistFlags -- ^verbosity & snapshot
      -> (FilePath -> FilePath) -- ^build prefix (temp dir)
      -> [PPSuffixHandler]  -- ^ extra preprocessors (includes suffixes)
      -> IO ()
sdist pkg mb_lbi flags mkTmpDir pps = do

  -- do some QA
  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


-- |Prepare a directory tree of source files.
prepareTree :: Verbosity          -- ^verbosity
            -> PackageDescription -- ^info from the cabal file
            -> Maybe LocalBuildInfo
            -> FilePath           -- ^dist dir
            -> FilePath           -- ^source tree to populate
            -> [PPSuffixHandler]  -- ^extra preprocessors (includes suffixes)
            -> IO ()
prepareTree verbosity pkg_descr0 mb_lbi distPref targetDir pps = do
  createDirectoryIfMissingVerbose ::
  Verbosity -> Bool -> FilePath -> IO ()createDirectoryIfMissingVerbose verbosity :: Verbosityverbosity True :: BoolTrue targetDir :: FilePathtargetDir

  -- maybe move the library files into place
  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

  -- move the executables into place
  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

  -- move the test suites into place
  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
           -- preserve executable bit on extra-src-files like ./configure
           perms <- getPermissions :: FilePath -> IO PermissionsgetPermissions file :: FilePathfile
           when :: Monad m => Bool -> m () -> m ()when (executable :: Permissions -> Boolexecutable perms :: Permissionsperms) --only checks user x bit
                (setFileExecutable :: FilePath -> IO ()setFileExecutable (targetDir :: FilePathtargetDir (</>) :: FilePath -> FilePath -> FilePath</> file :: FilePathfile))
      | file <- files :: [FilePath]files ]

  -- copy the install-include 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

  -- if the package was configured then we can run platform independent
  -- pre-processors and include those generated files
  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 ()

  -- setup isn't listed in the description file.
  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"]
  -- the description file itself
  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

    -- We have to deal with all libs and executables, so we have local
    -- versions of these functions that ignore the 'buildable' attribute:
    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)

-- | Prepare a directory tree of source files for a snapshot version.
-- It is expected that the appropriate snapshot version has already been set
-- in the package description, eg using 'snapshotPackage' or 'snapshotVersion'.
--
prepareSnapshotTree :: Verbosity          -- ^verbosity
                    -> PackageDescription -- ^info from the cabal file
                    -> Maybe LocalBuildInfo
                    -> FilePath           -- ^dist dir
                    -> FilePath           -- ^source tree to populate
                    -> [PPSuffixHandler]  -- ^extra preprocessors (includes suffixes)
                    -> 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          -- ^verbosity
                             -> PackageDescription -- ^info from the cabal file
                             -> FilePath           -- ^source tree
                             -> IO ()
overwriteSnapshotPackageDesc verbosity pkg targetDir = do
    -- We could just writePackageDescription targetDescFile pkg_descr,
    -- but that would lose comments and formatting.
    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

-- | Modifies a 'PackageDescription' by appending a snapshot number
-- corresponding to the given date.
--
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

-- | Modifies a 'Version' by appending a snapshot number corresponding
-- to the given date.
--
snapshotVersion :: CalendarTime -> Version -> Version
snapshotVersion date version = version :: Versionversion {
    versionBranch = versionBranch :: Version -> [Int]versionBranch version :: Versionversion
                 (++) :: [a] -> [a] -> [a]++ [dateToSnapshotNumber :: CalendarTime -> IntdateToSnapshotNumber date :: CalendarTimedate]
  }

-- | Given a date produce a corresponding integer representation.
-- For example given a date @18/03/2008@ produce the number @20080318@.
--
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

-- |Create an archive from a tree of source files, and clean up the tree.
createArchive :: Verbosity            -- ^verbosity
              -> PackageDescription   -- ^info from cabal file
              -> Maybe LocalBuildInfo -- ^info from configure
              -> FilePath             -- ^source tree to archive
              -> FilePath             -- ^name of archive to create
              -> 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)

   -- Hmm: I could well be skating on thinner ice here by using the -C option (=> GNU tar-specific?)
   -- [The prev. solution used pipes and sub-command sequences to set up the paths correctly,
   -- which is problematic in a Windows setting.]
  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

-- |Move the sources into place based on buildInfo
prepareDir :: Verbosity -- ^verbosity
           -> PackageDescription -- ^info from the cabal file
           -> FilePath           -- ^dist dir
           -> FilePath  -- ^TargetPrefix
           -> [PPSuffixHandler]  -- ^ extra preprocessors (includes suffixes)
           -> [ModuleName]  -- ^Exposed modules
           -> 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."

------------------------------------------------------------

-- | The name of the tarball without extension
--
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) }