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