Command.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Init.Command
-- Copyright   :  (c) Brent Yorgey 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Implementation of the 'cabal init' command, which creates an initial .cabal
-- file for a project.
--
-----------------------------------------------------------------------------

module Distribution.Client.Init.Command (

    -- * Commands
    initCabal
  , incVersion

  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude hiding (empty)

import System.IO
  ( hSetBuffering, stdout, BufferMode(..) )
import System.Directory
  ( getCurrentDirectory, doesDirectoryExist, getDirectoryContents )
import System.FilePath
  ( (</>), takeBaseName, equalFilePath )

import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Control.Monad
  ( (>=>) )
import Control.Arrow
  ( (&&&), (***) )

import Distribution.CabalSpecVersion
  ( CabalSpecVersion (..), showCabalSpecVersion )
import Distribution.Version
  ( Version, mkVersion, alterVersion, majorBoundVersion
  , orLaterVersion, earlierVersion, intersectVersionRanges, VersionRange )
import Distribution.ModuleName
  ( ModuleName )  -- And for the Text instance
import Distribution.InstalledPackageInfo
  ( InstalledPackageInfo, exposed )
import qualified Distribution.Package as P
import qualified Distribution.SPDX as SPDX
import Language.Haskell.Extension ( Language(..) )

import Distribution.Client.Init.Defaults
  ( defaultApplicationDir, defaultCabalVersion, myLibModule, defaultSourceDir )
import Distribution.Client.Init.FileCreators
  ( writeLicense, writeChangeLog, createDirectories, createLibHs, createMainHs
  , createTestSuiteIfEligible, writeCabalFile )
import Distribution.Client.Init.Prompt
  ( prompt, promptYesNo, promptStr, promptList, maybePrompt
  , promptListOptional )
import Distribution.Client.Init.Utils
  ( eligibleForTestSuite,  message )
import Distribution.Client.Init.Types
  ( InitFlags(..), PackageType(..), Category(..)
  , displayPackageType )
import Distribution.Client.Init.Heuristics
  ( guessPackageName, guessAuthorNameMail, guessMainFileCandidates,
    SourceFileEntry(..),
    scanForModules, neededBuildPrograms )

import Distribution.Simple.Flag
  ( maybeToFlag )
import Distribution.Simple.Setup
  ( Flag(..), flagToMaybe )
import Distribution.Simple.Configure
  ( getInstalledPackages )
import Distribution.Simple.Compiler
  ( PackageDBStack, Compiler )
import Distribution.Simple.Program
  ( ProgramDb )
import Distribution.Simple.PackageIndex
  ( InstalledPackageIndex, moduleNameIndex )

import Distribution.Solver.Types.PackageIndex
  ( elemByPackageName )

import Distribution.Client.IndexUtils
  ( getSourcePackages )
import Distribution.Client.Types
  ( SourcePackageDb(..) )
import Distribution.Client.Setup
  ( RepoContext(..) )

initCabal :: Verbosity
          -> PackageDBStack
          -> RepoContext
          -> Compiler
          -> ProgramDb
          -> InitFlags
          -> IO ()
initCabal verbosity packageDBs repoCtxt comp progdb initFlags = do

  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
  sourcePkgDb <- getSourcePackages verbosity repoCtxt

  hSetBuffering stdout NoBuffering

  initFlags' <- extendFlags installedPkgIndex sourcePkgDb initFlags

  case license initFlags' of
    Flag SPDX.NONE -> return ()
    _              -> writeLicense initFlags'
  writeChangeLog initFlags'
  createDirectories (sourceDirs initFlags')
  createLibHs initFlags'
  createDirectories (applicationDirs initFlags')
  createMainHs initFlags'
  createTestSuiteIfEligible initFlags'
  success <- writeCabalFile initFlags'

  when success $ generateWarnings initFlags'

---------------------------------------------------------------------------
--  Flag acquisition  -----------------------------------------------------
---------------------------------------------------------------------------

-- | Fill in more details in InitFlags by guessing, discovering, or prompting
-- the user.
extendFlags :: InstalledPackageIndex -> SourcePackageDb -> InitFlags -> IO InitFlags
extendFlags pkgIx sourcePkgDb =
      getSimpleProject
  >=> getLibOrExec
  >=> getCabalVersion
  >=> getPackageName sourcePkgDb
  >=> getVersion
  >=> getLicense
  >=> getAuthorInfo
  >=> getHomepage
  >=> getSynopsis
  >=> getCategory
  >=> getExtraSourceFiles
  >=> getAppDir
  >=> getSrcDir
  >=> getGenTests
  >=> getTestDir
  >=> getLanguage
  >=> getGenComments
  >=> 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.
infixr 1 ?>>
(?>>) :: IO (Maybe a) -> IO (Maybe a) -> IO (Maybe a)
f ?>> g = do
  ma <- f
  if isJust ma
    then return ma
    else g

-- | Ask if a simple project with sensible defaults should be created.
getSimpleProject :: InitFlags -> IO InitFlags
getSimpleProject flags = do
  simpleProj <-     return (flagToMaybe $ simpleProject flags)
                ?>> maybePrompt flags
                    (promptYesNo
                      "Should I generate a simple project with sensible defaults"
                      (Just True))
  return $ case maybeToFlag simpleProj of
    Flag True ->
      flags { interactive = Flag False
            , simpleProject = Flag True
            , packageType = Flag LibraryAndExecutable
            , cabalVersion = Flag defaultCabalVersion
            }
    simpleProjFlag@_ ->
      flags { simpleProject = simpleProjFlag }


-- | Get the version of the cabal spec to use.
--
-- The spec version can be specified by the InitFlags cabalVersion field. If
-- none is specified then the user is prompted to pick from a list of
-- supported versions (see code below).
getCabalVersion :: InitFlags -> IO InitFlags
getCabalVersion flags = do
  cabVer <-     return (flagToMaybe $ cabalVersion flags)
            ?>> maybePrompt flags (either (const defaultCabalVersion) id `fmap`
                                  promptList "Please choose version of the Cabal specification to use"
                                  [CabalSpecV1_10, CabalSpecV2_0, CabalSpecV2_2, CabalSpecV2_4, CabalSpecV3_0]
                                  (Just defaultCabalVersion) displayCabalVersion False)
            ?>> return (Just defaultCabalVersion)

  return $  flags { cabalVersion = maybeToFlag cabVer }

  where
    displayCabalVersion :: CabalSpecVersion -> String
    displayCabalVersion v = case v of
      CabalSpecV1_10 -> "1.10   (legacy)"
      CabalSpecV2_0  -> "2.0    (+ support for Backpack, internal sub-libs, '^>=' operator)"
      CabalSpecV2_2  -> "2.2    (+ support for 'common', 'elif', redundant commas, SPDX)"
      CabalSpecV2_4  -> "2.4    (+ support for '**' globbing)"
      CabalSpecV3_0  -> "3.0    (+ set notation for ==, common stanzas in ifs, more redundant commas, better pkgconfig-depends)"
      _              -> showCabalSpecVersion v



-- | Get the package name: use the package directory (supplied, or the current
--   directory by default) as a guess. It looks at the SourcePackageDb to avoid
--   using an existing package name.
getPackageName :: SourcePackageDb -> InitFlags -> IO InitFlags
getPackageName sourcePkgDb flags = do
  guess    <-     traverse guessPackageName (flagToMaybe $ packageDir flags)
              ?>> Just `fmap` (getCurrentDirectory >>= guessPackageName)

  let guess' | isPkgRegistered guess = Nothing
             | otherwise = guess

  pkgName' <-     return (flagToMaybe $ packageName flags)
              ?>> maybePrompt flags (prompt "Package name" guess')
              ?>> return guess'

  chooseAgain <- if isPkgRegistered pkgName'
                    then promptYesNo promptOtherNameMsg (Just True)
                    else return False

  if chooseAgain
    then getPackageName sourcePkgDb flags
    else return $ flags { packageName = maybeToFlag pkgName' }

  where
    isPkgRegistered (Just pkg) = elemByPackageName (packageIndex sourcePkgDb) pkg
    isPkgRegistered Nothing    = False

    promptOtherNameMsg = "This package name is already used by another " ++
                         "package on hackage. Do you want to choose a " ++
                         "different name"

-- | Package version: use 0.1.0.0 as a last resort, but try prompting the user
--  if possible.
getVersion :: InitFlags -> IO InitFlags
getVersion flags = do
  let v = Just $ mkVersion [0,1,0,0]
  v' <-     return (flagToMaybe $ version flags)
        ?>> maybePrompt flags (prompt "Package version" v)
        ?>> return v
  return $ flags { version = maybeToFlag v' }

-- | Choose a license for the package.
--
-- The license can come from Initflags (license field), if it is not present
-- then prompt the user from a predefined list of licenses.
getLicense :: InitFlags -> IO InitFlags
getLicense flags = do
  elic <- return (fmap Right $ flagToMaybe $ license flags)
      ?>> maybePrompt flags (promptList "Please choose a license" listedLicenses (Just SPDX.NONE) prettyShow True)

  case elic of
      Nothing          -> return flags { license = NoFlag }
      Just (Right lic) -> return flags { license = Flag lic }
      Just (Left str)  -> case eitherParsec str of
          Right lic -> return flags { license = Flag lic }
          -- on error, loop
          Left err -> do
              putStrLn "The license must be a valid SPDX expression."
              putStrLn err
              getLicense flags
  where
    -- perfectly we'll have this and writeLicense (in FileCreators)
    -- in a single file
    listedLicenses =
      SPDX.NONE :
      map (\lid -> SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing))
      [ SPDX.BSD_2_Clause
      , SPDX.BSD_3_Clause
      , SPDX.Apache_2_0
      , SPDX.MIT
      , SPDX.MPL_2_0
      , SPDX.ISC

      , SPDX.GPL_2_0_only
      , SPDX.GPL_3_0_only
      , SPDX.LGPL_2_1_only
      , SPDX.LGPL_3_0_only
      , SPDX.AGPL_3_0_only

      , SPDX.GPL_2_0_or_later
      , SPDX.GPL_3_0_or_later
      , SPDX.LGPL_2_1_or_later
      , SPDX.LGPL_3_0_or_later
      , SPDX.AGPL_3_0_or_later
      ]

-- | The author's name and email. Prompt, or try to guess from an existing
--   darcs repo.
getAuthorInfo :: InitFlags -> IO InitFlags
getAuthorInfo flags = do
  (authorName, authorEmail)  <-
    (flagToMaybe *** flagToMaybe) `fmap` guessAuthorNameMail
  authorName'  <-     return (flagToMaybe $ author flags)
                  ?>> maybePrompt flags (promptStr "Author name" authorName)
                  ?>> return authorName

  authorEmail' <-     return (flagToMaybe $ email flags)
                  ?>> maybePrompt flags (promptStr "Maintainer email" authorEmail)
                  ?>> return authorEmail

  return $ flags { author = maybeToFlag authorName'
                 , email  = maybeToFlag authorEmail'
                 }

-- | Prompt for a homepage URL for the package.
getHomepage :: InitFlags -> IO InitFlags
getHomepage flags = do
  hp  <- queryHomepage
  hp' <-     return (flagToMaybe $ homepage flags)
         ?>> maybePrompt flags (promptStr "Project homepage URL" hp)
         ?>> return hp

  return $ flags { homepage = maybeToFlag hp' }

-- | Right now this does nothing, but it could be changed to do some
--   intelligent guessing.
queryHomepage :: IO (Maybe String)
queryHomepage = return Nothing     -- get default remote darcs repo?

-- | Prompt for a project synopsis.
getSynopsis :: InitFlags -> IO InitFlags
getSynopsis flags = do
  syn <-     return (flagToMaybe $ synopsis flags)
         ?>> maybePrompt flags (promptStr "Project synopsis" Nothing)

  return $ flags { synopsis = maybeToFlag syn }

-- | Prompt for a package category.
--   Note that it should be possible to do some smarter guessing here too, i.e.
--   look at the name of the top level source directory.
getCategory :: InitFlags -> IO InitFlags
getCategory flags = do
  cat <-     return (flagToMaybe $ category flags)
         ?>> fmap join (maybePrompt flags
                         (promptListOptional "Project category" [Codec ..]))
  return $ flags { category = maybeToFlag cat }

-- | Try to guess extra source files (don't prompt the user).
getExtraSourceFiles :: InitFlags -> IO InitFlags
getExtraSourceFiles flags = do
  extraSrcFiles <-     return (extraSrc flags)
                   ?>> Just `fmap` guessExtraSourceFiles flags

  return $ flags { extraSrc = extraSrcFiles }

defaultChangeLog :: FilePath
defaultChangeLog = "CHANGELOG.md"

-- | Try to guess things to include in the extra-source-files field.
--   For now, we just look for things in the root directory named
--   'readme', 'changes', or 'changelog', with any sort of
--   capitalization and any extension.
guessExtraSourceFiles :: InitFlags -> IO [FilePath]
guessExtraSourceFiles flags = do
  dir <-
    maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
  files <- getDirectoryContents dir
  let extraFiles = filter isExtra files
  if any isLikeChangeLog extraFiles
    then return extraFiles
    else return (defaultChangeLog : extraFiles)

  where
    isExtra = likeFileNameBase ("README" : changeLogLikeBases)
    isLikeChangeLog = likeFileNameBase changeLogLikeBases
    likeFileNameBase candidates = (`elem` candidates) . map toUpper . takeBaseName
    changeLogLikeBases = ["CHANGES", "CHANGELOG"]

-- | Ask whether the project builds a library or executable.
getLibOrExec :: InitFlags -> IO InitFlags
getLibOrExec flags = do
  pkgType <-     return (flagToMaybe $ packageType flags)
           ?>> maybePrompt flags (either (const Executable) id `fmap`
                                   promptList "What does the package build"
                                   [Executable, Library, LibraryAndExecutable]
                                   Nothing displayPackageType False)
           ?>> return (Just Executable)

  -- If this package contains an executable, get the main file name.
  mainFile <- if pkgType == Just Library then return Nothing else
                    getMainFile flags

  return $ flags { packageType = maybeToFlag pkgType
                 , mainIs = maybeToFlag mainFile
                 }


-- | Try to guess the main file of the executable, and prompt the user to choose
-- one of them. Top-level modules including the word 'Main' in the file name
-- will be candidates, and shorter filenames will be preferred.
getMainFile :: InitFlags -> IO (Maybe FilePath)
getMainFile flags =
  return (flagToMaybe $ mainIs flags)
  ?>> do
    candidates <- guessMainFileCandidates flags
    let showCandidate = either (++" (does not yet exist, but will be created)") id
        defaultFile = listToMaybe candidates
    maybePrompt flags (either id (either id id) `fmap`
                       promptList "What is the main module of the executable"
                       candidates
                       defaultFile showCandidate True)
      ?>> return (fmap (either id id) defaultFile)

-- | Ask if a test suite should be generated for the library.
getGenTests :: InitFlags -> IO InitFlags
getGenTests flags = do
  genTests <-     return (flagToMaybe $ initializeTestSuite flags)
                  -- Only generate a test suite if the package contains a library.
              ?>> if (packageType flags) == Flag Executable then return (Just False) else return Nothing
              ?>> maybePrompt flags
                  (promptYesNo
                    "Should I generate a test suite for the library"
                    (Just True))
  return $ flags { initializeTestSuite = maybeToFlag genTests }

-- | Ask for the test suite root directory.
getTestDir :: InitFlags -> IO InitFlags
getTestDir flags = do
  dirs <- return (testDirs flags)
              -- Only need testDirs when test suite generation is enabled.
          ?>> if not (eligibleForTestSuite flags) then return (Just []) else return Nothing
          ?>> fmap (fmap ((:[]) . either id id)) (maybePrompt
                   flags
                   (promptList "Test directory" ["test"] (Just "test") id True))

  return $ flags { testDirs = dirs }

-- | Ask for the Haskell base language of the package.
getLanguage :: InitFlags -> IO InitFlags
getLanguage flags = do
  lang <-     return (flagToMaybe $ language flags)
          ?>> maybePrompt flags
                (either UnknownLanguage id `fmap`
                  promptList "What base language is the package written in"
                  [Haskell2010, Haskell98]
                  (Just Haskell2010) prettyShow True)
          ?>> return (Just Haskell2010)

  if invalidLanguage lang
    then putStrLn invalidOtherLanguageMsg >> getLanguage flags
    else return $ flags { language = maybeToFlag lang }

  where
    invalidLanguage (Just (UnknownLanguage t)) = any (not . isAlphaNum) t
    invalidLanguage _ = False

    invalidOtherLanguageMsg = "\nThe language must be alphanumeric. " ++
                              "Please enter a different language."

-- | Ask whether to generate explanatory comments.
getGenComments :: InitFlags -> IO InitFlags
getGenComments flags = do
  genComments <-     return (not <$> flagToMaybe (noComments flags))
                 ?>> maybePrompt flags (promptYesNo promptMsg (Just False))
                 ?>> return (Just False)
  return $ flags { noComments = maybeToFlag (fmap not genComments) }
  where
    promptMsg = "Add informative comments to each field in the cabal file (y/n)"

-- | Ask for the application root directory.
getAppDir :: InitFlags -> IO InitFlags
getAppDir flags = do
  appDirs <-
    return (applicationDirs flags)
    ?>> noAppDirIfLibraryOnly
    ?>> guessAppDir flags
    ?>> promptUserForApplicationDir
    ?>> setDefault
  return $ flags { applicationDirs = appDirs }

  where
    -- If the packageType==Library, then there is no application dir.
    noAppDirIfLibraryOnly :: IO (Maybe [String])
    noAppDirIfLibraryOnly =
      if (packageType flags) == Flag Library
      then return (Just [])
      else return Nothing

    -- Set the default application directory.
    setDefault :: IO (Maybe [String])
    setDefault = pure (Just [defaultApplicationDir])

    -- Prompt the user for the application directory (defaulting to "app").
    -- Returns 'Nothing' if in non-interactive mode, otherwise will always
    -- return a 'Just' value ('Just []' if no separate application directory).
    promptUserForApplicationDir :: IO (Maybe [String])
    promptUserForApplicationDir = fmap (either (:[]) id) <$> maybePrompt
      flags
      (promptList
       ("Application " ++ mainFile ++ "directory")
       [[defaultApplicationDir], ["src-exe"], []]
        (Just [defaultApplicationDir])
       showOption True)

    showOption :: [String] -> String
    showOption [] = "(none)"
    showOption (x:_) = x

    -- The name
    mainFile :: String
    mainFile = case mainIs flags of
      Flag mainPath -> "(" ++ mainPath ++ ") "
      _             -> ""

-- | Try to guess app directory. Could try harder; for the
--   moment just looks to see whether there is a directory called 'app'.
guessAppDir :: InitFlags -> IO (Maybe [String])
guessAppDir flags = do
  dir      <- maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
  appIsDir <- doesDirectoryExist (dir </> "app")
  return $ if appIsDir
             then Just ["app"]
             else Nothing

-- | Ask for the source (library) root directory.
getSrcDir :: InitFlags -> IO InitFlags
getSrcDir flags = do
  srcDirs <-
    return (sourceDirs flags)
    ?>> noSourceDirIfExecutableOnly
    ?>> guessSourceDir flags
    ?>> promptUserForSourceDir
    ?>> setDefault

  return $ flags { sourceDirs = srcDirs }

  where
    -- If the packageType==Executable, then there is no source dir.
    noSourceDirIfExecutableOnly :: IO (Maybe [String])
    noSourceDirIfExecutableOnly =
      if (packageType flags) == Flag Executable
      then return (Just [])
      else return Nothing

    -- Set the default source directory.
    setDefault :: IO (Maybe [String])
    setDefault = pure (Just [defaultSourceDir])

    -- Prompt the user for the source directory (defaulting to "app").
    -- Returns 'Nothing' if in non-interactive mode, otherwise will always
    -- return a 'Just' value ('Just []' if no separate application directory).
    promptUserForSourceDir :: IO (Maybe [String])
    promptUserForSourceDir = fmap (either (:[]) id) <$> maybePrompt
      flags
      (promptList
       ("Library source directory")
       [[defaultSourceDir], ["lib"], ["src-lib"], []]
        (Just [defaultSourceDir])
       showOption True)

    showOption :: [String] -> String
    showOption [] = "(none)"
    showOption (x:_) = x


-- | Try to guess source directory. Could try harder; for the
--   moment just looks to see whether there is a directory called 'src'.
guessSourceDir :: InitFlags -> IO (Maybe [String])
guessSourceDir flags = do
  dir      <-
    maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
  srcIsDir <- doesDirectoryExist (dir </> "src")
  return $ if srcIsDir
             then Just ["src"]
             else Nothing

-- | Check whether a potential source file is located in one of the
--   source directories.
isSourceFile :: Maybe [FilePath] -> SourceFileEntry -> Bool
isSourceFile Nothing        sf = isSourceFile (Just ["."]) sf
isSourceFile (Just srcDirs) sf = any (equalFilePath (relativeSourcePath sf)) srcDirs

-- | Get the list of exposed modules and extra tools needed to build them.
getModulesBuildToolsAndDeps :: InstalledPackageIndex -> InitFlags -> IO InitFlags
getModulesBuildToolsAndDeps pkgIx flags = do
  dir <- maybe getCurrentDirectory return . flagToMaybe $ packageDir flags

  sourceFiles0 <- scanForModules dir

  let sourceFiles = filter (isSourceFile (sourceDirs flags)) sourceFiles0

  Just mods <-      return (exposedModules flags)
           ?>> (return . Just . map moduleName $ sourceFiles)

  tools <-     return (buildTools flags)
           ?>> (return . Just . neededBuildPrograms $ sourceFiles)

  deps <-      return (dependencies flags)
           ?>> Just <$> importsToDeps flags
                        (fromString "Prelude" :  -- to ensure we get base as a dep
                           (   nub   -- only need to consider each imported package once
                             . filter (`notElem` mods)  -- don't consider modules from
                                                        -- this package itself
                             . concatMap imports
                             $ sourceFiles
                           )
                        )
                        pkgIx

  exts <-     return (otherExts flags)
          ?>> (return . Just . nub . concatMap extensions $ sourceFiles)

  -- If we're initializing a library and there were no modules discovered
  -- then create an empty 'MyLib' module.
  -- This gets a little tricky when 'sourceDirs' == 'applicationDirs' because
  -- then the executable needs to set 'other-modules: MyLib' or else the build
  -- fails.
  let (finalModsList, otherMods) = case (packageType flags, mods) of

        -- For an executable leave things as they are.
        (Flag Executable, _) -> (mods, otherModules flags)

        -- If a non-empty module list exists don't change anything.
        (_, (_:_)) -> (mods, otherModules flags)

        -- Library only: 'MyLib' in 'other-modules' only.
        (Flag Library, _) -> ([myLibModule], Nothing)

        -- For a 'LibraryAndExecutable' we need to have special handling.
        -- If we don't have a module list (Nothing or empty), then create a Lib.
        (_, []) ->
          if sourceDirs flags == applicationDirs flags
          then ([myLibModule], Just [myLibModule])
          else ([myLibModule], Nothing)

  return $ flags { exposedModules = Just finalModsList
                 , otherModules   = otherMods
                 , buildTools     = tools
                 , dependencies   = deps
                 , otherExts      = exts
                 }

-- | Given a list of imported modules, retrieve the list of dependencies that
-- provide those modules.
importsToDeps :: InitFlags -> [ModuleName] -> InstalledPackageIndex -> 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 <$> traverse (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 " ++ prettyShow m ++ ".")
    >> return Nothing

chooseDep flags (m, Just [])
  = message flags ("\nWarning: no package found providing " ++ prettyShow 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 "
                                 ++ prettyShow m
                                 ++ ": " ++ intercalate ", " (fmap (prettyShow . P.pkgName . NE.head) grps))
                  message flags "You will need to pick one and manually add it to the Build-depends: field."
                  return Nothing
  where
    pkgGroups = NE.groupBy ((==) `on` P.pkgName) (map P.packageId ps)

    desugar = maybe True (< CabalSpecV2_0) $ flagToMaybe (cabalVersion flags)

    -- Given a list of available versions of the same package, pick a dependency.
    toDep :: NonEmpty 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 desugar . P.pkgVersion $ pid) P.mainLibSet --TODO sublibraries

    -- Otherwise, choose the latest version and issue a warning.
    toDep pids  = do
      message flags ("\nWarning: multiple versions of " ++ prettyShow (P.pkgName . NE.head $ pids) ++ " provide " ++ prettyShow m ++ ", choosing the latest.")
      return $ P.Dependency (P.pkgName . NE.head $ pids)
                            (pvpize desugar . maximum . fmap P.pkgVersion $ pids)
                            P.mainLibSet --TODO take into account sublibraries

-- | Given a version, return an API-compatible (according to PVP) version range.
--
-- If the boolean argument denotes whether to use a desugared
-- representation (if 'True') or the new-style @^>=@-form (if
-- 'False').
--
-- Example: @pvpize True (mkVersion [0,4,1])@ produces the version range @>= 0.4 && < 0.5@ (which is the
-- same as @0.4.*@).
pvpize :: Bool -> Version -> VersionRange
pvpize False  v = majorBoundVersion v
pvpize True   v = orLaterVersion v'
           `intersectVersionRanges`
           earlierVersion (incVersion 1 v')
  where v' = alterVersion (take 2) v

-- | Increment the nth version component (counting from 0).
incVersion :: Int -> Version -> Version
incVersion n = alterVersion (incVersion' n)
  where
    incVersion' 0 []     = [1]
    incVersion' 0 (v:_)  = [v+1]
    incVersion' m []     = replicate m 0 ++ [1]
    incVersion' m (v:vs) = v : incVersion' (m-1) vs

-- | Generate warnings for missing fields etc.
generateWarnings :: InitFlags -> IO ()
generateWarnings flags = do
  message flags ""
  when (synopsis flags `elem` [NoFlag, Flag ""])
       (message flags "Warning: no synopsis given. You should edit the .cabal file and add one.")

  message flags "You may want to edit the .cabal file and add a Description field."