{-# 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)

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 qualified Distribution.Types.PackageName as PN
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
(Int -> SourceFileEntry -> ShowS)
-> (SourceFileEntry -> FilePath)
-> ([SourceFileEntry] -> ShowS)
-> Show SourceFileEntry
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 CabalSpecVersion -> CabalSpecVersion -> Bool
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 = (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
"Main" FilePath
f Bool -> Bool -> Bool
|| FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
"main" FilePath
f)
         Bool -> Bool -> Bool
&& FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".hs" FilePath
f Bool -> Bool -> Bool
|| FilePath -> FilePath -> 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 = FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".hs" FilePath
f Bool -> Bool -> Bool
|| FilePath -> FilePath -> 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 (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> ShowS -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion -> ShowS
knownSuffixHandlers CabalSpecVersion
v ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension

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

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

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

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

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

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

                Maybe SourceFileEntry -> m (Maybe SourceFileEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SourceFileEntry -> m (Maybe SourceFileEntry))
-> (SourceFileEntry -> Maybe SourceFileEntry)
-> SourceFileEntry
-> m (Maybe SourceFileEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceFileEntry -> Maybe SourceFileEntry
forall a. a -> Maybe a
Just (SourceFileEntry -> m (Maybe SourceFileEntry))
-> SourceFileEntry -> m (Maybe SourceFileEntry)
forall a b. (a -> b) -> a -> b
$ SourceFileEntry :: FilePath
-> ModuleName
-> FilePath
-> [ModuleName]
-> [Extension]
-> SourceFileEntry
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
            Maybe SourceFileEntry -> m (Maybe SourceFileEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SourceFileEntry
forall a. Maybe a
Nothing

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

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

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

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

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

    grabModuleName :: ShowS
grabModuleName [] = []
    grabModuleName (Char
'-':Char
'-':FilePath
xs) = ShowS
grabModuleName ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
dropWhile' (Char -> Char -> Bool
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 :: FilePath -> m [ModuleName]
retrieveModuleImports FilePath
m = do
  (FilePath -> ModuleName) -> [FilePath] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
fromString (FilePath -> ModuleName) -> ShowS -> FilePath -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) ([FilePath] -> [ModuleName])
-> (FilePath -> [FilePath]) -> FilePath -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
grabModuleImports (FilePath -> [ModuleName]) -> m FilePath -> m [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
forall (m :: * -> *). Interactive m => FilePath -> m FilePath
readFile FilePath
m

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

    grabModuleImports :: FilePath -> [FilePath]
grabModuleImports [] = []
    grabModuleImports (Char
'-':Char
'-':FilePath
xs) = FilePath -> [FilePath]
grabModuleImports (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
dropWhile' (Char -> Char -> Bool
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 FilePath -> [FilePath] -> [FilePath]
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 FilePath -> [FilePath] -> [FilePath]
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 :: FilePath -> m [Extension]
retrieveModuleExtensions FilePath
m = do
  [Maybe Extension] -> [Extension]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Extension] -> [Extension])
-> (FilePath -> [Maybe Extension]) -> FilePath -> [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Maybe Extension) -> [FilePath] -> [Maybe Extension]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Maybe Extension
forall a. Parsec a => FilePath -> Maybe a
simpleParsec (FilePath -> Maybe Extension)
-> ShowS -> FilePath -> Maybe Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) ([FilePath] -> [Maybe Extension])
-> (FilePath -> [FilePath]) -> FilePath -> [Maybe Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
grabModuleExtensions (FilePath -> [Extension]) -> m FilePath -> m [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
forall (m :: * -> *). Interactive m => FilePath -> m FilePath
readFile FilePath
m

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

    grabModuleExtensions :: FilePath -> [FilePath]
grabModuleExtensions [] = []
    grabModuleExtensions (Char
'-':Char
'-':FilePath
xs) = FilePath -> [FilePath]
grabModuleExtensions (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
dropWhile' (Char -> Char -> Bool
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 FilePath -> [FilePath] -> [FilePath]
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 FilePath -> [FilePath] -> [FilePath]
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 = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
p ShowS -> ShowS -> ShowS
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 = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
p ShowS -> ShowS -> ShowS
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 ([FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just [FilePath
"."]) SourceFileEntry
sf
isSourceFile (Just [FilePath]
srcDirs) SourceFileEntry
sf = (FilePath -> Bool) -> [FilePath] -> Bool
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 :: 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  = ([InstalledPackageInfo] -> [InstalledPackageInfo])
-> Map ModuleName [InstalledPackageInfo]
-> Map ModuleName [InstalledPackageInfo]
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((InstalledPackageInfo -> Bool)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter InstalledPackageInfo -> Bool
exposed) (Map ModuleName [InstalledPackageInfo]
 -> Map ModuleName [InstalledPackageInfo])
-> Map ModuleName [InstalledPackageInfo]
-> Map ModuleName [InstalledPackageInfo]
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 = ((ModuleName, ModuleName)
 -> (ModuleName, ModuleName, Maybe [InstalledPackageInfo]))
-> [(ModuleName, ModuleName)]
-> [(ModuleName, ModuleName, Maybe [InstalledPackageInfo])]
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
mn, ModuleName
ds) -> (ModuleName
mn, ModuleName
ds, ModuleName
-> Map ModuleName [InstalledPackageInfo]
-> Maybe [InstalledPackageInfo]
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

  Verbosity -> Severity -> FilePath -> m ()
forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Log FilePath
"Guessing dependencies..."
  [Dependency] -> [Dependency]
forall a. Eq a => [a] -> [a]
nub ([Dependency] -> [Dependency])
-> ([Maybe Dependency] -> [Dependency])
-> [Maybe Dependency]
-> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Dependency] -> [Dependency]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Dependency] -> [Dependency])
-> m [Maybe Dependency] -> m [Dependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ModuleName, ModuleName, Maybe [InstalledPackageInfo])
 -> m (Maybe Dependency))
-> [(ModuleName, ModuleName, Maybe [InstalledPackageInfo])]
-> m [Maybe Dependency]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Verbosity
-> InitFlags
-> (ModuleName, ModuleName, Maybe [InstalledPackageInfo])
-> m (Maybe Dependency)
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 :: 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 (PackageIdentifier -> PackageIdentifier -> Bool)
-> [PackageIdentifier] -> [NonEmpty PackageIdentifier]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy (\PackageIdentifier
x PackageIdentifier
y -> PackageIdentifier -> PackageName
P.pkgName PackageIdentifier
x PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier -> PackageName
P.pkgName PackageIdentifier
y) ([PackageIdentifier] -> [NonEmpty PackageIdentifier])
-> [PackageIdentifier] -> [NonEmpty PackageIdentifier]
forall a b. (a -> b) -> a -> b
$ (InstalledPackageInfo -> PackageIdentifier)
-> [InstalledPackageInfo] -> [PackageIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo -> PackageIdentifier
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] -> (Dependency -> Maybe Dependency)
-> m Dependency -> m (Maybe Dependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dependency -> Maybe Dependency
forall a. a -> Maybe a
Just (m Dependency -> m (Maybe Dependency))
-> m Dependency -> m (Maybe Dependency)
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:|[]) ->
          Dependency -> m Dependency
forall (m :: * -> *) a. Monad m => a -> m a
return (Dependency -> m Dependency) -> Dependency -> m Dependency
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 (Version -> VersionRange)
-> (PackageIdentifier -> Version)
-> PackageIdentifier
-> VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> Version
P.pkgVersion (PackageIdentifier -> VersionRange)
-> PackageIdentifier -> VersionRange
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
          Verbosity -> Severity -> FilePath -> m ()
forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning (FilePath
"multiple versions of " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageIdentifier -> PackageName
P.pkgName (PackageIdentifier -> PackageName)
-> (NonEmpty PackageIdentifier -> PackageIdentifier)
-> NonEmpty PackageIdentifier
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PackageIdentifier -> PackageIdentifier
forall a. NonEmpty a -> a
NE.head (NonEmpty PackageIdentifier -> PackageName)
-> NonEmpty PackageIdentifier -> PackageName
forall a b. (a -> b) -> a -> b
$ NonEmpty PackageIdentifier
pids) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" provide " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", choosing the latest.")
          Dependency -> m Dependency
forall (m :: * -> *) a. Monad m => a -> m a
return (Dependency -> m Dependency) -> Dependency -> m Dependency
forall a b. (a -> b) -> a -> b
$ PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
P.Dependency
              (PackageIdentifier -> PackageName
P.pkgName (PackageIdentifier -> PackageName)
-> (NonEmpty PackageIdentifier -> PackageIdentifier)
-> NonEmpty PackageIdentifier
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PackageIdentifier -> PackageIdentifier
forall a. NonEmpty a -> a
NE.head (NonEmpty PackageIdentifier -> PackageName)
-> NonEmpty PackageIdentifier -> PackageName
forall a b. (a -> b) -> a -> b
$ NonEmpty PackageIdentifier
pids)
              (Bool -> Version -> VersionRange
pvpize Bool
desugar (Version -> VersionRange)
-> (NonEmpty PackageIdentifier -> Version)
-> NonEmpty PackageIdentifier
-> VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Version -> Version
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (NonEmpty Version -> Version)
-> (NonEmpty PackageIdentifier -> NonEmpty Version)
-> NonEmpty PackageIdentifier
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageIdentifier -> Version)
-> NonEmpty PackageIdentifier -> NonEmpty Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageIdentifier -> Version
P.pkgVersion (NonEmpty PackageIdentifier -> VersionRange)
-> NonEmpty PackageIdentifier -> VersionRange
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
        Verbosity -> Severity -> FilePath -> m ()
forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning (FilePath
"multiple packages found providing " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((NonEmpty PackageIdentifier -> FilePath)
-> [NonEmpty PackageIdentifier] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageName -> FilePath)
-> (NonEmpty PackageIdentifier -> PackageName)
-> NonEmpty PackageIdentifier
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
P.pkgName (PackageIdentifier -> PackageName)
-> (NonEmpty PackageIdentifier -> PackageIdentifier)
-> NonEmpty PackageIdentifier
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PackageIdentifier -> PackageIdentifier
forall a. NonEmpty a -> a
NE.head) [NonEmpty PackageIdentifier]
grps))
        Verbosity -> Severity -> FilePath -> m ()
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."
        Maybe Dependency -> m (Maybe Dependency)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Dependency
forall a. Maybe a
Nothing

  Maybe [InstalledPackageInfo]
_ -> do
    Verbosity -> Severity -> FilePath -> m ()
forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning (FilePath
"no package found providing " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
importer FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
".")
    Maybe Dependency -> m (Maybe Dependency)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Dependency
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                   CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_0
      Flag CabalSpecVersion
NoFlag -> CabalSpecVersion
defaultCabalVersion CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV2_0

filePathToPkgName :: FilePath -> P.PackageName
filePathToPkgName :: FilePath -> PackageName
filePathToPkgName = FilePath -> PackageName
PN.mkPackageName (FilePath -> PackageName) -> ShowS -> FilePath -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
Prelude.last ([FilePath] -> FilePath) -> (FilePath -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories

currentDirPkgName :: Interactive m => m P.PackageName
currentDirPkgName :: m PackageName
currentDirPkgName = FilePath -> PackageName
filePathToPkgName (FilePath -> PackageName) -> m FilePath -> m PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePath
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 (LibraryName -> NonEmptySet LibraryName
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 :: Verbosity -> PkgDescription -> m PkgDescription
fixupDocFiles Verbosity
v PkgDescription
pkgDesc
  | PkgDescription -> CabalSpecVersion
_pkgCabalVersion PkgDescription
pkgDesc CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_18 = do
    Verbosity -> Severity -> FilePath -> m ()
forall (m :: * -> *).
Interactive m =>
Verbosity -> Severity -> FilePath -> m ()
message Verbosity
v Severity
Warning (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
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."
      ]

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

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


getBaseDep :: Interactive m => InstalledPackageIndex -> InitFlags -> m [Dependency]
getBaseDep :: InstalledPackageIndex -> InitFlags -> m [Dependency]
getBaseDep InstalledPackageIndex
pkgIx InitFlags
flags = Verbosity
-> InitFlags
-> [(ModuleName, ModuleName)]
-> InstalledPackageIndex
-> m [Dependency]
forall (m :: * -> *).
Interactive m =>
Verbosity
-> InitFlags
-> [(ModuleName, ModuleName)]
-> InstalledPackageIndex
-> m [Dependency]
retrieveDependencies Verbosity
silent InitFlags
flags
  [(FilePath -> ModuleName
forall a. IsString a => FilePath -> a
fromString FilePath
"Prelude", FilePath -> ModuleName
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 = Maybe TestTarget
forall a. Maybe a
Nothing
addLibDepToTest PackageName
n (Just TestTarget
t) = TestTarget -> Maybe TestTarget
forall a. a -> Maybe a
Just (TestTarget -> Maybe TestTarget) -> TestTarget -> Maybe TestTarget
forall a b. (a -> b) -> a -> b
$ TestTarget
t
  { _testDependencies :: [Dependency]
_testDependencies = TestTarget -> [Dependency]
_testDependencies TestTarget
t [Dependency] -> [Dependency] -> [Dependency]
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 [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++ [PackageName -> Dependency
mkPackageNameDep PackageName
n]
  }