{-# LANGUAGE RecordWildCards #-}

module Distribution.Client.Init.Utils
( SourceFileEntry(..)
, retrieveSourceFiles
, retrieveModuleName
, retrieveModuleImports
, retrieveModuleExtensions
, retrieveBuildTools
, retrieveDependencies
, isMain
, isHaskell
, isSourceFile
, trim
, currentDirPkgName
, filePathToPkgName
, mkPackageNameDep
, fixupDocFiles
, mkStringyDep
, getBaseDep
, addLibDepToExe
, addLibDepToTest
) where


import qualified Prelude ()
import Distribution.Client.Compat.Prelude hiding (putStrLn, empty, readFile, Parsec, many)
import Distribution.Utils.Generic (isInfixOf, safeLast)

import Control.Monad (forM)

import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Language.Haskell.Extension (Extension(..))
import System.FilePath

import Distribution.CabalSpecVersion (CabalSpecVersion(..))
import Distribution.ModuleName (ModuleName)
import Distribution.InstalledPackageInfo (InstalledPackageInfo, exposed)
import qualified Distribution.Package as P
import Distribution.Simple.PackageIndex (InstalledPackageIndex, moduleNameIndex)
import Distribution.Simple.Setup (Flag(..))
import Distribution.Utils.String (trim)
import Distribution.Version
import Distribution.Client.Init.Defaults
import Distribution.Client.Init.Types
import Distribution.Client.Utils (pvpize)
import Distribution.Types.PackageName
import Distribution.Types.Dependency (Dependency, mkDependency)
import qualified Distribution.Compat.NonEmptySet as NES
import Distribution.Types.LibraryName
import Distribution.Verbosity (silent)


-- |Data type of source files found in the working directory
data SourceFileEntry = SourceFileEntry
    { SourceFileEntry -> FilePath
relativeSourcePath :: FilePath
    , SourceFileEntry -> ModuleName
moduleName         :: ModuleName
    , SourceFileEntry -> FilePath
fileExtension      :: String
    , SourceFileEntry -> [ModuleName]
imports            :: [ModuleName]
    , SourceFileEntry -> [Extension]
extensions         :: [Extension]
    } deriving Int -> SourceFileEntry -> ShowS
[SourceFileEntry] -> ShowS
SourceFileEntry -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SourceFileEntry] -> ShowS
$cshowList :: [SourceFileEntry] -> ShowS
show :: SourceFileEntry -> FilePath
$cshow :: SourceFileEntry -> FilePath
showsPrec :: Int -> SourceFileEntry -> ShowS
$cshowsPrec :: Int -> SourceFileEntry -> ShowS
Show

-- Unfortunately we cannot use the version exported by Distribution.Simple.Program
knownSuffixHandlers :: CabalSpecVersion -> String -> String
knownSuffixHandlers :: CabalSpecVersion -> ShowS
knownSuffixHandlers CabalSpecVersion
v FilePath
s
  | CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV3_0 = case FilePath
s of
      FilePath
".gc" -> FilePath
"greencard"
      FilePath
".chs" -> FilePath
"chs"
      FilePath
".hsc" -> FilePath
"hsc2hs"
      FilePath
".x" -> FilePath
"alex"
      FilePath
".y" -> FilePath
"happy"
      FilePath
".ly" -> FilePath
"happy"
      FilePath
".cpphs" -> FilePath
"cpp"
      FilePath
_ -> FilePath
""
  | Bool
otherwise = case FilePath
s of
      FilePath
".gc" -> FilePath
"greencard:greencard"
      FilePath
".chs" -> FilePath
"chs:chs"
      FilePath
".hsc" -> FilePath
"hsc2hs:hsc2hs"
      FilePath
".x" -> FilePath
"alex:alex"
      FilePath
".y" -> FilePath
"happy:happy"
      FilePath
".ly" -> FilePath
"happy:happy"
      FilePath
".cpphs" -> FilePath
"cpp:cpp"
      FilePath
_ -> FilePath
""


-- | Check if a given file has main file characteristics
isMain :: String -> Bool
isMain :: FilePath -> Bool
isMain FilePath
f = (forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
"Main" FilePath
f Bool -> Bool -> Bool
|| forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
"main" FilePath
f)
         Bool -> Bool -> Bool
&& forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".hs" FilePath
f Bool -> Bool -> Bool
|| forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".lhs" FilePath
f

-- | Check if a given file has a Haskell extension
isHaskell :: String -> Bool
isHaskell :: FilePath -> Bool
isHaskell FilePath
f = forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".hs" FilePath
f Bool -> Bool -> Bool
|| forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".lhs" FilePath
f

isBuildTool :: CabalSpecVersion -> String -> Bool
isBuildTool :: CabalSpecVersion -> FilePath -> Bool
isBuildTool CabalSpecVersion
v = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion -> ShowS
knownSuffixHandlers CabalSpecVersion
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension

retrieveBuildTools :: Interactive m => CabalSpecVersion -> FilePath -> m [Dependency]
retrieveBuildTools :: forall (m :: * -> *).
Interactive m =>
CabalSpecVersion -> FilePath -> m [Dependency]
retrieveBuildTools CabalSpecVersion
v FilePath
fp = do
  Bool
exists <- forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist FilePath
fp
  if Bool
exists
    then do
      [FilePath]
files <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
takeExtension forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => FilePath -> m [FilePath]
listFilesRecursive FilePath
fp

      let tools :: [Dependency]
tools =
            [ FilePath -> Dependency
mkStringyDep (CabalSpecVersion -> ShowS
knownSuffixHandlers CabalSpecVersion
v FilePath
f)
            | FilePath
f <- [FilePath]
files, CabalSpecVersion -> FilePath -> Bool
isBuildTool CabalSpecVersion
v FilePath
f
            ]

      forall (m :: * -> *) a. Monad m => a -> m a
return [Dependency]
tools

    else
      forall (m :: * -> *) a. Monad m => a -> m a
return []

retrieveSourceFiles :: Interactive m => FilePath -> m [SourceFileEntry]
retrieveSourceFiles :: forall (m :: * -> *).
Interactive m =>
FilePath -> m [SourceFileEntry]
retrieveSourceFiles FilePath
fp = do
  Bool
exists <- forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist FilePath
fp
  if Bool
exists
    then do
      [FilePath]
files <- forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isHaskell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => FilePath -> m [FilePath]
listFilesRecursive FilePath
fp

      [Maybe SourceFileEntry]
entries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
files forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
        Bool
exists' <- forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesFileExist FilePath
f
        if Bool
exists'
          then do
            Maybe ModuleName
maybeModuleName <- forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe ModuleName)
retrieveModuleName FilePath
f
            case Maybe ModuleName
maybeModuleName of
              Maybe ModuleName
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
              Just ModuleName
moduleName -> do

                let fileExtension :: FilePath
fileExtension   = ShowS
takeExtension FilePath
f
                FilePath
relativeSourcePath <- FilePath -> ShowS
makeRelative FilePath
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory
                [ModuleName]
imports            <- forall (m :: * -> *). Interactive m => FilePath -> m [ModuleName]
retrieveModuleImports FilePath
f
                [Extension]
extensions         <- forall (m :: * -> *). Interactive m => FilePath -> m [Extension]
retrieveModuleExtensions FilePath
f

                forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SourceFileEntry {FilePath
[Extension]
[ModuleName]
ModuleName
extensions :: [Extension]
imports :: [ModuleName]
relativeSourcePath :: FilePath
fileExtension :: FilePath
moduleName :: ModuleName
extensions :: [Extension]
imports :: [ModuleName]
fileExtension :: FilePath
moduleName :: ModuleName
relativeSourcePath :: FilePath
..}
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ [Maybe SourceFileEntry]
entries

  else
    forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Given a module, retrieve its name
retrieveModuleName :: Interactive m => FilePath -> m (Maybe ModuleName)
retrieveModuleName :: forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe ModuleName)
retrieveModuleName FilePath
m = do
    FilePath
rawModule <- ShowS
trim forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
grabModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => FilePath -> m FilePath
readFile FilePath
m

    if forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
rawModule (ShowS
dirToModuleName FilePath
m)
      then
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsString a => FilePath -> a
fromString FilePath
rawModule
      else do
        forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn
          forall a b. (a -> b) -> a -> b
$ FilePath
"Warning: found module that doesn't match directory structure: "
          forall a. [a] -> [a] -> [a]
++ FilePath
rawModule
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  where
    dirToModuleName :: ShowS
dirToModuleName = forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'\\' then Char
'.' else Char
x)

    stop :: Char -> Bool
stop Char
c = (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n') Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
' ')

    grabModuleName :: ShowS
grabModuleName [] = []
    grabModuleName (Char
'-':Char
'-':FilePath
xs) = ShowS
grabModuleName forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
dropWhile' (forall a. Eq a => a -> a -> Bool
/= Char
'\n') FilePath
xs
    grabModuleName (Char
'm':Char
'o':Char
'd':Char
'u':Char
'l':Char
'e':Char
' ':FilePath
xs) = (Char -> Bool) -> ShowS
takeWhile' Char -> Bool
stop FilePath
xs
    grabModuleName (Char
_:FilePath
xs) = ShowS
grabModuleName FilePath
xs

-- | Given a module, retrieve all of its imports
retrieveModuleImports :: Interactive m => FilePath -> m [ModuleName]
retrieveModuleImports :: forall (m :: * -> *). Interactive m => FilePath -> m [ModuleName]
retrieveModuleImports FilePath
m = do
  forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => FilePath -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
grabModuleImports forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => FilePath -> m FilePath
readFile FilePath
m

  where
    stop :: Char -> Bool
stop Char
c = (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n') Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
' ') Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'(')

    grabModuleImports :: FilePath -> [FilePath]
grabModuleImports [] = []
    grabModuleImports (Char
'-':Char
'-':FilePath
xs) = FilePath -> [FilePath]
grabModuleImports forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
dropWhile' (forall a. Eq a => a -> a -> Bool
/= Char
'\n') FilePath
xs
    grabModuleImports (Char
'i':Char
'm':Char
'p':Char
'o':Char
'r':Char
't':Char
' ':FilePath
xs) = case ShowS
trim FilePath
xs of -- in case someone uses a weird formatting
      (Char
'q':Char
'u':Char
'a':Char
'l':Char
'i':Char
'f':Char
'i':Char
'e':Char
'd':Char
' ':FilePath
ys) -> (Char -> Bool) -> ShowS
takeWhile' Char -> Bool
stop FilePath
ys forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
grabModuleImports ((Char -> Bool) -> ShowS
dropWhile' Char -> Bool
stop FilePath
ys)
      FilePath
_                                            -> (Char -> Bool) -> ShowS
takeWhile' Char -> Bool
stop FilePath
xs forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
grabModuleImports ((Char -> Bool) -> ShowS
dropWhile' Char -> Bool
stop FilePath
xs)
    grabModuleImports (Char
_:FilePath
xs) = FilePath -> [FilePath]
grabModuleImports FilePath
xs

-- | Given a module, retrieve all of its language pragmas
retrieveModuleExtensions :: Interactive m => FilePath -> m [Extension]
retrieveModuleExtensions :: forall (m :: * -> *). Interactive m => FilePath -> m [Extension]
retrieveModuleExtensions FilePath
m = do
  forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Parsec a => FilePath -> Maybe a
simpleParsec forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
grabModuleExtensions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => FilePath -> m FilePath
readFile FilePath
m

  where
    stop :: Char -> Bool
stop Char
c = (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n') Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
' ') Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
',') Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
'#')

    grabModuleExtensions :: FilePath -> [FilePath]
grabModuleExtensions [] = []
    grabModuleExtensions (Char
'-':Char
'-':FilePath
xs) = FilePath -> [FilePath]
grabModuleExtensions forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
dropWhile' (forall a. Eq a => a -> a -> Bool
/= Char
'\n') FilePath
xs
    grabModuleExtensions (Char
'L':Char
'A':Char
'N':Char
'G':Char
'U':Char
'A':Char
'G':Char
'E':FilePath
xs) = (Char -> Bool) -> ShowS
takeWhile' Char -> Bool
stop FilePath
xs forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
grabModuleExtensions' ((Char -> Bool) -> ShowS
dropWhile' Char -> Bool
stop FilePath
xs)
    grabModuleExtensions (Char
_:FilePath
xs) = FilePath -> [FilePath]
grabModuleExtensions FilePath
xs

    grabModuleExtensions' :: FilePath -> [FilePath]
grabModuleExtensions' [] = []
    grabModuleExtensions' (Char
'#':FilePath
xs) = FilePath -> [FilePath]
grabModuleExtensions FilePath
xs
    grabModuleExtensions' (Char
',':FilePath
xs) = (Char -> Bool) -> ShowS
takeWhile' Char -> Bool
stop FilePath
xs forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
grabModuleExtensions' ((Char -> Bool) -> ShowS
dropWhile' Char -> Bool
stop FilePath
xs)
    grabModuleExtensions' (Char
_:FilePath
xs) = FilePath -> [FilePath]
grabModuleExtensions FilePath
xs

takeWhile' :: (Char -> Bool) -> String -> String
takeWhile' :: (Char -> Bool) -> ShowS
takeWhile' Char -> Bool
p = forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim

dropWhile' :: (Char -> Bool) -> String -> String
dropWhile' :: (Char -> Bool) -> ShowS
dropWhile' Char -> Bool
p = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim

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

retrieveDependencies :: Interactive m => Verbosity -> InitFlags -> [(ModuleName, ModuleName)] -> InstalledPackageIndex -> m [P.Dependency]
retrieveDependencies :: forall (m :: * -> *).
Interactive m =>
Verbosity
-> InitFlags
-> [(ModuleName, ModuleName)]
-> InstalledPackageIndex
-> m [Dependency]
retrieveDependencies Verbosity
v InitFlags
flags [(ModuleName, ModuleName)]
mods' InstalledPackageIndex
pkgIx = do
  let mods :: [(ModuleName, ModuleName)]
mods = [(ModuleName, ModuleName)]
mods'

      modMap :: M.Map ModuleName [InstalledPackageInfo]
      modMap :: Map ModuleName [InstalledPackageInfo]
modMap  = forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a. (a -> Bool) -> [a] -> [a]
filter InstalledPackageInfo -> Bool
exposed) forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex -> Map ModuleName [InstalledPackageInfo]
moduleNameIndex InstalledPackageIndex
pkgIx

      modDeps :: [(ModuleName, ModuleName, Maybe [InstalledPackageInfo])]
      modDeps :: [(ModuleName, ModuleName, Maybe [InstalledPackageInfo])]
modDeps = forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
mn, ModuleName
ds) -> (ModuleName
mn, ModuleName
ds, forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
ds Map ModuleName [InstalledPackageInfo]
modMap)) [(ModuleName, ModuleName)]
mods
      -- modDeps = map (id &&& flip M.lookup modMap) mods

  forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Log FilePath
"Guessing dependencies..."
  forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
Interactive m =>
Verbosity
-> InitFlags
-> (ModuleName, ModuleName, Maybe [InstalledPackageInfo])
-> m (Maybe Dependency)
chooseDep Verbosity
v InitFlags
flags) [(ModuleName, ModuleName, Maybe [InstalledPackageInfo])]
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
  :: Interactive m
  => Verbosity
  -> InitFlags
  -> (ModuleName, ModuleName, Maybe [InstalledPackageInfo])
  -> m (Maybe P.Dependency)
chooseDep :: forall (m :: * -> *).
Interactive m =>
Verbosity
-> InitFlags
-> (ModuleName, ModuleName, Maybe [InstalledPackageInfo])
-> m (Maybe Dependency)
chooseDep Verbosity
v InitFlags
flags (ModuleName
importer, ModuleName
m, Maybe [InstalledPackageInfo]
mipi) = case Maybe [InstalledPackageInfo]
mipi of
  -- We found some packages: group them by name.
  Just ps :: [InstalledPackageInfo]
ps@(InstalledPackageInfo
_:[InstalledPackageInfo]
_) ->
    case forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (\PackageIdentifier
x PackageIdentifier
y -> PackageIdentifier -> PackageName
P.pkgName PackageIdentifier
x forall a. Eq a => a -> a -> Bool
== PackageIdentifier -> PackageName
P.pkgName PackageIdentifier
y) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> PackageIdentifier
P.packageId [InstalledPackageInfo]
ps 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.

      -- Given a list of available versions of the same package, pick a dependency.
      [NonEmpty PackageIdentifier
grp] -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case NonEmpty PackageIdentifier
grp of

        -- If only one version, easy. We change e.g. 0.4.2  into  0.4.*
        (PackageIdentifier
pid:|[]) ->
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
P.Dependency
              (PackageIdentifier -> PackageName
P.pkgName PackageIdentifier
pid)
              (Bool -> Version -> VersionRange
pvpize Bool
desugar forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> Version
P.pkgVersion forall a b. (a -> b) -> a -> b
$ PackageIdentifier
pid)
              NonEmptySet LibraryName
P.mainLibSet --TODO sublibraries

        -- Otherwise, choose the latest version and issue a warning.
        NonEmpty PackageIdentifier
pids -> do
          forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning (FilePath
"multiple versions of " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow (PackageIdentifier -> PackageName
P.pkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head forall a b. (a -> b) -> a -> b
$ NonEmpty PackageIdentifier
pids) forall a. [a] -> [a] -> [a]
++ FilePath
" provide " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m forall a. [a] -> [a] -> [a]
++ FilePath
", choosing the latest.")
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
P.Dependency
              (PackageIdentifier -> PackageName
P.pkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head forall a b. (a -> b) -> a -> b
$ NonEmpty PackageIdentifier
pids)
              (Bool -> Version -> VersionRange
pvpize Bool
desugar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageIdentifier -> Version
P.pkgVersion forall a b. (a -> b) -> a -> b
$ NonEmpty PackageIdentifier
pids)
              NonEmptySet LibraryName
P.mainLibSet --TODO take into account sublibraries

      -- if multiple packages are found, we refuse to choose between
      -- different packages and make the user do it
      [NonEmpty PackageIdentifier]
grps     -> do
        forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning (FilePath
"multiple packages found providing " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
P.pkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head) [NonEmpty PackageIdentifier]
grps))
        forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning FilePath
"You will need to pick one and manually add it to the build-depends field."
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  Maybe [InstalledPackageInfo]
_ -> do
    forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning (FilePath
"no package found providing " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m forall a. [a] -> [a] -> [a]
++ FilePath
" in " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
prettyShow ModuleName
importer forall a. [a] -> [a] -> [a]
++ FilePath
".")
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

  where
    -- desugar if cabal version lower than 2.0
    desugar :: Bool
desugar = case InitFlags -> Flag CabalSpecVersion
cabalVersion InitFlags
flags of
      Flag CabalSpecVersion
x -> CabalSpecVersion
x                   forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_0
      Flag CabalSpecVersion
NoFlag -> CabalSpecVersion
defaultCabalVersion forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_0

filePathToPkgName :: Interactive m => FilePath -> m P.PackageName
filePathToPkgName :: forall (m :: * -> *). Interactive m => FilePath -> m PackageName
filePathToPkgName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> PackageName
mkPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
repair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe FilePath
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
safeLast forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Interactive m => FilePath -> m FilePath
canonicalizePathNoThrow
  where
    -- Treat each span of non-alphanumeric characters as a hyphen. Each
    -- hyphenated component of a package name must contain at least one
    -- alphabetic character. An arbitrary character ('x') will be prepended if
    -- this is not the case for the first component, and subsequent components
    -- will simply be run together. For example, "1+2_foo-3" will become
    -- "x12-foo3".
    repair :: ShowS
repair = ShowS -> ShowS -> ShowS
repair' (Char
'x' forall a. a -> [a] -> [a]
:) forall a. a -> a
id
    repair' :: ShowS -> ShowS -> ShowS
repair' ShowS
invalid ShowS
valid FilePath
x = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum) FilePath
x of
        FilePath
"" -> ShowS
repairComponent FilePath
""
        FilePath
x' -> let (FilePath
c, FilePath
r) = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ShowS
repairComponent forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlphaNum FilePath
x'
              in FilePath
c forall a. [a] -> [a] -> [a]
++ ShowS
repairRest FilePath
r
      where
        repairComponent :: ShowS
repairComponent FilePath
c | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit FilePath
c = ShowS
invalid FilePath
c
                          | Bool
otherwise     = ShowS
valid FilePath
c
    repairRest :: ShowS
repairRest = ShowS -> ShowS -> ShowS
repair' forall a. a -> a
id (Char
'-' forall a. a -> [a] -> [a]
:)

currentDirPkgName :: Interactive m => m P.PackageName
currentDirPkgName :: forall (m :: * -> *). Interactive m => m PackageName
currentDirPkgName = forall (m :: * -> *). Interactive m => FilePath -> m PackageName
filePathToPkgName forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory

mkPackageNameDep :: PackageName -> Dependency
mkPackageNameDep :: PackageName -> Dependency
mkPackageNameDep PackageName
pkg = PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
mkDependency PackageName
pkg VersionRange
anyVersion (forall a. a -> NonEmptySet a
NES.singleton LibraryName
LMainLibName)

-- when cabal-version < 1.18, extra-doc-files is not supported
-- so whatever the user wants as doc files should be dumped into
-- extra-src-files.
--
fixupDocFiles :: Interactive m => Verbosity -> PkgDescription -> m PkgDescription
fixupDocFiles :: forall (m :: * -> *).
Interactive m =>
Verbosity -> PkgDescription -> m PkgDescription
fixupDocFiles Verbosity
v PkgDescription
pkgDesc
  | PkgDescription -> CabalSpecVersion
_pkgCabalVersion PkgDescription
pkgDesc forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_18 = do
    forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ FilePath
"Cabal spec versions < 1.18 do not support extra-doc-files. "
      , FilePath
"Doc files will be treated as extra-src-files."
      ]

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PkgDescription
pkgDesc
      { _pkgExtraSrcFiles :: Set FilePath
_pkgExtraSrcFiles =PkgDescription -> Set FilePath
_pkgExtraSrcFiles PkgDescription
pkgDesc
        forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (PkgDescription -> Maybe (Set FilePath)
_pkgExtraDocFiles PkgDescription
pkgDesc)
      , _pkgExtraDocFiles :: Maybe (Set FilePath)
_pkgExtraDocFiles = forall a. Maybe a
Nothing
      }
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return PkgDescription
pkgDesc

mkStringyDep :: String -> Dependency
mkStringyDep :: FilePath -> Dependency
mkStringyDep = PackageName -> Dependency
mkPackageNameDep forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PackageName
mkPackageName


getBaseDep :: Interactive m => InstalledPackageIndex -> InitFlags -> m [Dependency]
getBaseDep :: forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
getBaseDep InstalledPackageIndex
pkgIx InitFlags
flags = forall (m :: * -> *).
Interactive m =>
Verbosity
-> InitFlags
-> [(ModuleName, ModuleName)]
-> InstalledPackageIndex
-> m [Dependency]
retrieveDependencies Verbosity
silent InitFlags
flags
  [(forall a. IsString a => FilePath -> a
fromString FilePath
"Prelude", forall a. IsString a => FilePath -> a
fromString FilePath
"Prelude")] InstalledPackageIndex
pkgIx

-- Add package name as dependency of test suite
--
addLibDepToTest :: PackageName -> Maybe TestTarget -> Maybe TestTarget
addLibDepToTest :: PackageName -> Maybe TestTarget -> Maybe TestTarget
addLibDepToTest PackageName
_ Maybe TestTarget
Nothing = forall a. Maybe a
Nothing
addLibDepToTest PackageName
n (Just TestTarget
t) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TestTarget
t
  { _testDependencies :: [Dependency]
_testDependencies = TestTarget -> [Dependency]
_testDependencies TestTarget
t forall a. [a] -> [a] -> [a]
++ [PackageName -> Dependency
mkPackageNameDep PackageName
n]
  }

-- Add package name as dependency of executable
--
addLibDepToExe :: PackageName -> ExeTarget -> ExeTarget
addLibDepToExe :: PackageName -> ExeTarget -> ExeTarget
addLibDepToExe PackageName
n ExeTarget
exe = ExeTarget
exe
  { _exeDependencies :: [Dependency]
_exeDependencies = ExeTarget -> [Dependency]
_exeDependencies ExeTarget
exe forall a. [a] -> [a] -> [a]
++ [PackageName -> Dependency
mkPackageNameDep PackageName
n]
  }