{-# LANGUAGE LambdaCase #-}
module Distribution.Client.Init.NonInteractive.Heuristics
( guessPackageName
, guessMainFile
, guessLicense
, guessExtraDocFiles
, guessAuthorName
, guessAuthorEmail
, guessCabalSpecVersion
, guessLanguage
, guessPackageType
, guessSourceDirectories
, guessApplicationDirectories
) where
import Distribution.Client.Compat.Prelude hiding (readFile, (<|>), many)
import Distribution.Simple.Setup (fromFlagOrDefault)
import qualified Data.List as L
import Distribution.Client.Init.Defaults
import Distribution.Client.Init.FlagExtractors (getCabalVersionNoPrompt)
import Distribution.Client.Init.Types
import Distribution.Client.Init.Utils
import System.FilePath
import Distribution.CabalSpecVersion
import Language.Haskell.Extension
import Distribution.Version
import Distribution.Types.PackageName (PackageName)
import Distribution.Simple.Compiler
import qualified Data.Set as Set
import Distribution.FieldGrammar.Newtypes
guessMainFile :: Interactive m => FilePath -> m HsFilePath
guessMainFile :: forall (m :: * -> *). Interactive m => FilePath -> m HsFilePath
guessMainFile FilePath
pkgDir = do
Bool
exists <- forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist FilePath
pkgDir
if Bool
exists
then do
[FilePath]
files <- forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isMain forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Interactive m => FilePath -> m [FilePath]
listFilesRecursive FilePath
pkgDir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
files
then HsFilePath
defaultMainIs
else FilePath -> HsFilePath
toHsFilePath forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
L.head [FilePath]
files
else
forall (m :: * -> *) a. Monad m => a -> m a
return HsFilePath
defaultMainIs
guessCabalSpecVersion :: Interactive m => m CabalSpecVersion
guessCabalSpecVersion :: forall (m :: * -> *). Interactive m => m CabalSpecVersion
guessCabalSpecVersion = do
(ExitCode
_, FilePath
verString, FilePath
_) <- forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath] -> FilePath -> m (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
"cabal" [FilePath
"--version"] FilePath
""
case forall a. Parsec a => FilePath -> Maybe a
simpleParsec forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) FilePath
verString of
Just Version
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe CabalSpecVersion
defaultCabalVersion forall a b. (a -> b) -> a -> b
$ case Version -> [Int]
versionNumbers Version
v of
[Int
x,Int
y,Int
_,Int
_] -> [Int] -> Maybe CabalSpecVersion
cabalSpecFromVersionDigits [Int
x,Int
y]
[Int
x,Int
y,Int
_] -> [Int] -> Maybe CabalSpecVersion
cabalSpecFromVersionDigits [Int
x,Int
y]
[Int]
_ -> forall a. a -> Maybe a
Just CabalSpecVersion
defaultCabalVersion
Maybe Version
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CabalSpecVersion
defaultCabalVersion
guessLanguage :: Interactive m => Compiler -> m Language
guessLanguage :: forall (m :: * -> *). Interactive m => Compiler -> m Language
guessLanguage Compiler {compilerId :: Compiler -> CompilerId
compilerId = CompilerId CompilerFlavor
GHC Version
ver} =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Version
ver forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
0,Int
1]
then Language
Haskell98
else Language
Haskell2010
guessLanguage Compiler
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Language
defaultLanguage
guessPackageName :: Interactive m => FilePath -> m PackageName
guessPackageName :: forall (m :: * -> *). Interactive m => FilePath -> m PackageName
guessPackageName = forall (m :: * -> *). Interactive m => FilePath -> m PackageName
filePathToPkgName
guessLicense :: Interactive m => InitFlags -> m SpecLicense
guessLicense :: forall (m :: * -> *). Interactive m => InitFlags -> m SpecLicense
guessLicense InitFlags
flags = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion -> SpecLicense
defaultLicense forall a b. (a -> b) -> a -> b
$ InitFlags -> CabalSpecVersion
getCabalVersionNoPrompt InitFlags
flags
guessExtraDocFiles :: Interactive m => InitFlags -> m (Maybe (Set FilePath))
InitFlags
flags = do
FilePath
pkgDir <- forall a. a -> Flag a -> a
fromFlagOrDefault forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> Flag FilePath
packageDir InitFlags
flags
[FilePath]
files <- forall (m :: * -> *). Interactive m => FilePath -> m [FilePath]
getDirectoryContents FilePath
pkgDir
let extraDocCandidates :: [FilePath]
extraDocCandidates = [FilePath
"CHANGES", FilePath
"CHANGELOG", FilePath
"README"]
extraDocs :: [FilePath]
extraDocs = [FilePath
y | FilePath
x <- [FilePath]
extraDocCandidates, FilePath
y <- [FilePath]
files, FilePath
x forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (FilePath -> FilePath
takeBaseName FilePath
y)]
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
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
extraDocs
then forall a. a -> Set a
Set.singleton FilePath
defaultChangelog
else forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
extraDocs
guessPackageType :: Interactive m => InitFlags -> m PackageType
guessPackageType :: forall (m :: * -> *). Interactive m => InitFlags -> m PackageType
guessPackageType InitFlags
flags = do
if forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (InitFlags -> Flag Bool
initializeTestSuite InitFlags
flags)
then
forall (m :: * -> *) a. Monad m => a -> m a
return PackageType
TestSuite
else do
let lastDir :: FilePath -> FilePath
lastDir FilePath
dirs = forall a. [a] -> a
L.last forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories forall a b. (a -> b) -> a -> b
$ FilePath
dirs
srcCandidates :: [FilePath]
srcCandidates = [FilePath
defaultSourceDir, FilePath
"src", FilePath
"source"]
testCandidates :: [FilePath]
testCandidates = [FilePath
defaultTestDir, FilePath
"test", FilePath
"tests"]
FilePath
pkgDir <- forall a. a -> Flag a -> a
fromFlagOrDefault forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> Flag FilePath
packageDir InitFlags
flags
[FilePath]
files <- forall (m :: * -> *).
Interactive m =>
(FilePath -> m Bool) -> FilePath -> m [FilePath]
listFilesInside (\FilePath
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
lastDir FilePath
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
testCandidates) FilePath
pkgDir
[FilePath]
files' <- forall a. (a -> Bool) -> [a] -> [a]
filter (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
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
testCandidates) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *). Interactive m => FilePath -> m [FilePath]
listFilesRecursive FilePath
pkgDir
let hasExe :: Bool
hasExe = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath
f | FilePath
f <- [FilePath]
files, FilePath -> Bool
isMain forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
f]
hasLib :: Bool
hasLib = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath
f | FilePath
f <- [FilePath]
files, FilePath -> FilePath
lastDir FilePath
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
srcCandidates]
hasTest :: Bool
hasTest = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath
f | FilePath
f <- [FilePath]
files', FilePath -> Bool
isMain forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
f]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (Bool
hasLib, Bool
hasExe, Bool
hasTest) of
(Bool
True , Bool
True , Bool
_ ) -> PackageType
LibraryAndExecutable
(Bool
True , Bool
False, Bool
_ ) -> PackageType
Library
(Bool
False, Bool
False, Bool
True) -> PackageType
TestSuite
(Bool, Bool, Bool)
_ -> PackageType
Executable
guessApplicationDirectories :: Interactive m => InitFlags -> m [FilePath]
guessApplicationDirectories :: forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
guessApplicationDirectories InitFlags
flags = do
FilePath
pkgDirs <- forall a. a -> Flag a -> a
fromFlagOrDefault forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory
(forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> Flag FilePath
packageDir InitFlags
flags)
[FilePath]
pkgDirsContents <- forall (m :: * -> *). Interactive m => FilePath -> m [FilePath]
listDirectory FilePath
pkgDirs
let candidates :: [FilePath]
candidates = [FilePath
defaultApplicationDir, FilePath
"app", FilePath
"src-exe"] in
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [FilePath
y | FilePath
x <- [FilePath]
candidates, FilePath
y <- [FilePath]
pkgDirsContents, FilePath
x forall a. Eq a => a -> a -> Bool
== FilePath
y] of
[] -> [FilePath
defaultApplicationDir]
[FilePath]
x -> forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
</> FilePath
pkgDirs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [FilePath]
x
guessSourceDirectories :: Interactive m => InitFlags -> m [FilePath]
guessSourceDirectories :: forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
guessSourceDirectories InitFlags
flags = do
FilePath
pkgDir <- forall a. a -> Flag a -> a
fromFlagOrDefault forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> Flag FilePath
packageDir InitFlags
flags
forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist (FilePath
pkgDir FilePath -> FilePath -> FilePath
</> FilePath
"src") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Bool
False -> [FilePath
defaultSourceDir]
Bool
True -> [FilePath
"src"]
guessAuthorName :: Interactive m => m (Maybe String)
guessAuthorName :: forall (m :: * -> *). Interactive m => m (Maybe FilePath)
guessAuthorName = forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe FilePath)
guessGitInfo FilePath
"user.name"
guessAuthorEmail :: Interactive m => m (Maybe String)
guessAuthorEmail :: forall (m :: * -> *). Interactive m => m (Maybe FilePath)
guessAuthorEmail = forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe FilePath)
guessGitInfo FilePath
"user.email"
guessGitInfo :: Interactive m => String -> m (Maybe String)
guessGitInfo :: forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe FilePath)
guessGitInfo FilePath
target = do
(ExitCode, FilePath, FilePath)
localInfo <- forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath] -> FilePath -> m (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
"git" [FilePath
"config", FilePath
"--local", FilePath
target] FilePath
""
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall {a} {b} {c}. (a, b, c) -> b
snd' (ExitCode, FilePath, FilePath)
localInfo
then do
(ExitCode, FilePath, FilePath)
globalInfo <- forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath] -> FilePath -> m (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
"git" [FilePath
"config", FilePath
"--global", FilePath
target] FilePath
""
case forall {a} {b} {c}. (a, b, c) -> a
fst' (ExitCode, FilePath, FilePath)
globalInfo of
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (FilePath -> FilePath
trim forall a b. (a -> b) -> a -> b
$ forall {a} {b} {c}. (a, b, c) -> b
snd' (ExitCode, FilePath, FilePath)
globalInfo)
ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (FilePath -> FilePath
trim forall a b. (a -> b) -> a -> b
$ forall {a} {b} {c}. (a, b, c) -> b
snd' (ExitCode, FilePath, FilePath)
localInfo)
where
fst' :: (a, b, c) -> a
fst' (a
x, b
_, c
_) = a
x
snd' :: (a, b, c) -> b
snd' (a
_, b
x, c
_) = b
x