diff --git a/Cabal.cabal b/Cabal.cabal --- a/Cabal.cabal +++ b/Cabal.cabal @@ -1,5 +1,5 @@ name: Cabal -version: 1.18.0 +version: 1.18.1 copyright: 2003-2006, Isaac Jones 2005-2011, Duncan Coutts license: BSD3 diff --git a/Distribution/Compat/ReadP.hs b/Distribution/Compat/ReadP.hs --- a/Distribution/Compat/ReadP.hs +++ b/Distribution/Compat/ReadP.hs @@ -69,9 +69,9 @@ ) where -import Control.Monad( MonadPlus(..), liftM2, ap ) +import Control.Monad( MonadPlus(..), liftM, liftM2, ap ) import Data.Char (isSpace) -import Control.Applicative (Applicative(..)) +import Control.Applicative (Applicative(..), Alternative(empty, (<|>))) infixr 5 +++, <++ @@ -89,7 +89,7 @@ -- Monad, MonadPlus instance Functor (P s) where - fmap f x = x >>= return . f + fmap = liftM instance Applicative (P s) where pure = return @@ -105,6 +105,10 @@ (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s] fail _ = Fail + +instance Alternative (P s) where + empty = mzero + (<|>) = mplus instance MonadPlus (P s) where mzero = Fail diff --git a/Distribution/Compiler.hs b/Distribution/Compiler.hs --- a/Distribution/Compiler.hs +++ b/Distribution/Compiler.hs @@ -20,7 +20,7 @@ -- Unfortunately we cannot make this change yet without breaking the -- 'UserHooks' api, which would break all custom @Setup.hs@ files, so for the -- moment we just have to live with this deficiency. If you're interested, see --- ticket #50. +-- ticket #57. {- All rights reserved. diff --git a/Distribution/Simple/BuildTarget.hs b/Distribution/Simple/BuildTarget.hs --- a/Distribution/Simple/BuildTarget.hs +++ b/Distribution/Simple/BuildTarget.hs @@ -55,7 +55,7 @@ ( partitionEithers ) import qualified Data.Map as Map import Control.Monad -import Control.Applicative (Applicative(..)) +import Control.Applicative (Applicative(..), Alternative(..)) import qualified Distribution.Compat.ReadP as Parse import Distribution.Compat.ReadP ( (+++), (<++) ) @@ -744,6 +744,10 @@ | MatchErrorNoSuch String String deriving (Show, Eq) + +instance Alternative Match where + empty = mzero + (<|>) = mplus instance MonadPlus Match where mzero = matchZero diff --git a/Distribution/Simple/PackageIndex.hs b/Distribution/Simple/PackageIndex.hs --- a/Distribution/Simple/PackageIndex.hs +++ b/Distribution/Simple/PackageIndex.hs @@ -106,6 +106,8 @@ -- of the same package version. These are unique by InstalledPackageId -- and are kept in preference order. -- + -- FIXME: Clarify what "preference order" means. Check that this invariant is + -- preserved. See #1463 for discussion. !(Map PackageName (Map Version [InstalledPackageInfo])) deriving (Show, Read) diff --git a/Distribution/Simple/SrcDist.hs b/Distribution/Simple/SrcDist.hs --- a/Distribution/Simple/SrcDist.hs +++ b/Distribution/Simple/SrcDist.hs @@ -124,7 +124,6 @@ case (sDistListSources flags) of Flag path -> withFile path WriteMode $ \outHandle -> do (ordinary, maybeExecutable) <- listPackageSources verbosity pkg pps - DontCreateDefaultSetupScript mapM_ (hPutStrLn outHandle) ordinary mapM_ (hPutStrLn outHandle) maybeExecutable notice verbosity $ "List of package sources written to file '" @@ -168,11 +167,6 @@ targetPref = distPref tmpTargetDir = mkTmpDir distPref --- | Should a default @Setup.hs@ be created if none exists? We do this in --- @sdist@, but not in @sdist --list-sources@. -data CreateDefaultSetupScript = CreateDefaultSetupScript - | DontCreateDefaultSetupScript - -- | List all source files of a package. Returns a tuple of lists: first -- component is a list of ordinary files, second one is a list of those files -- that may be executable. @@ -180,13 +174,10 @@ -> PackageDescription -- ^ info from the cabal file -> [PPSuffixHandler] -- ^ extra preprocessors (include -- suffixes) - -> CreateDefaultSetupScript -- ^ create a default - -- @Setup.hs@ ? -> IO ([FilePath], [FilePath]) -listPackageSources verbosity pkg_descr0 pps createSetup = do +listPackageSources verbosity pkg_descr0 pps = do -- Call helpers that actually do all work. ordinary <- listPackageSourcesOrdinary verbosity pkg_descr pps - createSetup maybeExecutable <- listPackageSourcesMaybeExecutable pkg_descr return (ordinary, maybeExecutable) where @@ -202,9 +193,8 @@ listPackageSourcesOrdinary :: Verbosity -> PackageDescription -> [PPSuffixHandler] - -> CreateDefaultSetupScript -> IO [FilePath] -listPackageSourcesOrdinary verbosity pkg_descr pps createSetup = +listPackageSourcesOrdinary verbosity pkg_descr pps = fmap concat . sequence $ [ -- Library sources. @@ -259,27 +249,24 @@ . forM (dataFiles pkg_descr) $ \filename -> matchFileGlob (dataDir pkg_descr filename) + -- Extra doc files. + , fmap concat + . forM (extraDocFiles pkg_descr) $ \ filename -> + matchFileGlob filename + -- License file. , return $ case [licenseFile pkg_descr] of [[]] -> [] l -> l + -- Install-include files. , withLib $ \ l -> do let lbi = libBuildInfo l relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi) mapM (fmap snd . findIncludeFile relincdirs) (installIncludes lbi) - -- Setup script. - , do mSetupFile <- findSetupFile - case mSetupFile of - Just setupFile -> return [setupFile] - Nothing -> case createSetup of - DontCreateDefaultSetupScript -> return [] - CreateDefaultSetupScript -> do - writeUTF8File "Setup.hs" $ unlines [ - "import Distribution.Simple", - "main = defaultMain"] - return ["Setup.hs"] + -- Setup script, if it exists. + , fmap (maybe [] (\f -> [f])) $ findSetupFile "" -- The .cabal file itself. , fmap (\d -> [d]) (defaultPackageDesc verbosity) @@ -312,17 +299,17 @@ _ -> return () (ordinary, mExecutable) <- listPackageSources verbosity pkg_descr0 pps - CreateDefaultSetupScript installOrdinaryFiles verbosity targetDir (zip (repeat []) ordinary) installMaybeExecutableFiles verbosity targetDir (zip (repeat []) mExecutable) + maybeCreateDefaultSetupScript targetDir where pkg_descr = filterAutogenModule pkg_descr0 -- | Find the setup script file, if it exists. -findSetupFile :: IO (Maybe FilePath) -findSetupFile = do - hsExists <- doesFileExist setupHs +findSetupFile :: FilePath -> IO (Maybe FilePath) +findSetupFile targetDir = do + hsExists <- doesFileExist setupHs lhsExists <- doesFileExist setupLhs if hsExists then return (Just setupHs) @@ -330,8 +317,19 @@ then return (Just setupLhs) else return Nothing where - setupHs = "Setup.hs" - setupLhs = "Setup.lhs" + setupHs = targetDir "Setup.hs" + setupLhs = targetDir "Setup.lhs" + +-- | Create a default setup script in the target directory, if it doesn't exist. +maybeCreateDefaultSetupScript :: FilePath -> IO () +maybeCreateDefaultSetupScript targetDir = do + mSetupFile <- findSetupFile targetDir + case mSetupFile of + Just _setupFile -> return () + Nothing -> do + writeUTF8File (targetDir "Setup.hs") $ unlines [ + "import Distribution.Simple", + "main = defaultMain"] -- | Find the main executable file. findMainExeFile :: BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath diff --git a/Distribution/Version.hs b/Distribution/Version.hs --- a/Distribution/Version.hs +++ b/Distribution/Version.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +{-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Version @@ -121,8 +121,10 @@ | VersionRangeParens VersionRange -- just '(exp)' parentheses syntax deriving (Show,Read,Eq,Typeable,Data) --- TODO orphan +#if __GLASGOW_HASKELL__ < 707 +-- starting with ghc-7.7/base-4.7 this instance is provided in "Data.Data" deriving instance Data Version +#endif {-# DEPRECATED AnyVersion "Use 'anyVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} {-# DEPRECATED ThisVersion "use 'thisVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} @@ -233,8 +235,7 @@ IntersectVersionRanges (orLaterVersion v1) (orEarlierVersion v2) {-# DEPRECATED betweenVersionsInclusive - "In practice this is not very useful because we normally use inclusive lower bounds and exclusive upper bounds" - #-} + "In practice this is not very useful because we normally use inclusive lower bounds and exclusive upper bounds" #-} -- | Fold over the basic syntactic structure of a 'VersionRange'. --