{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Init.NonInteractive.Heuristics
-- Copyright   :  (c) Benedikt Huber 2009
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Heuristics for creating initial cabal files.
--
-----------------------------------------------------------------------------
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



-- | Guess the main file, returns a default value if none is found.
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

-- | Juggling characters around to guess the desired cabal version based on
--   the system's cabal version.
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

-- | Guess the language specification based on the GHC version
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

-- | Guess the package name based on the given root directory.
guessPackageName :: Interactive m => FilePath -> m PackageName
guessPackageName :: forall (m :: * -> *). Interactive m => FilePath -> m PackageName
guessPackageName = forall (m :: * -> *). Interactive m => FilePath -> m PackageName
filePathToPkgName

-- | Try to guess the license from an already existing @LICENSE@ file in
--   the package directory, comparing the file contents with the ones
--   listed in @Licenses.hs@, for now it only returns a default value.
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))
guessExtraDocFiles :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Maybe (Set FilePath))
guessExtraDocFiles 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

-- | Try to guess the package type from the files in the package directory,
--   looking for unique characteristics from each type, defaults to Executable.
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

-- | Try to guess the application directories from the package directory,
--   using a default value as fallback.
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

-- | Try to guess the source directories, using a default value as fallback.
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"]

-- | Guess author and email using git configuration options.
guessAuthorName :: Interactive m => m String
guessAuthorName :: forall (m :: * -> *). Interactive m => m FilePath
guessAuthorName = forall (m :: * -> *). Interactive m => FilePath -> m FilePath
guessGitInfo FilePath
"user.name"

guessAuthorEmail :: Interactive m => m String
guessAuthorEmail :: forall (m :: * -> *). Interactive m => m FilePath
guessAuthorEmail = forall (m :: * -> *). Interactive m => FilePath -> m FilePath
guessGitInfo FilePath
"user.email"

guessGitInfo :: Interactive m => String -> m String
guessGitInfo :: forall (m :: * -> *). Interactive m => FilePath -> m FilePath
guessGitInfo FilePath
target = do
  (ExitCode, FilePath, FilePath)
info <- 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)
info
    then FilePath -> FilePath
trim forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b} {c}. (a, b, c) -> b
snd' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath] -> FilePath -> m (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
"git" [FilePath
"config", FilePath
"--global", FilePath
target] FilePath
""
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
trim forall a b. (a -> b) -> a -> b
$ forall {a} {b} {c}. (a, b, c) -> b
snd' (ExitCode, FilePath, FilePath)
info

  where
    snd' :: (a, b, c) -> b
snd' (a
_, b
x, c
_) = b
x