{-# 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 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
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
""
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
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 []
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
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
(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
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
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
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
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
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
[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
(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
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
[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 :: 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)
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
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]
}
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]
}