cabal init patches

Brent Yorgey byorgey at seas.upenn.edu
Tue Oct 25 07:14:40 CEST 2011


Hi all,

I've finally gotten around to working on some improvements to cabal
init.  The first three listed patches are minor improvements. The last
is a bigger addition, which tries to guess the right package
dependencies to list in the build-depends field.  Feedback welcome.

-Brent

4 patches for repository http://darcs.haskell.org/cabal:

Fri Oct 14 16:21:34 EDT 2011  Brent Yorgey <byorgey at cis.upenn.edu>
  * init: improve prompt: 'homepage' field is not for repos.

Fri Oct 14 16:22:10 EDT 2011  Brent Yorgey <byorgey at cis.upenn.edu>
  * init: improve prompt: enclose y/n in parens

Fri Oct 14 16:22:30 EDT 2011  Brent Yorgey <byorgey at cis.upenn.edu>
  * init: see whether source directory 'src' exists.

Tue Oct 25 01:09:00 EDT 2011  Brent Yorgey <byorgey at cis.upenn.edu>
  * init: guess at filling in deps in the build-depends: field
-------------- next part --------------
Hi all,

I've finally gotten around to working on some improvements to cabal
init.  The first three listed patches are minor improvements. The last
is a bigger addition, which tries to guess the right package
dependencies to list in the build-depends field.  Feedback welcome.

-Brent

4 patches for repository http://darcs.haskell.org/cabal:

Fri Oct 14 16:21:34 EDT 2011  Brent Yorgey <byorgey at cis.upenn.edu>
  * init: improve prompt: 'homepage' field is not for repos.

Fri Oct 14 16:22:10 EDT 2011  Brent Yorgey <byorgey at cis.upenn.edu>
  * init: improve prompt: enclose y/n in parens

Fri Oct 14 16:22:30 EDT 2011  Brent Yorgey <byorgey at cis.upenn.edu>
  * init: see whether source directory 'src' exists.

Tue Oct 25 01:09:00 EDT 2011  Brent Yorgey <byorgey at cis.upenn.edu>
  * init: guess at filling in deps in the build-depends: field


New patches:

[init: improve prompt: 'homepage' field is not for repos.
Brent Yorgey <byorgey at cis.upenn.edu>**20111014202134
 Ignore-this: 432aabae368e371597a384d97f1dbc21
] hunk ./cabal-install/Distribution/Client/Init.hs 172
 getHomepage flags = do
   hp  <- queryHomepage
   hp' <-     return (flagToMaybe $ homepage flags)
-         ?>> maybePrompt flags (promptStr "Project homepage/repo URL" hp)
+         ?>> maybePrompt flags (promptStr "Project homepage URL" hp)
          ?>> return hp
 
   return $ flags { homepage = maybeToFlag hp' }
[init: improve prompt: enclose y/n in parens
Brent Yorgey <byorgey at cis.upenn.edu>**20111014202210
 Ignore-this: 4925b25ef425d774333856b83fc6eb6a
] hunk ./cabal-install/Distribution/Client/Init.hs 220
                  ?>> return (Just False)
   return $ flags { noComments = maybeToFlag (fmap not genComments) }
   where
-    promptMsg = "Include documentation on what each field means y/n"
+    promptMsg = "Include documentation on what each field means (y/n)"
 
 -- | Try to guess the source root directory (don't prompt the user).
 getSrcDir :: InitFlags -> IO InitFlags
[init: see whether source directory 'src' exists.
Brent Yorgey <byorgey at cis.upenn.edu>**20111014202230
 Ignore-this: 8008fc37fad5ebe45c1a62c5ce45264b
] {
hunk ./cabal-install/Distribution/Client/Init.hs 27
 import System.IO
   ( hSetBuffering, stdout, BufferMode(..) )
 import System.Directory
-  ( getCurrentDirectory )
+  ( getCurrentDirectory, doesDirectoryExist )
+import System.FilePath
+  ( (</>) )
 import Data.Time
   ( getCurrentTime, utcToLocalTime, toGregorian, localDay, getCurrentTimeZone )
 
hunk ./cabal-install/Distribution/Client/Init.hs 228
 getSrcDir :: InitFlags -> IO InitFlags
 getSrcDir flags = do
   srcDirs <-     return (sourceDirs flags)
-             ?>> guessSourceDirs
+             ?>> Just `fmap` (guessSourceDirs flags)
 
   return $ flags { sourceDirs = srcDirs }
 
hunk ./cabal-install/Distribution/Client/Init.hs 232
--- XXX
--- | Try to guess source directories.
-guessSourceDirs :: IO (Maybe [String])
-guessSourceDirs = return Nothing
+-- | Try to guess source directories.  Could try harder; for the
+--   moment just looks to see whether there is a directory called 'src'.
+guessSourceDirs :: InitFlags -> IO [String]
+guessSourceDirs flags = do
+  dir      <- fromMaybe getCurrentDirectory
+                (fmap return . flagToMaybe $ packageDir flags)
+  srcIsDir <- doesDirectoryExist (dir </> "src")
+  if srcIsDir
+    then return ["src"]
+    else return []
 
 -- | Get the list of exposed modules and extra tools needed to build them.
 getModulesAndBuildTools :: InitFlags -> IO InitFlags
}
[init: guess at filling in deps in the build-depends: field
Brent Yorgey <byorgey at cis.upenn.edu>**20111025050900
 Ignore-this: 4adf589b96657d084c6fd72175d8ee05
] {
hunk ./cabal-install/Distribution/Client/Init.hs 34
   ( getCurrentTime, utcToLocalTime, toGregorian, localDay, getCurrentTimeZone )
 
 import Data.List
-  ( intersperse, (\\) )
+  ( intersperse, intercalate, nub, groupBy, (\\) )
 import Data.Maybe
hunk ./cabal-install/Distribution/Client/Init.hs 36
-  ( fromMaybe, isJust )
+  ( fromMaybe, isJust, catMaybes )
+import Data.Function
+  ( on )
+import qualified Data.Map as M
 import Data.Traversable
   ( traverse )
hunk ./cabal-install/Distribution/Client/Init.hs 42
+import Control.Applicative
+  ( (<$>) )
 import Control.Monad
   ( when )
 #if MIN_VERSION_base(3,0,0)
hunk ./cabal-install/Distribution/Client/Init.hs 50
 import Control.Monad
   ( (>=>), join )
 #endif
+import Control.Arrow
+  ( (&&&) )
 
 import Text.PrettyPrint hiding (mode, cat)
 
hunk ./cabal-install/Distribution/Client/Init.hs 58
 import Data.Version
   ( Version(..) )
 import Distribution.Version
-  ( orLaterVersion )
+  ( orLaterVersion, withinVersion, VersionRange )
+import Distribution.Verbosity
+  ( Verbosity )
+import Distribution.ModuleName
+  ( ModuleName, fromString )
+import Distribution.InstalledPackageInfo
+  ( InstalledPackageInfo, sourcePackageId, exposed )
+import qualified Distribution.Package as P
 
 import Distribution.Client.Init.Types
   ( InitFlags(..), PackageType(..), Category(..) )
hunk ./cabal-install/Distribution/Client/Init.hs 83
   ( runReadE, readP_to_E )
 import Distribution.Simple.Setup
   ( Flag(..), flagToMaybe )
+import Distribution.Simple.Configure
+  ( getInstalledPackages )
+import Distribution.Simple.Compiler
+  ( PackageDBStack, Compiler )
+import Distribution.Simple.Program
+  ( ProgramConfiguration )
+import Distribution.Simple.PackageIndex
+  ( PackageIndex, moduleNameIndex )
 import Distribution.Text
   ( display, Text(..) )
 
hunk ./cabal-install/Distribution/Client/Init.hs 94
-initCabal :: InitFlags -> IO ()
-initCabal initFlags = do
+initCabal :: Verbosity
+          -> PackageDBStack
+          -> Compiler
+          -> ProgramConfiguration
+          -> InitFlags
+          -> IO ()
+initCabal verbosity packageDBs comp conf initFlags = do
+
+  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
+
   hSetBuffering stdout NoBuffering
 
hunk ./cabal-install/Distribution/Client/Init.hs 106
-  initFlags' <- extendFlags initFlags
+  initFlags' <- extendFlags installedPkgIndex initFlags
 
   writeLicense initFlags'
   writeSetupFile initFlags'
hunk ./cabal-install/Distribution/Client/Init.hs 120
 
 -- | Fill in more details by guessing, discovering, or prompting the
 --   user.
-extendFlags :: InitFlags -> IO InitFlags
-extendFlags =  getPackageName
-           >=> getVersion
-           >=> getLicense
-           >=> getAuthorInfo
-           >=> getHomepage
-           >=> getSynopsis
-           >=> getCategory
-           >=> getLibOrExec
-           >=> getGenComments
-           >=> getSrcDir
-           >=> getModulesAndBuildTools
+extendFlags :: PackageIndex -> InitFlags -> IO InitFlags
+extendFlags pkgIx =
+      getPackageName
+  >=> getVersion
+  >=> getLicense
+  >=> getAuthorInfo
+  >=> getHomepage
+  >=> getSynopsis
+  >=> getCategory
+  >=> getLibOrExec
+  >=> getGenComments
+  >=> getSrcDir
+  >=> getModulesBuildToolsAndDeps pkgIx
 
 -- | Combine two actions which may return a value, preferring the first. That
 --   is, run the second action only if the first doesn't return a value.
hunk ./cabal-install/Distribution/Client/Init.hs 275
     else return []
 
 -- | Get the list of exposed modules and extra tools needed to build them.
-getModulesAndBuildTools :: InitFlags -> IO InitFlags
-getModulesAndBuildTools flags = do
+getModulesBuildToolsAndDeps :: PackageIndex -> InitFlags -> IO InitFlags
+getModulesBuildToolsAndDeps pkgIx flags = do
   dir <- fromMaybe getCurrentDirectory
                    (fmap return . flagToMaybe $ packageDir flags)
 
hunk ./cabal-install/Distribution/Client/Init.hs 283
   -- XXX really should use guessed source roots.
   sourceFiles <- scanForModules dir
 
-  mods <-      return (exposedModules flags)
+  Just mods <-      return (exposedModules flags)
            ?>> (return . Just . map moduleName $ sourceFiles)
 
   tools <-     return (buildTools flags)
hunk ./cabal-install/Distribution/Client/Init.hs 289
            ?>> (return . Just . neededBuildPrograms $ sourceFiles)
 
-  return $ flags { exposedModules = mods
-                 , buildTools     = tools }
+  deps <-      return (dependencies flags)
+           ?>> Just <$> importsToDeps flags
+                        (fromString "Prelude" : concatMap imports sourceFiles)
+                        pkgIx
+
+  return $ flags { exposedModules = Just mods
+                 , buildTools     = tools
+                 , dependencies   = deps
+                 }
+
+importsToDeps :: InitFlags -> [ModuleName] -> PackageIndex -> IO [P.Dependency]
+importsToDeps flags mods pkgIx = do
+
+  let modMap :: M.Map ModuleName [InstalledPackageInfo]
+      modMap  = M.map (filter exposed) $ moduleNameIndex pkgIx
+
+      modDeps :: [(ModuleName, Maybe [InstalledPackageInfo])]
+      modDeps = map (id &&& flip M.lookup modMap) mods
+
+  message flags "\nGuessing dependencies..."
+  nub . catMaybes <$> mapM (chooseDep flags) modDeps
+
+-- Given a module and a list of installed packages providing it,
+-- choose a dependency (i.e. package + version range) to use for that
+-- module.
+chooseDep :: InitFlags -> (ModuleName, Maybe [InstalledPackageInfo])
+          -> IO (Maybe P.Dependency)
+
+chooseDep flags (m, Nothing)
+  = message flags ("\nWarning: no package found providing " ++ display m ++ ".")
+    >> return Nothing
+
+chooseDep flags (m, Just [])
+  = message flags ("\nWarning: no package found providing " ++ display m ++ ".")
+    >> return Nothing
+
+    -- We found some packages: group them by name.
+chooseDep flags (m, Just ps)
+  = case pkgGroups of
+      -- if there's only one group, i.e. multiple versions of a single package,
+      -- we make it into a dependency, choosing the latest-ish version (see toDep).
+      [grp] -> Just <$> toDep grp
+      -- otherwise, we refuse to choose between different packages and make the user
+      -- do it.
+      grps  -> do message flags ("\nWarning: multiple packages found providing "
+                                 ++ display m
+                                 ++ ": " ++ intercalate ", " (map (display . P.pkgName . head) grps))
+                  message flags ("You will need to pick one and manually add it to the Build-depends: field.")
+                  return Nothing
+  where
+    pkgGroups = groupBy ((==) `on` P.pkgName) (map sourcePackageId ps)
+
+    -- Given a list of available versions of the same package, pick a dependency.
+    toDep :: [P.PackageIdentifier] -> IO P.Dependency
+
+    -- If only one version, easy.  We change e.g. 0.4.2  into  0.4.*
+    toDep [pid] = return $ P.Dependency (P.pkgName pid) (pvpize . P.pkgVersion $ pid)
+
+    -- Otherwise, choose the latest version and issue a warning.
+    toDep pids  = do
+      message flags ("\nWarning: multiple versions of " ++ display (P.pkgName . head $ pids) ++ " provide " ++ display m ++ ", choosing the latest.")
+      return $ P.Dependency (P.pkgName . head $ pids)
+                            (pvpize . maximum . map P.pkgVersion $ pids)
+
+    pvpize :: Version -> VersionRange
+    pvpize v = withinVersion $ v { versionBranch = take 2 (versionBranch v) }
 
 ---------------------------------------------------------------------------
 --  Prompting/user interaction  -------------------------------------------
hunk ./cabal-install/Distribution/Client/Init.hs 476
 
 writeLicense :: InitFlags -> IO ()
 writeLicense flags = do
-  message flags "Generating LICENSE..."
+  message flags "\nGenerating LICENSE..."
   year <- getYear
   let licenseFile =
         case license flags of
hunk ./cabal-install/Distribution/Client/Init.hs 522
     , "main = defaultMain"
     ]
 
+-- XXX ought to do something sensible if a .cabal file already exists,
+-- instead of overwriting.
 writeCabalFile :: InitFlags -> IO Bool
 writeCabalFile flags@(InitFlags{packageName = NoFlag}) = do
   message flags "Error: no package name provided."
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 22
     guessAuthorNameMail,
     knownCategories,
 ) where
-import Distribution.Simple.Setup(Flag(..))
-import Distribution.ModuleName ( ModuleName, fromString )
+import Distribution.Text         (simpleParse)
+import Distribution.Simple.Setup (Flag(..))
+import Distribution.ModuleName
+    ( ModuleName, fromString, toFilePath )
 import Distribution.Client.PackageIndex
     ( allPackagesByName )
 import qualified Distribution.PackageDescription as PD
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 39
 #if MIN_VERSION_base(3,0,3)
 import Data.Either ( partitionEithers )
 #endif
+import Data.List   ( isPrefixOf )
 import Data.Maybe  ( catMaybes )
 import Data.Monoid ( mempty, mappend )
 import qualified Data.Set as Set ( fromList, toList )
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 47
                           getHomeDirectory, canonicalizePath )
 import System.Environment ( getEnvironment )
 import System.FilePath ( takeExtension, takeBaseName, dropExtension,
-                         (</>), splitDirectories, makeRelative )
+                         (</>), (<.>), splitDirectories, makeRelative )
 
 -- |Guess the package name based on the given root directory
 guessPackageName :: FilePath -> IO String
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 56
 -- |Data type of source files found in the working directory
 data SourceFileEntry = SourceFileEntry
     { relativeSourcePath :: FilePath
-    , moduleName :: ModuleName
-    , fileExtension :: String
+    , moduleName         :: ModuleName
+    , fileExtension      :: String
+    , imports            :: [ModuleName]
     } deriving Show
 
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 61
+sfToFileName :: FilePath -> SourceFileEntry -> FilePath
+sfToFileName projectRoot (SourceFileEntry relPath m ext _)
+  = projectRoot </> relPath </> toFilePath m <.> ext
+
 -- |Search for source files in the given directory
 -- and return pairs of guessed haskell source path and
 -- module names.
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 80
         let modules = catMaybes [ guessModuleName hierarchy file
                                 | file <- files
                                 , isUpper (head file) ]
+        modules' <- mapM (findImports projectRoot) modules
         recMods <- mapM (scanRecursive dir hierarchy) dirs
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 82
-        return $ concat (modules : recMods)
+        return $ concat (modules' : recMods)
     tagIsDir parent entry = do
         isDir <- doesDirectoryExist (parent </> entry)
         return $ (if isDir then Right else Left) entry
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 88
     guessModuleName hierarchy entry
         | takeBaseName entry == "Setup" = Nothing
-        | ext `elem` sourceExtensions = Just $ SourceFileEntry relRoot modName ext
+        | ext `elem` sourceExtensions = Just $ SourceFileEntry relRoot modName ext []
         | otherwise = Nothing
       where
         relRoot = makeRelative projectRoot srcRoot
hunk ./cabal-install/Distribution/Client/Init/Heuristics.hs 103
     ignoreDir ('.':_)  = True
     ignoreDir dir      = dir `elem` ["dist", "_darcs"]
 
+findImports :: FilePath -> SourceFileEntry -> IO SourceFileEntry
+findImports projectRoot sf = do
+  s <- readFile (sfToFileName projectRoot sf)
+
+  let modules = catMaybes
+              . map ( getModName
+                    . drop 1
+                    . filter (not . null)
+                    . dropWhile (/= "import")
+                    . words
+                    )
+              . filter (not . ("--" `isPrefixOf`)) -- poor man's comment filtering
+              . lines
+              $ s
+
+      -- XXX we should probably make a better attempt at parsing
+      -- comments above.  Unfortunately we can't use a full-fledged
+      -- Haskell parser since cabal's dependencies must be kept at a
+      -- minimum.
+
+  return sf { imports = modules }
+
+ where getModName :: [String] -> Maybe ModuleName
+       getModName []               = Nothing
+       getModName ("qualified":ws) = getModName ws
+       getModName (ms:_)           = simpleParse ms
+
+
+
 -- Unfortunately we cannot use the version exported by Distribution.Simple.Program
 knownSuffixHandlers :: [(String,String)]
 knownSuffixHandlers =
hunk ./cabal-install/Distribution/Client/Init/Types.hs 21
   ( Flag(..) )
 
 import Distribution.Version
+import Distribution.Verbosity
 import qualified Distribution.Package as P
 import Distribution.License
 import Distribution.ModuleName
hunk ./cabal-install/Distribution/Client/Init/Types.hs 63
               , dependencies :: Maybe [P.Dependency]
               , sourceDirs   :: Maybe [String]
               , buildTools   :: Maybe [String]
+
+              , initVerbosity :: Flag Verbosity
               }
   deriving (Show)
 
hunk ./cabal-install/Distribution/Client/Init/Types.hs 97
     , dependencies   = mempty
     , sourceDirs     = mempty
     , buildTools     = mempty
+    , initVerbosity  = mempty
     }
   mappend  a b = InitFlags
     { nonInteractive = combine nonInteractive
hunk ./cabal-install/Distribution/Client/Init/Types.hs 120
     , dependencies   = combine dependencies
     , sourceDirs     = combine sourceDirs
     , buildTools     = combine buildTools
+    , initVerbosity  = combine initVerbosity
     }
     where combine field = field a `mappend` field b
 
hunk ./cabal-install/Distribution/Client/Setup.hs 842
 emptyInitFlags  = mempty
 
 defaultInitFlags :: IT.InitFlags
-defaultInitFlags  = emptyInitFlags
+defaultInitFlags  = emptyInitFlags { IT.initVerbosity = toFlag normal }
 
 initCommand :: CommandUI IT.InitFlags
 initCommand = CommandUI {
hunk ./cabal-install/Distribution/Client/Setup.hs 976
         IT.buildTools (\v flags -> flags { IT.buildTools = v })
         (reqArg' "TOOL" (Just . (:[]))
                         (fromMaybe []))
+
+      , optionVerbosity IT.initVerbosity (\v flags -> flags { IT.initVerbosity = v })
       ]
   }
   where readMaybe s = case reads s of
hunk ./cabal-install/Main.hs 29
          , InfoFlags(..), infoCommand
          , UploadFlags(..), uploadCommand
          , ReportFlags(..), reportCommand
-         , InitFlags, initCommand
+         , InitFlags(initVerbosity), initCommand
          , SDistFlags(..), SDistExFlags(..), sdistCommand
          , reportCommand
          , unpackCommand, UnpackFlags(..) )
hunk ./cabal-install/Main.hs 358
          targets
 
 initAction :: InitFlags -> [String] -> GlobalFlags -> IO ()
-initAction flags _extraArgs _globalFlags = do
-  initCabal flags
+initAction initFlags _extraArgs globalFlags = do
+  let verbosity = fromFlag (initVerbosity initFlags)
+  config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
+  let configFlags  = savedConfigureFlags config
+  (comp, conf) <- configCompilerAux' configFlags
+  initCabal verbosity
+            (configPackageDB' configFlags)
+            comp
+            conf
+            initFlags
 
 -- | See 'Distribution.Client.Install.withWin32SelfUpgrade' for details.
 --
}

Context:

[Describe benchmark sections in the user guide
Johan Tibell <johan.tibell at gmail.com>**20111019153233
 Ignore-this: 349a426ca769cfea19c5f784846e8a95
] 
[Fix source repo subdir name after cabal->Cabal dir rename
Duncan Coutts <duncan at community.haskell.org>**20111023214425
 Ignore-this: e1e0327576da9bfc45056ef69c74e28a
] 
[Add a source package index cache to speed up reading
Duncan Coutts <duncan at community.haskell.org>**20111023213253
 Ignore-this: d35c7eeaba12305fc9a5f1b1c146c902
 e.g. about 3x faster for cabal info pkgname
] 
[Bump versions of Cabal and cabal-install
Duncan Coutts <duncan at community.haskell.org>**20111023213924
 Ignore-this: b298e60d9b5eada94f0f40edf942f031
 Latest cabal-install requires latest Cabal due to api addition
] 
[Fail gracefully if 'cabal bench' is run before 'cabal build'
Johan Tibell <johan.tibell at gmail.com>**20111013232847
 Ignore-this: 9c73bb0b650fe4b06a5515bef7587cfd
] 
[Add unit test for 'cabal bench' command-line flags
Johan Tibell <johan.tibell at gmail.com>**20111013232109
 Ignore-this: fc3e53a768c3c971a8f5e3a6e187ba2d
] 
[Implement 'cabal bench' command
Johan Tibell <johan.tibell at gmail.com>**20111013225615
 Ignore-this: 34a2e6e5bdc13d16eaadc48a2efe2d75
 The only implement benchmark interface so far is exitcode-stdio-1.0,
 which forwards the output of the benchmark executable being run to the
 parent process' stdout/stderr.
] 
[Add package checks for benchmarks
Johan Tibell <johan.tibell at gmail.com>**20111012201604
 Ignore-this: ce4094004ab81b6f60d69a30f6f16247
 Refactor duplicate names check to avoid having to manually write all
 O(n^2) possible collision cases between executables, test suites, and
 benchmarks.
] 
[Uploading build reports shouldn't fail if there are no reports
Max Bolingbroke <batterseapower at hotmail.com>**20111016143819
 Ignore-this: 7423a9c3a67a581c04502912fc08f460
] 
[Add a (substituted) flag to allow configuration of Haddock's --use-contents flag
Max Bolingbroke <batterseapower at hotmail.com>**20111016110852
 Ignore-this: 33d1cc9683e9e3e421c2ca54dc745de0
] 
[Allow Haddock to be configured from the 'install' command
Max Bolingbroke <batterseapower at hotmail.com>**20111015170101
 Ignore-this: af173867f239b0259490445f27756ad9
] 
[Rename the cabal directory to Cabal
Ian Lynagh <igloo at earth.li>**20111023151002
 Ignore-this: ff444b152bfc981496c6e2d2206a4953
 
 Makes things a little simpler in GHC's build system if libraries are in
 the same directory as their name.
] 
[Change Safe Haskell package trust default to untrusted
David Terei <davidterei at gmail.com>**20111018033319
 Ignore-this: 2b7ea14f983abf92b8c7dca67b280d4a
] 
[Install phase pulls in benchmark dependencies when necessary
Johan Tibell <johan.tibell at gmail.com>**20111012210035
 Ignore-this: 9b055441a6fec970fbb2aaa6f4cb4406
] 
[Include benchmarks in product of 'setup sdist'
Johan Tibell <johan.tibell at gmail.com>**20111012205036
 Ignore-this: 216583b2d9ae5312aaf3da043bf45b6
] 
[Add unit test for building benchmarks
Johan Tibell <johan.tibell at gmail.com>**20111012154138
 Ignore-this: b66404f7b8829e67223c0222cbc98b10
] 
[Build executable benchmarks
Johan Tibell <johan.tibell at gmail.com>**20111012143034
 Ignore-this: 26ba0c0ab2476bef33c2e4c0b2e0c8d9
 Benchmarks are treated just like test suites in that a dummy
 Executable is created and built.
] 
[Add unit test for benchmark section
Johan Tibell <johan.tibell at gmail.com>**20111011195847
 Ignore-this: 672f8848e5ce9cb2e321894506176b3e
] 
[Implement 'configure' and preprocessing for benchmarks
Johan Tibell <johan.tibell at gmail.com>**20111011194838
 Ignore-this: 519cfe1fd6bb6ac0ccc4f10d2d037897
] 
[Parse the --{enable,disable}-benchmarks command line flag
Johan Tibell <johan.tibell at gmail.com>**20111011192349
 Ignore-this: 268674c925d07184b6efc11a38d65d6f
] 
[Parse 'benchmark' sections and handle configurations (flags) for benchmarks
Johan Tibell <johan.tibell at gmail.com>**20111011191515
 Ignore-this: e6b671538374a5db09b995ab1a233ce2
] 
[Add a Benchmark data type for representing 'benchmark' sections
Johan Tibell <johan.tibell at gmail.com>**20111011175849
 Ignore-this: aba4698167e15db635302e577b871b1b
] 
[Use the configured proxy even for uploading build reports
Max Bolingbroke <batterseapower at hotmail.com>**20110928210859
 Ignore-this: 189a21577bfe5a651850feda891955e2
] 
[GHC 7.2+ no longer generates _stub.o files
Duncan Coutts <duncan at community.haskell.org>**20110910195329
 Ignore-this: e7b432affc79e4d7c418c03be7e55acc
 So stop looking for them. This could otherwise cause problems if one
 switches ghc version without cleaning the build dir since we'll pick
 up the old _stub.o files and end up with duplicate linker symbols.
] 
[Use a PVP-style version as the default for cabal init
Duncan Coutts <duncan at community.haskell.org>**20110925021722
 Ignore-this: 58c054d082254c4bcf26cd4601317f2
] 
[Filter autogenerated modules from test suite build info when doing sdist.
Thomas Tuegel <ttuegel at gmail.com>**20110923201806
 Ignore-this: 6f1eb9a1af8fad0442544d05d2568db9
] 
[Change extension name to "ConstraintKinds"
Duncan Coutts <duncan at community.haskell.org>**20110908220819
 Ignore-this: a5faf4ded03ba1394278c810a8136bf2
 For consistency with the rest of the extensions. Requested by SPJ.
] 
[Add the ConstraintKind extension
Max Bolingbroke <batterseapower at hotmail.com>**20110906094145
 Ignore-this: 838aa67afada51bc8f023a24531a0d0d
] 
[Fix a typo in a QA message
Duncan Coutts <duncan at community.haskell.org>**20110905001515
 Ignore-this: e906b589e4acea1121ac193998696751
] 
[Better error message for unknown build types
Duncan Coutts <duncan at community.haskell.org>**20110901114046
 Ignore-this: 91989561ff78edbe3d72b7d569db4561
] 
[Consistent import of Text.PrettyPrint
David Terei <davidterei at gmail.com>**20110825180411
 Ignore-this: 785b7c0aaad8b997678c1e68b90502f8
] 
[Drop assertion checking in the old solver
Duncan Coutts <duncan at community.haskell.org>**20110818172118
 Ignore-this: a516461e7f19e2aa2109fc905ac85
 Make it a bit faster.
] 
[Update version constraint on the Cabal library, for 1.12 release.
Duncan Coutts <duncan at community.haskell.org>**20110818171955
 Ignore-this: 870a523382e1e0cec2b5cd033c778359
] 
[Add cabal sdist --zip flag for creating zip archives
Duncan Coutts <duncan at community.haskell.org>**20110818171721
 Ignore-this: 86469c0f4f4b72d58b6278c3ef692901
 Handy if you want to send sources to people who do not grok .tar.gz
 Requires that the 'zip' program be installed (unlike for .tar.gz where
 we do it internally so that it works on all systems).
] 
[Relax cabal-install's deps for ghc-7.2
Duncan Coutts <duncan at community.haskell.org>**20110812110846
 Ignore-this: 1524732bffa5cc04e5d475ec4c4f12d8
] 
[Fix the repo location
Duncan Coutts <duncan at community.haskell.org>**20110812110820
 Ignore-this: 1ed9152864fc3336c82495904b1e5612
] 
[Improve the error message emitted when multiple .cabal files are found
Duncan Coutts <duncan at community.haskell.org>**20110508223014
 Ignore-this: 1c96d4f42fe55094f07b0573bb80fda1
] 
[Add Safe Haskell flags to known extensions
David Terei <davidterei at gmail.com>**20110810201543
 Ignore-this: 9e0a42de1539e1a56d72f9a7ecdf554c
] 
[Change trusted property to be true by default
David Terei <davidterei at gmail.com>**20110808223228
 Ignore-this: c46cf169c46b809cf457678f77e02b20
] 
[Fix for intra-package build-tools dependencies
Duncan Coutts <duncan at community.haskell.org>**20110808165045
 Ignore-this: 83f148981c7d8d3c616027975ee8f59a
] 
[Simplify some code in Program.Hpc slightly
Duncan Coutts <duncan at community.haskell.org>**20110726001531
 Ignore-this: d7ea77d1f072f7071fc709e0c9a38ded
] 
[Added Distribution.Simple.Program.Hpc.
Thomas Tuegel <ttuegel at gmail.com>**20110719004251
 Ignore-this: a988f4262e4f52c8ae0a3ca5715a636e
] 
[Restore graceful failure upon invoking "cabal test" before "cabal build".
Thomas Tuegel <ttuegel at gmail.com>**20110719002218
 Ignore-this: 2096a4cfad17eb67ef26bb15a8b3a066
] 
[Fix executable test suite unit test for improved HPC interface.
Thomas Tuegel <ttuegel at gmail.com>**20110718033150
 Ignore-this: b543b01721940b23aac7bd46282425b1
] 
[Generate aggregate coverage statistics from all test suites in package.
Thomas Tuegel <ttuegel at gmail.com>**20110718050448
 Ignore-this: bff5f3167ab61da015b8fcb7c4f77cdc
] 
[Invoke HPC using D.S.Program utilities.
Thomas Tuegel <ttuegel at gmail.com>**20110718045949
 Ignore-this: 37e1f01f594dd522c5328b397ac0e94d
 This patch also reorganizes the HPC output directories for consistency. All
 files related to HPC are now located in the "dist/hpc" directory.
] 
[Fix cabal haddock for packages with internal dependencies
Duncan Coutts <duncan at community.haskell.org>**20110718235728
 Ignore-this: 86cdab6325a86875e9ae592881b4f54f
] 
[Update cabal sdist to follow the changes in the Cabal lib
Duncan Coutts <duncan at community.haskell.org>**20110717223648
 Ignore-this: 1136aa98cb024a10250ea75ec8633a2c
] 
[Added unit test for test options.
Thomas Tuegel <ttuegel at gmail.com>**20110521164529
 Ignore-this: 3dc94c06cdfacf20cf000682370fbf3
] 
[Fixed crash on Windows due to file handle leak.
Thomas Tuegel <ttuegel at gmail.com>**20110518030422
 Ignore-this: c94eb903aef9ffcf52394a821d245dda
 Ticket #843. Cabal test crashed when trying to delete a temporary log file
 because 'readFile' reads unnecessarily lazily and was keeping a file handle
 open during attempted deletion. This patch forces the entire file to be read
 so the handle will be closed.
] 
[Stop cabal-install from duplicating test options.
Thomas Tuegel <ttuegel at gmail.com>**20110521232047
 Ignore-this: 55b98ab47306178e355cacedc7a5a6d2
] 
[Fix use of multiple test options.
Thomas Tuegel <ttuegel at gmail.com>**20110521223029
 Ignore-this: c694ad21faab23abb7157ccec700ccf2
] 
[Don't prefix test output with ">>>".
Thomas Tuegel <ttuegel at gmail.com>**20110708035007
 Ignore-this: a9d417eb836c641339a0203d1c36e82e
 Ticket #848. Removing the prefix brings "cabal test" in line with other cabal
 commands, which do not prefix their output, either. Prior to this patch, the
 summary notices which appear before and after each test suite were written to
 the temporary log file along with the stdio from the test executable; this would
 lead to duplicate notices when the contents of the temporary log file are read
 onto the console. After this patch, the summary notices are never written to the
 temporary log file, only to the console and the final log file (which is never
 read by Cabal), removing the confusing duplicate notices.
] 
[Fail gracefully when running "setup test" before "setup build".
Thomas Tuegel <ttuegel at gmail.com>**20110303164611
 Ignore-this: a4d818cd7702ddbbbbffc8679abeb85d
] 
[Bump cabal-install version
Duncan Coutts <duncan at community.haskell.org>**20110708013248
 Ignore-this: 16626faad564787fc5ae3808d1e6ccc9
] 
[Bump Cabal lib version
Duncan Coutts <duncan at community.haskell.org>**20110708013245
 Ignore-this: e01c7efbb68856167c227ba118ddce33
] 
[Couple of trivial code changes
Duncan Coutts <duncan at community.haskell.org>**20110708013012
 Ignore-this: b98aaac9e33f8c684cefedcd05d37ee2
] 
[Fix withComponentsLBI and move Components to LocalBuildInfo module
Duncan Coutts <duncan at community.haskell.org>**20110708012122
 Ignore-this: 57217119f7825c9bcd3824a34ecd0c8f
 An annoyance of the current Simple build system is that each phase
 (build, install, etc) can be passed additional HookedBuildInfo which
 gets merged into the PackageDescription. This means that we cannot
 process the PackageDescription up front at configure time and just
 store and reuse it later, we have to work from it each time afresh.
 
 The recent addition of Components (libs, exes, test suites) and a
 topoligical sort of the components in the LocalBuildInfo fell foul
 of this annoyance. The LocalBuildInfo stored the entire component
 which meant they were not updated with the HookedBuildInfo. This
 broke packages with custom Setup.hs scripts that took advantage of
 the HookedBuildInfo feature, including those with configure scripts.
 
 The solution is to store not the list of whole components but the
 list of component names. Then withComponentsLBI retrieves the actual
 components from the PackageDescription which thus includes the
 HookedBuildInfo.
 
 Also moved the Components into an internal module because (for the
 moment at least) it is part of the Simple build system, not part of
 the package description.
] 
[Relax some dependencies
Ian Lynagh <igloo at earth.li>**20110706192619
 Ignore-this: 6353c1d64a2fff3cef3ca0d8a9f2e95e
] 
[Add files needed by the GHC build system
Ian Lynagh <igloo at earth.li>**20110624003654
 Ignore-this: a40dd98104e994d1a1648c3ce2676a45
] 
[Add a dash separator for pid in createTempDirectory and openBinaryTempFile too
Jens Petersen <juhp at community.haskell.org>**20110519021658
 Ignore-this: ee0c842388212326579309ac6f93408f
] 
[Update changelog for 1.10.2.0
Duncan Coutts <duncan at community.haskell.org>**20110618190748
 Ignore-this: 64129f45dd16d2d93c82097530dc15d1
] 
[TAG cabal-install merged
Duncan Coutts <duncan at community.haskell.org>**20110619135228
 Ignore-this: 58d670de46a24046d0b869dc2b88e13a
 We now have both the Cabal library and the cabal-install tool
 together in the same repo, each in a subdir.
     
 The idea is that this will make splitting packages and moving
 code between package rather easier in future.
] 
Patch bundle hash:
9605b0075266518b6c4a8dc930335448cda25fcb


More information about the cabal-devel mailing list