{-# LANGUAGE LambdaCase #-}
module Distribution.Client.Init.NonInteractive.Command
( genPkgDescription
, genLibTarget
, genExeTarget
, genTestTarget
, createProject
, packageTypeHeuristics
, authorHeuristics
, emailHeuristics
, cabalVersionHeuristics
, packageNameHeuristics
, versionHeuristics
, mainFileHeuristics
, testDirsHeuristics
, initializeTestSuiteHeuristics
, exposedModulesHeuristics
, libOtherModulesHeuristics
, exeOtherModulesHeuristics
, testOtherModulesHeuristics
, buildToolsHeuristics
, dependenciesHeuristics
, otherExtsHeuristics
, licenseHeuristics
, homepageHeuristics
, synopsisHeuristics
, categoryHeuristics
, extraDocFileHeuristics
, appDirsHeuristics
, srcDirsHeuristics
, languageHeuristics
, noCommentsHeuristics
, minimalHeuristics
, overwriteHeuristics
) where
import Distribution.Client.Init.Types

import Prelude ()
import Distribution.Client.Compat.Prelude hiding (putStr, putStrLn, getLine, last, head)

import Data.List (last, head)
import qualified Data.List.NonEmpty as NEL

import Distribution.CabalSpecVersion (CabalSpecVersion(..))
import Distribution.Version (Version)
import Distribution.ModuleName (ModuleName, components)
import Distribution.Types.Dependency (Dependency(..))
import Distribution.Types.PackageName (PackageName, unPackageName)
import Distribution.Client.Init.Defaults
import Distribution.Client.Init.NonInteractive.Heuristics
import Distribution.Client.Init.Utils
import Distribution.Client.Init.FlagExtractors
import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Client.Types (SourcePackageDb(..))
import Distribution.Solver.Types.PackageIndex (elemByPackageName)
import Distribution.Utils.Generic (safeHead)
import Distribution.Verbosity

import Language.Haskell.Extension (Language(..), Extension(..))

import System.FilePath (splitDirectories, (</>))
import Distribution.Simple.Compiler
import qualified Data.Set as Set
import Distribution.FieldGrammar.Newtypes


-- | Main driver for interactive prompt code.
--
createProject
    :: Interactive m
    => Compiler
    -> Verbosity
    -> InstalledPackageIndex
    -> SourcePackageDb
    -> InitFlags
    -> m ProjectSettings
createProject :: Compiler
-> Verbosity
-> InstalledPackageIndex
-> SourcePackageDb
-> InitFlags
-> m ProjectSettings
createProject Compiler
comp Verbosity
v InstalledPackageIndex
pkgIx SourcePackageDb
srcDb InitFlags
initFlags = do

  -- The workflow is as follows:
  --
  --  1. Get the package type, supplied as either a program input or
  --     via user prompt. This determines what targets will be built
  --     in later steps.
  --
  --  2. Determine whether we generate simple targets or prompt the
  --     user for inputs when not supplied as a flag. In general,
  --     flag inputs are preferred, and "simple" here means
  --     reasonable defaults defined in @Defaults.hs@.
  --
  --  3. Generate package description and the targets specified by
  --     the package type. Once this is done, a prompt for building
  --     test suites is initiated, and this determines if we build
  --     test targets as well. Then we ask if the user wants to
  --     comment their .cabal file with pretty comments.
  --
  --  4. The targets are passed to the file creator script, and associated
  --     directories/files/modules are created, with the a .cabal file
  --     being generated as a final result.
  --

  PackageType
pkgType <- InitFlags -> m PackageType
forall (m :: * -> *). Interactive m => InitFlags -> m PackageType
packageTypeHeuristics InitFlags
initFlags
  Bool
isMinimal <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getMinimal InitFlags
initFlags
  Bool
doOverwrite <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getOverwrite InitFlags
initFlags
  FilePath
pkgDir <- InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
packageDirHeuristics InitFlags
initFlags
  PkgDescription
pkgDesc <- Verbosity -> PkgDescription -> m PkgDescription
forall (m :: * -> *).
Interactive m =>
Verbosity -> PkgDescription -> m PkgDescription
fixupDocFiles Verbosity
v (PkgDescription -> m PkgDescription)
-> m PkgDescription -> m PkgDescription
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InitFlags -> SourcePackageDb -> m PkgDescription
forall (m :: * -> *).
Interactive m =>
InitFlags -> SourcePackageDb -> m PkgDescription
genPkgDescription InitFlags
initFlags SourcePackageDb
srcDb
  Bool
comments <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
noCommentsHeuristics InitFlags
initFlags

  let pkgName :: PackageName
pkgName = PkgDescription -> PackageName
_pkgName PkgDescription
pkgDesc
      cabalSpec :: CabalSpecVersion
cabalSpec = PkgDescription -> CabalSpecVersion
_pkgCabalVersion PkgDescription
pkgDesc
      mkOpts :: Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
cs = Bool
-> Bool
-> Bool
-> Verbosity
-> FilePath
-> PackageType
-> PackageName
-> CabalSpecVersion
-> WriteOpts
WriteOpts
        Bool
doOverwrite Bool
isMinimal Bool
cs
        Verbosity
v FilePath
pkgDir PackageType
pkgType PackageName
pkgName

  case PackageType
pkgType of
    PackageType
Library -> do
      LibTarget
libTarget <- InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m LibTarget
forall (m :: * -> *).
Interactive m =>
InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m LibTarget
genLibTarget InitFlags
initFlags Compiler
comp InstalledPackageIndex
pkgIx CabalSpecVersion
cabalSpec
      Maybe TestTarget
testTarget <- PackageName -> Maybe TestTarget -> Maybe TestTarget
addLibDepToTest PackageName
pkgName (Maybe TestTarget -> Maybe TestTarget)
-> m (Maybe TestTarget) -> m (Maybe TestTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m (Maybe TestTarget)
forall (m :: * -> *).
Interactive m =>
InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags Compiler
comp InstalledPackageIndex
pkgIx CabalSpecVersion
cabalSpec

      ProjectSettings -> m ProjectSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectSettings -> m ProjectSettings)
-> ProjectSettings -> m ProjectSettings
forall a b. (a -> b) -> a -> b
$ WriteOpts
-> PkgDescription
-> Maybe LibTarget
-> Maybe ExeTarget
-> Maybe TestTarget
-> ProjectSettings
ProjectSettings
        (Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
comments CabalSpecVersion
cabalSpec) PkgDescription
pkgDesc
        (LibTarget -> Maybe LibTarget
forall a. a -> Maybe a
Just LibTarget
libTarget) Maybe ExeTarget
forall a. Maybe a
Nothing Maybe TestTarget
testTarget

    PackageType
Executable -> do
      ExeTarget
exeTarget <- InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m ExeTarget
forall (m :: * -> *).
Interactive m =>
InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m ExeTarget
genExeTarget InitFlags
initFlags Compiler
comp InstalledPackageIndex
pkgIx CabalSpecVersion
cabalSpec

      ProjectSettings -> m ProjectSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectSettings -> m ProjectSettings)
-> ProjectSettings -> m ProjectSettings
forall a b. (a -> b) -> a -> b
$ WriteOpts
-> PkgDescription
-> Maybe LibTarget
-> Maybe ExeTarget
-> Maybe TestTarget
-> ProjectSettings
ProjectSettings
        (Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
comments CabalSpecVersion
cabalSpec) PkgDescription
pkgDesc Maybe LibTarget
forall a. Maybe a
Nothing
        (ExeTarget -> Maybe ExeTarget
forall a. a -> Maybe a
Just ExeTarget
exeTarget) Maybe TestTarget
forall a. Maybe a
Nothing

    PackageType
LibraryAndExecutable -> do
      LibTarget
libTarget <- InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m LibTarget
forall (m :: * -> *).
Interactive m =>
InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m LibTarget
genLibTarget InitFlags
initFlags Compiler
comp InstalledPackageIndex
pkgIx CabalSpecVersion
cabalSpec
      ExeTarget
exeTarget <- PackageName -> ExeTarget -> ExeTarget
addLibDepToExe PackageName
pkgName (ExeTarget -> ExeTarget) -> m ExeTarget -> m ExeTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m ExeTarget
forall (m :: * -> *).
Interactive m =>
InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m ExeTarget
genExeTarget InitFlags
initFlags Compiler
comp InstalledPackageIndex
pkgIx CabalSpecVersion
cabalSpec
      Maybe TestTarget
testTarget <- PackageName -> Maybe TestTarget -> Maybe TestTarget
addLibDepToTest PackageName
pkgName (Maybe TestTarget -> Maybe TestTarget)
-> m (Maybe TestTarget) -> m (Maybe TestTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m (Maybe TestTarget)
forall (m :: * -> *).
Interactive m =>
InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags Compiler
comp InstalledPackageIndex
pkgIx CabalSpecVersion
cabalSpec

      ProjectSettings -> m ProjectSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectSettings -> m ProjectSettings)
-> ProjectSettings -> m ProjectSettings
forall a b. (a -> b) -> a -> b
$ WriteOpts
-> PkgDescription
-> Maybe LibTarget
-> Maybe ExeTarget
-> Maybe TestTarget
-> ProjectSettings
ProjectSettings
        (Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
comments CabalSpecVersion
cabalSpec) PkgDescription
pkgDesc (LibTarget -> Maybe LibTarget
forall a. a -> Maybe a
Just LibTarget
libTarget)
        (ExeTarget -> Maybe ExeTarget
forall a. a -> Maybe a
Just ExeTarget
exeTarget) Maybe TestTarget
testTarget
    
    PackageType
TestSuite -> do
      Maybe TestTarget
testTarget <- InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m (Maybe TestTarget)
forall (m :: * -> *).
Interactive m =>
InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m (Maybe TestTarget)
genTestTarget InitFlags
initFlags Compiler
comp InstalledPackageIndex
pkgIx CabalSpecVersion
cabalSpec

      ProjectSettings -> m ProjectSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectSettings -> m ProjectSettings)
-> ProjectSettings -> m ProjectSettings
forall a b. (a -> b) -> a -> b
$ WriteOpts
-> PkgDescription
-> Maybe LibTarget
-> Maybe ExeTarget
-> Maybe TestTarget
-> ProjectSettings
ProjectSettings
        (Bool -> CabalSpecVersion -> WriteOpts
mkOpts Bool
comments CabalSpecVersion
cabalSpec) PkgDescription
pkgDesc
        Maybe LibTarget
forall a. Maybe a
Nothing Maybe ExeTarget
forall a. Maybe a
Nothing Maybe TestTarget
testTarget

genPkgDescription
  :: Interactive m
  => InitFlags
  -> SourcePackageDb
  -> m PkgDescription
genPkgDescription :: InitFlags -> SourcePackageDb -> m PkgDescription
genPkgDescription InitFlags
flags SourcePackageDb
srcDb = CabalSpecVersion
-> PackageName
-> Version
-> SpecLicense
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription
PkgDescription
  (CabalSpecVersion
 -> PackageName
 -> Version
 -> SpecLicense
 -> FilePath
 -> FilePath
 -> FilePath
 -> FilePath
 -> FilePath
 -> Set FilePath
 -> Maybe (Set FilePath)
 -> PkgDescription)
-> m CabalSpecVersion
-> m (PackageName
      -> Version
      -> SpecLicense
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Set FilePath
      -> Maybe (Set FilePath)
      -> PkgDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> m CabalSpecVersion
forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion
cabalVersionHeuristics InitFlags
flags
  m (PackageName
   -> Version
   -> SpecLicense
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Set FilePath
   -> Maybe (Set FilePath)
   -> PkgDescription)
-> m PackageName
-> m (Version
      -> SpecLicense
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Set FilePath
      -> Maybe (Set FilePath)
      -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SourcePackageDb -> InitFlags -> m PackageName
forall (m :: * -> *).
Interactive m =>
SourcePackageDb -> InitFlags -> m PackageName
packageNameHeuristics SourcePackageDb
srcDb InitFlags
flags
  m (Version
   -> SpecLicense
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Set FilePath
   -> Maybe (Set FilePath)
   -> PkgDescription)
-> m Version
-> m (SpecLicense
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Set FilePath
      -> Maybe (Set FilePath)
      -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m Version
forall (m :: * -> *). Interactive m => InitFlags -> m Version
versionHeuristics InitFlags
flags
  m (SpecLicense
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Set FilePath
   -> Maybe (Set FilePath)
   -> PkgDescription)
-> m SpecLicense
-> m (FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Set FilePath
      -> Maybe (Set FilePath)
      -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m SpecLicense
forall (m :: * -> *). Interactive m => InitFlags -> m SpecLicense
licenseHeuristics InitFlags
flags
  m (FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Set FilePath
   -> Maybe (Set FilePath)
   -> PkgDescription)
-> m FilePath
-> m (FilePath
      -> FilePath
      -> FilePath
      -> FilePath
      -> Set FilePath
      -> Maybe (Set FilePath)
      -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
authorHeuristics InitFlags
flags
  m (FilePath
   -> FilePath
   -> FilePath
   -> FilePath
   -> Set FilePath
   -> Maybe (Set FilePath)
   -> PkgDescription)
-> m FilePath
-> m (FilePath
      -> FilePath
      -> FilePath
      -> Set FilePath
      -> Maybe (Set FilePath)
      -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
emailHeuristics InitFlags
flags
  m (FilePath
   -> FilePath
   -> FilePath
   -> Set FilePath
   -> Maybe (Set FilePath)
   -> PkgDescription)
-> m FilePath
-> m (FilePath
      -> FilePath
      -> Set FilePath
      -> Maybe (Set FilePath)
      -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
homepageHeuristics InitFlags
flags
  m (FilePath
   -> FilePath
   -> Set FilePath
   -> Maybe (Set FilePath)
   -> PkgDescription)
-> m FilePath
-> m (FilePath
      -> Set FilePath -> Maybe (Set FilePath) -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
synopsisHeuristics InitFlags
flags
  m (FilePath
   -> Set FilePath -> Maybe (Set FilePath) -> PkgDescription)
-> m FilePath
-> m (Set FilePath -> Maybe (Set FilePath) -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
categoryHeuristics InitFlags
flags
  m (Set FilePath -> Maybe (Set FilePath) -> PkgDescription)
-> m (Set FilePath) -> m (Maybe (Set FilePath) -> PkgDescription)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m (Set FilePath)
forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Set FilePath)
getExtraSrcFiles InitFlags
flags
  m (Maybe (Set FilePath) -> PkgDescription)
-> m (Maybe (Set FilePath)) -> m PkgDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m (Maybe (Set FilePath))
forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Maybe (Set FilePath))
extraDocFileHeuristics InitFlags
flags

genLibTarget
  :: Interactive m
  => InitFlags
  -> Compiler
  -> InstalledPackageIndex
  -> CabalSpecVersion
  -> m LibTarget
genLibTarget :: InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m LibTarget
genLibTarget InitFlags
flags Compiler
comp InstalledPackageIndex
pkgs CabalSpecVersion
v = do
  [FilePath]
srcDirs   <- InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
srcDirsHeuristics InitFlags
flags
  let srcDir :: FilePath
srcDir = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultSourceDir (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeHead [FilePath]
srcDirs
  [FilePath]
-> Language
-> NonEmpty ModuleName
-> [ModuleName]
-> [Extension]
-> [Dependency]
-> [Dependency]
-> LibTarget
LibTarget [FilePath]
srcDirs
    (Language
 -> NonEmpty ModuleName
 -> [ModuleName]
 -> [Extension]
 -> [Dependency]
 -> [Dependency]
 -> LibTarget)
-> m Language
-> m (NonEmpty ModuleName
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> LibTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> Compiler -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> Compiler -> m Language
languageHeuristics InitFlags
flags Compiler
comp
    m (NonEmpty ModuleName
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> LibTarget)
-> m (NonEmpty ModuleName)
-> m ([ModuleName]
      -> [Extension] -> [Dependency] -> [Dependency] -> LibTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m (NonEmpty ModuleName)
forall (m :: * -> *).
Interactive m =>
InitFlags -> m (NonEmpty ModuleName)
exposedModulesHeuristics InitFlags
flags
    m ([ModuleName]
   -> [Extension] -> [Dependency] -> [Dependency] -> LibTarget)
-> m [ModuleName]
-> m ([Extension] -> [Dependency] -> [Dependency] -> LibTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [ModuleName]
forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
libOtherModulesHeuristics InitFlags
flags
    m ([Extension] -> [Dependency] -> [Dependency] -> LibTarget)
-> m [Extension] -> m ([Dependency] -> [Dependency] -> LibTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> m [Extension]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m [Extension]
otherExtsHeuristics InitFlags
flags FilePath
srcDir
    m ([Dependency] -> [Dependency] -> LibTarget)
-> m [Dependency] -> m ([Dependency] -> LibTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
dependenciesHeuristics InitFlags
flags FilePath
srcDir InstalledPackageIndex
pkgs
    m ([Dependency] -> LibTarget) -> m [Dependency] -> m LibTarget
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> CabalSpecVersion -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> CabalSpecVersion -> m [Dependency]
buildToolsHeuristics InitFlags
flags FilePath
srcDir CabalSpecVersion
v

genExeTarget
  :: Interactive m
  => InitFlags
  -> Compiler
  -> InstalledPackageIndex
  -> CabalSpecVersion
  -> m ExeTarget
genExeTarget :: InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m ExeTarget
genExeTarget InitFlags
flags Compiler
comp InstalledPackageIndex
pkgs CabalSpecVersion
v = do
  [FilePath]
appDirs  <- InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
appDirsHeuristics InitFlags
flags
  let appDir :: FilePath
appDir = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultApplicationDir (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeHead [FilePath]
appDirs
  HsFilePath
-> [FilePath]
-> Language
-> [ModuleName]
-> [Extension]
-> [Dependency]
-> [Dependency]
-> ExeTarget
ExeTarget
    (HsFilePath
 -> [FilePath]
 -> Language
 -> [ModuleName]
 -> [Extension]
 -> [Dependency]
 -> [Dependency]
 -> ExeTarget)
-> m HsFilePath
-> m ([FilePath]
      -> Language
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> ExeTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> m HsFilePath
forall (m :: * -> *). Interactive m => InitFlags -> m HsFilePath
mainFileHeuristics InitFlags
flags
    m ([FilePath]
   -> Language
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> ExeTarget)
-> m [FilePath]
-> m (Language
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> ExeTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [FilePath] -> m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
appDirs
    m (Language
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> ExeTarget)
-> m Language
-> m ([ModuleName]
      -> [Extension] -> [Dependency] -> [Dependency] -> ExeTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> Compiler -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> Compiler -> m Language
languageHeuristics InitFlags
flags Compiler
comp
    m ([ModuleName]
   -> [Extension] -> [Dependency] -> [Dependency] -> ExeTarget)
-> m [ModuleName]
-> m ([Extension] -> [Dependency] -> [Dependency] -> ExeTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [ModuleName]
forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
exeOtherModulesHeuristics InitFlags
flags
    m ([Extension] -> [Dependency] -> [Dependency] -> ExeTarget)
-> m [Extension] -> m ([Dependency] -> [Dependency] -> ExeTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> m [Extension]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m [Extension]
otherExtsHeuristics InitFlags
flags FilePath
appDir
    m ([Dependency] -> [Dependency] -> ExeTarget)
-> m [Dependency] -> m ([Dependency] -> ExeTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
dependenciesHeuristics InitFlags
flags FilePath
appDir InstalledPackageIndex
pkgs
    m ([Dependency] -> ExeTarget) -> m [Dependency] -> m ExeTarget
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> CabalSpecVersion -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> CabalSpecVersion -> m [Dependency]
buildToolsHeuristics InitFlags
flags FilePath
appDir CabalSpecVersion
v

genTestTarget
  :: Interactive m
  => InitFlags
  -> Compiler
  -> InstalledPackageIndex
  -> CabalSpecVersion
  -> m (Maybe TestTarget)
genTestTarget :: InitFlags
-> Compiler
-> InstalledPackageIndex
-> CabalSpecVersion
-> m (Maybe TestTarget)
genTestTarget InitFlags
flags Compiler
comp InstalledPackageIndex
pkgs CabalSpecVersion
v = do
  Bool
initialized <- InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
initializeTestSuiteHeuristics InitFlags
flags
  [FilePath]
testDirs' <- InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
testDirsHeuristics InitFlags
flags
  let testDir :: FilePath
testDir = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultTestDir (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeHead [FilePath]
testDirs'
  if Bool -> Bool
not Bool
initialized
  then Maybe TestTarget -> m (Maybe TestTarget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TestTarget
forall a. Maybe a
Nothing
  else (TestTarget -> Maybe TestTarget)
-> m TestTarget -> m (Maybe TestTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestTarget -> Maybe TestTarget
forall a. a -> Maybe a
Just (m TestTarget -> m (Maybe TestTarget))
-> m TestTarget -> m (Maybe TestTarget)
forall a b. (a -> b) -> a -> b
$ HsFilePath
-> [FilePath]
-> Language
-> [ModuleName]
-> [Extension]
-> [Dependency]
-> [Dependency]
-> TestTarget
TestTarget
    (HsFilePath
 -> [FilePath]
 -> Language
 -> [ModuleName]
 -> [Extension]
 -> [Dependency]
 -> [Dependency]
 -> TestTarget)
-> m HsFilePath
-> m ([FilePath]
      -> Language
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> TestTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> m HsFilePath
forall (m :: * -> *). Interactive m => InitFlags -> m HsFilePath
testMainHeuristics InitFlags
flags
    m ([FilePath]
   -> Language
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> TestTarget)
-> m [FilePath]
-> m (Language
      -> [ModuleName]
      -> [Extension]
      -> [Dependency]
      -> [Dependency]
      -> TestTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [FilePath] -> m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
testDirs'
    m (Language
   -> [ModuleName]
   -> [Extension]
   -> [Dependency]
   -> [Dependency]
   -> TestTarget)
-> m Language
-> m ([ModuleName]
      -> [Extension] -> [Dependency] -> [Dependency] -> TestTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> Compiler -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> Compiler -> m Language
languageHeuristics InitFlags
flags Compiler
comp
    m ([ModuleName]
   -> [Extension] -> [Dependency] -> [Dependency] -> TestTarget)
-> m [ModuleName]
-> m ([Extension] -> [Dependency] -> [Dependency] -> TestTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> m [ModuleName]
forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
testOtherModulesHeuristics InitFlags
flags
    m ([Extension] -> [Dependency] -> [Dependency] -> TestTarget)
-> m [Extension] -> m ([Dependency] -> [Dependency] -> TestTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> m [Extension]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> m [Extension]
otherExtsHeuristics InitFlags
flags FilePath
testDir
    m ([Dependency] -> [Dependency] -> TestTarget)
-> m [Dependency] -> m ([Dependency] -> TestTarget)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
dependenciesHeuristics InitFlags
flags FilePath
testDir InstalledPackageIndex
pkgs
    m ([Dependency] -> TestTarget) -> m [Dependency] -> m TestTarget
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitFlags -> FilePath -> CabalSpecVersion -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InitFlags -> FilePath -> CabalSpecVersion -> m [Dependency]
buildToolsHeuristics InitFlags
flags FilePath
testDir CabalSpecVersion
v

-- -------------------------------------------------------------------- --
-- Get flags from init config

minimalHeuristics :: Interactive m => InitFlags -> m Bool
minimalHeuristics :: InitFlags -> m Bool
minimalHeuristics = InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getMinimal

overwriteHeuristics :: Interactive m => InitFlags -> m Bool
overwriteHeuristics :: InitFlags -> m Bool
overwriteHeuristics = InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
getOverwrite

packageDirHeuristics :: Interactive m => InitFlags -> m FilePath
packageDirHeuristics :: InitFlags -> m FilePath
packageDirHeuristics = InitFlags -> m FilePath
forall (m :: * -> *). Interactive m => InitFlags -> m FilePath
getPackageDir

-- | Get the version of the cabal spec to use.
--   The spec version can be specified by the InitFlags cabalVersion field. If
--   none is specified then the default version is used.
cabalVersionHeuristics :: Interactive m => InitFlags -> m CabalSpecVersion
cabalVersionHeuristics :: InitFlags -> m CabalSpecVersion
cabalVersionHeuristics InitFlags
flags = InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
forall (m :: * -> *).
Interactive m =>
InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
getCabalVersion InitFlags
flags m CabalSpecVersion
forall (m :: * -> *). Interactive m => m CabalSpecVersion
guessCabalSpecVersion

-- | Get the package name: use the package directory (supplied, or the current
--   directory by default) as a guess. It looks at the SourcePackageDb to avoid
--   using an existing package name.
packageNameHeuristics :: Interactive m => SourcePackageDb -> InitFlags -> m PackageName
packageNameHeuristics :: SourcePackageDb -> InitFlags -> m PackageName
packageNameHeuristics SourcePackageDb
sourcePkgDb InitFlags
flags = InitFlags -> m PackageName -> m PackageName
forall (m :: * -> *).
Interactive m =>
InitFlags -> m PackageName -> m PackageName
getPackageName InitFlags
flags (m PackageName -> m PackageName) -> m PackageName -> m PackageName
forall a b. (a -> b) -> a -> b
$ do
    PackageName
defName <- FilePath -> m PackageName
forall (m :: * -> *). Interactive m => FilePath -> m PackageName
guessPackageName (FilePath -> m PackageName) -> m FilePath -> m PackageName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case InitFlags -> Flag FilePath
packageDir InitFlags
flags of
      Flag FilePath
a -> FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
a
      Flag FilePath
NoFlag -> [FilePath] -> FilePath
forall a. [a] -> a
last ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories (FilePath -> FilePath) -> 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

    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageName -> Bool
isPkgRegistered PackageName
defName)
      (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn (PackageName -> FilePath
inUseMsg PackageName
defName)

    PackageName -> m PackageName
forall (m :: * -> *) a. Monad m => a -> m a
return PackageName
defName

  where
    isPkgRegistered :: PackageName -> Bool
isPkgRegistered = PackageIndex UnresolvedSourcePackage -> PackageName -> Bool
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> Bool
elemByPackageName (SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
sourcePkgDb)

    inUseMsg :: PackageName -> FilePath
inUseMsg PackageName
pn = FilePath
"The name "
      FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
unPackageName PackageName
pn
      FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is already in use by another package on Hackage."

-- | Package version: use 0.1.0.0 as a last resort
versionHeuristics :: Interactive m => InitFlags -> m Version
versionHeuristics :: InitFlags -> m Version
versionHeuristics InitFlags
flags = InitFlags -> m Version -> m Version
forall (m :: * -> *).
Interactive m =>
InitFlags -> m Version -> m Version
getVersion InitFlags
flags (m Version -> m Version) -> m Version -> m Version
forall a b. (a -> b) -> a -> b
$ Version -> m Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
defaultVersion

-- | Choose a license for the package.
-- The license can come from Initflags (license field), if it is not present
-- then prompt the user from a predefined list of licenses.
licenseHeuristics :: Interactive m => InitFlags -> m SpecLicense
licenseHeuristics :: InitFlags -> m SpecLicense
licenseHeuristics InitFlags
flags = InitFlags -> m SpecLicense -> m SpecLicense
forall (m :: * -> *).
Interactive m =>
InitFlags -> m SpecLicense -> m SpecLicense
getLicense InitFlags
flags (m SpecLicense -> m SpecLicense) -> m SpecLicense -> m SpecLicense
forall a b. (a -> b) -> a -> b
$ InitFlags -> m SpecLicense
forall (m :: * -> *). Interactive m => InitFlags -> m SpecLicense
guessLicense InitFlags
flags

-- | The author's name. Prompt, or try to guess from an existing
--   darcs repo.
authorHeuristics :: Interactive m => InitFlags -> m String
authorHeuristics :: InitFlags -> m FilePath
authorHeuristics InitFlags
flags = InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getAuthor InitFlags
flags m FilePath
forall (m :: * -> *). Interactive m => m FilePath
guessAuthorEmail

-- | The author's email. Prompt, or try to guess from an existing
--   darcs repo.
emailHeuristics :: Interactive m => InitFlags -> m String
emailHeuristics :: InitFlags -> m FilePath
emailHeuristics InitFlags
flags = InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getEmail InitFlags
flags m FilePath
forall (m :: * -> *). Interactive m => m FilePath
guessAuthorName

-- | Prompt for a homepage URL for the package.
homepageHeuristics :: Interactive m => InitFlags -> m String
homepageHeuristics :: InitFlags -> m FilePath
homepageHeuristics InitFlags
flags = InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getHomepage InitFlags
flags (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""

-- | Prompt for a project synopsis.
synopsisHeuristics :: Interactive m => InitFlags -> m String
synopsisHeuristics :: InitFlags -> m FilePath
synopsisHeuristics InitFlags
flags = InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getSynopsis InitFlags
flags (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""

-- | Prompt for a package category.
--   Note that it should be possible to do some smarter guessing here too, i.e.
--   look at the name of the top level source directory.
categoryHeuristics :: Interactive m => InitFlags -> m String
categoryHeuristics :: InitFlags -> m FilePath
categoryHeuristics InitFlags
flags = InitFlags -> m FilePath -> m FilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m FilePath -> m FilePath
getCategory InitFlags
flags (m FilePath -> m FilePath) -> m FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""

-- | Try to guess extra source files.
extraDocFileHeuristics :: Interactive m => InitFlags -> m (Maybe (Set FilePath))
extraDocFileHeuristics :: InitFlags -> m (Maybe (Set FilePath))
extraDocFileHeuristics InitFlags
flags = case InitFlags -> Flag [FilePath]
extraDoc InitFlags
flags of
  Flag [FilePath]
x -> Maybe (Set FilePath) -> m (Maybe (Set FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Set FilePath) -> m (Maybe (Set FilePath)))
-> Maybe (Set FilePath) -> m (Maybe (Set FilePath))
forall a b. (a -> b) -> a -> b
$ Set FilePath -> Maybe (Set FilePath)
forall a. a -> Maybe a
Just (Set FilePath -> Maybe (Set FilePath))
-> Set FilePath -> Maybe (Set FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
x
  Flag [FilePath]
_ -> InitFlags -> m (Maybe (Set FilePath))
forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Maybe (Set FilePath))
guessExtraDocFiles InitFlags
flags

-- | Try to guess if the project builds a library, an executable, or both.
packageTypeHeuristics :: Interactive m => InitFlags -> m PackageType
packageTypeHeuristics :: InitFlags -> m PackageType
packageTypeHeuristics InitFlags
flags = InitFlags -> m PackageType -> m PackageType
forall (m :: * -> *).
Interactive m =>
InitFlags -> m PackageType -> m PackageType
getPackageType InitFlags
flags (m PackageType -> m PackageType) -> m PackageType -> m PackageType
forall a b. (a -> b) -> a -> b
$ InitFlags -> m PackageType
forall (m :: * -> *). Interactive m => InitFlags -> m PackageType
guessPackageType InitFlags
flags

-- | Try to guess the main file, if nothing is found, fallback
--   to a default value.
mainFileHeuristics :: Interactive m => InitFlags -> m HsFilePath
mainFileHeuristics :: InitFlags -> m HsFilePath
mainFileHeuristics InitFlags
flags = do
  FilePath
appDir <- [FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath) -> m [FilePath] -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
appDirsHeuristics InitFlags
flags
  InitFlags -> m HsFilePath -> m HsFilePath
forall (m :: * -> *).
Interactive m =>
InitFlags -> m HsFilePath -> m HsFilePath
getMainFile InitFlags
flags (m HsFilePath -> m HsFilePath)
-> (FilePath -> m HsFilePath) -> FilePath -> m HsFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m HsFilePath
forall (m :: * -> *). Interactive m => FilePath -> m HsFilePath
guessMainFile (FilePath -> m HsFilePath) -> FilePath -> m HsFilePath
forall a b. (a -> b) -> a -> b
$ FilePath
appDir

testMainHeuristics :: Interactive m => InitFlags -> m HsFilePath
testMainHeuristics :: InitFlags -> m HsFilePath
testMainHeuristics InitFlags
flags = do
  FilePath
testDir <- [FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath) -> m [FilePath] -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
testDirsHeuristics InitFlags
flags
  FilePath -> m HsFilePath
forall (m :: * -> *). Interactive m => FilePath -> m HsFilePath
guessMainFile FilePath
testDir

initializeTestSuiteHeuristics :: Interactive m => InitFlags -> m Bool
initializeTestSuiteHeuristics :: InitFlags -> m Bool
initializeTestSuiteHeuristics InitFlags
flags = InitFlags -> m Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getInitializeTestSuite InitFlags
flags (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

testDirsHeuristics :: Interactive m => InitFlags -> m [String]
testDirsHeuristics :: InitFlags -> m [FilePath]
testDirsHeuristics InitFlags
flags = InitFlags -> m [FilePath] -> m [FilePath]
forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getTestDirs InitFlags
flags (m [FilePath] -> m [FilePath]) -> m [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
defaultTestDir]

-- | Ask for the Haskell base language of the package.
languageHeuristics :: Interactive m => InitFlags -> Compiler -> m Language
languageHeuristics :: InitFlags -> Compiler -> m Language
languageHeuristics InitFlags
flags Compiler
comp = InitFlags -> m Language -> m Language
forall (m :: * -> *).
Interactive m =>
InitFlags -> m Language -> m Language
getLanguage InitFlags
flags (m Language -> m Language) -> m Language -> m Language
forall a b. (a -> b) -> a -> b
$ Compiler -> m Language
forall (m :: * -> *). Interactive m => Compiler -> m Language
guessLanguage Compiler
comp

-- | Ask whether to generate explanatory comments.
noCommentsHeuristics :: Interactive m => InitFlags -> m Bool
noCommentsHeuristics :: InitFlags -> m Bool
noCommentsHeuristics InitFlags
flags = InitFlags -> m Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getNoComments InitFlags
flags (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Ask for the application root directory.
appDirsHeuristics :: Interactive m => InitFlags -> m [String]
appDirsHeuristics :: InitFlags -> m [FilePath]
appDirsHeuristics InitFlags
flags = InitFlags -> m [FilePath] -> m [FilePath]
forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getAppDirs InitFlags
flags (m [FilePath] -> m [FilePath]) -> m [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
guessApplicationDirectories InitFlags
flags

-- | Ask for the source (library) root directory.
srcDirsHeuristics :: Interactive m => InitFlags -> m [String]
srcDirsHeuristics :: InitFlags -> m [FilePath]
srcDirsHeuristics InitFlags
flags = InitFlags -> m [FilePath] -> m [FilePath]
forall (m :: * -> *).
Interactive m =>
InitFlags -> m [FilePath] -> m [FilePath]
getSrcDirs InitFlags
flags (m [FilePath] -> m [FilePath]) -> m [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
guessSourceDirectories InitFlags
flags

-- | Retrieve the list of exposed modules
exposedModulesHeuristics :: Interactive m => InitFlags -> m (NonEmpty ModuleName)
exposedModulesHeuristics :: InitFlags -> m (NonEmpty ModuleName)
exposedModulesHeuristics InitFlags
flags = do
  [ModuleName]
mods <- case InitFlags -> Flag [ModuleName]
exposedModules InitFlags
flags of
    Flag [ModuleName]
x -> [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return [ModuleName]
x
    Flag [ModuleName]
NoFlag -> do
      FilePath
srcDir <- FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultSourceDir (Maybe FilePath -> FilePath)
-> ([FilePath] -> Maybe FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeHead ([FilePath] -> FilePath) -> m [FilePath] -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitFlags -> m [FilePath]
forall (m :: * -> *). Interactive m => InitFlags -> m [FilePath]
srcDirsHeuristics InitFlags
flags

      Bool
exists <- FilePath -> m Bool
forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist FilePath
srcDir

      if Bool
exists
        then do
          [FilePath]
modules      <- (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
srcDir
          [ModuleName]
modulesNames <- [Maybe ModuleName] -> [ModuleName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ModuleName] -> [ModuleName])
-> m [Maybe ModuleName] -> m [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m (Maybe ModuleName))
-> [FilePath] -> m [Maybe ModuleName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> m (Maybe ModuleName)
forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe ModuleName)
retrieveModuleName [FilePath]
modules

          [ModuleName]
otherModules' <- InitFlags -> m [ModuleName]
forall (m :: * -> *). Interactive m => InitFlags -> m [ModuleName]
libOtherModulesHeuristics InitFlags
flags
          [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ModuleName] -> m [ModuleName]) -> [ModuleName] -> m [ModuleName]
forall a b. (a -> b) -> a -> b
$ (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ModuleName]
otherModules') [ModuleName]
modulesNames
        
        else
          [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return []

  NonEmpty ModuleName -> m (NonEmpty ModuleName)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty ModuleName -> m (NonEmpty ModuleName))
-> NonEmpty ModuleName -> m (NonEmpty ModuleName)
forall a b. (a -> b) -> a -> b
$ if [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleName]
mods
    then ModuleName
myLibModule ModuleName -> [ModuleName] -> NonEmpty ModuleName
forall a. a -> [a] -> NonEmpty a
NEL.:| []
    else [ModuleName] -> NonEmpty ModuleName
forall a. [a] -> NonEmpty a
NEL.fromList [ModuleName]
mods

-- | Retrieve the list of other modules for Libraries, filtering them
--   based on the last component of the module name
libOtherModulesHeuristics :: Interactive m => InitFlags -> m [ModuleName]
libOtherModulesHeuristics :: InitFlags -> m [ModuleName]
libOtherModulesHeuristics InitFlags
flags = case InitFlags -> Flag [ModuleName]
otherModules InitFlags
flags of
  Flag [ModuleName]
x -> [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return [ModuleName]
x
  Flag [ModuleName]
NoFlag -> do
    let otherCandidates :: [FilePath]
otherCandidates = [FilePath
"Internal", FilePath
"Utils"]
        srcDir :: FilePath
srcDir = case InitFlags -> Flag [FilePath]
sourceDirs InitFlags
flags of
          Flag [FilePath]
x -> FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultSourceDir (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeHead [FilePath]
x
          Flag [FilePath]
NoFlag -> FilePath
defaultSourceDir

    FilePath
libDir <- (FilePath -> FilePath -> FilePath
</> FilePath
srcDir) (FilePath -> FilePath) -> m FilePath -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case InitFlags -> Flag FilePath
packageDir InitFlags
flags of
      Flag FilePath
x -> FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
      Flag FilePath
NoFlag -> m FilePath
forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory

    Bool
exists <- FilePath -> m Bool
forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist FilePath
libDir
    if Bool
exists
      then do
        [FilePath]
otherModules' <- (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
libDir
        (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
otherCandidates) (FilePath -> Bool)
-> (ModuleName -> FilePath) -> ModuleName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
last ([FilePath] -> FilePath)
-> (ModuleName -> [FilePath]) -> ModuleName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [FilePath]
components)
          ([ModuleName] -> [ModuleName])
-> ([Maybe ModuleName] -> [ModuleName])
-> [Maybe ModuleName]
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe ModuleName] -> [ModuleName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ModuleName] -> [ModuleName])
-> m [Maybe ModuleName] -> m [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m (Maybe ModuleName))
-> [FilePath] -> m [Maybe ModuleName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> m (Maybe ModuleName)
forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe ModuleName)
retrieveModuleName [FilePath]
otherModules'
      else [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Retrieve the list of other modules for Executables, it lists everything
--   that is a Haskell file within the application directory, excluding the main file
exeOtherModulesHeuristics :: Interactive m => InitFlags -> m [ModuleName]
exeOtherModulesHeuristics :: InitFlags -> m [ModuleName]
exeOtherModulesHeuristics InitFlags
flags = case InitFlags -> Flag [ModuleName]
otherModules InitFlags
flags of
  Flag [ModuleName]
x -> [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return [ModuleName]
x
  Flag [ModuleName]
NoFlag -> do
    let appDir :: FilePath
appDir = case InitFlags -> Flag [FilePath]
applicationDirs InitFlags
flags of
          Flag [FilePath]
x -> FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultApplicationDir (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeHead [FilePath]
x
          Flag [FilePath]
NoFlag -> FilePath
defaultApplicationDir

    FilePath
exeDir <- (FilePath -> FilePath -> FilePath
</> FilePath
appDir) (FilePath -> FilePath) -> m FilePath -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case InitFlags -> Flag FilePath
packageDir InitFlags
flags of
      Flag FilePath
x -> FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
      Flag FilePath
NoFlag -> m FilePath
forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory

    Bool
exists <- FilePath -> m Bool
forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist FilePath
exeDir
    if Bool
exists
      then do
        [FilePath]
otherModules' <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
f -> Bool -> Bool
not (FilePath -> Bool
isMain FilePath
f) Bool -> Bool -> Bool
&& FilePath -> Bool
isHaskell FilePath
f)
          ([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
exeDir
        [Maybe ModuleName] -> [ModuleName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ModuleName] -> [ModuleName])
-> m [Maybe ModuleName] -> m [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m (Maybe ModuleName))
-> [FilePath] -> m [Maybe ModuleName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> m (Maybe ModuleName)
forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe ModuleName)
retrieveModuleName [FilePath]
otherModules'
      else [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Retrieve the list of other modules for Tests, it lists everything
--   that is a Haskell file within the tests directory, excluding the main file
testOtherModulesHeuristics :: Interactive m => InitFlags -> m [ModuleName]
testOtherModulesHeuristics :: InitFlags -> m [ModuleName]
testOtherModulesHeuristics InitFlags
flags = case InitFlags -> Flag [ModuleName]
otherModules InitFlags
flags of
  Flag [ModuleName]
x -> [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return [ModuleName]
x
  Flag [ModuleName]
NoFlag -> do
    let testDir :: FilePath
testDir = case InitFlags -> Flag [FilePath]
testDirs InitFlags
flags of
          Flag [FilePath]
x -> FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultTestDir (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeHead [FilePath]
x
          Flag [FilePath]
NoFlag -> FilePath
defaultTestDir

    FilePath
testDir' <- (FilePath -> FilePath -> FilePath
</> FilePath
testDir) (FilePath -> FilePath) -> m FilePath -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case InitFlags -> Flag FilePath
packageDir InitFlags
flags of
      Flag FilePath
x -> FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
      Flag FilePath
NoFlag -> m FilePath
forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory

    Bool
exists <- FilePath -> m Bool
forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist FilePath
testDir'
    if Bool
exists
      then do
        [FilePath]
otherModules' <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
f -> Bool -> Bool
not (FilePath -> Bool
isMain FilePath
f) Bool -> Bool -> Bool
&& FilePath -> Bool
isHaskell FilePath
f)
          ([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
testDir'
        [Maybe ModuleName] -> [ModuleName]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ModuleName] -> [ModuleName])
-> m [Maybe ModuleName] -> m [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m (Maybe ModuleName))
-> [FilePath] -> m [Maybe ModuleName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> m (Maybe ModuleName)
forall (m :: * -> *).
Interactive m =>
FilePath -> m (Maybe ModuleName)
retrieveModuleName [FilePath]
otherModules'
      else [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Retrieve the list of build tools
buildToolsHeuristics
    :: Interactive m
    => InitFlags
    -> FilePath
    -> CabalSpecVersion
    -> m [Dependency]
buildToolsHeuristics :: InitFlags -> FilePath -> CabalSpecVersion -> m [Dependency]
buildToolsHeuristics InitFlags
flags FilePath
fp CabalSpecVersion
v = case InitFlags -> Flag [FilePath]
buildTools InitFlags
flags of
  Flag{} -> InitFlags -> m [Dependency]
forall (m :: * -> *). Interactive m => InitFlags -> m [Dependency]
getBuildTools InitFlags
flags
  Flag [FilePath]
NoFlag -> CabalSpecVersion -> FilePath -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
CabalSpecVersion -> FilePath -> m [Dependency]
retrieveBuildTools CabalSpecVersion
v FilePath
fp

-- | Retrieve the list of dependencies
dependenciesHeuristics :: Interactive m => InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
dependenciesHeuristics :: InitFlags -> FilePath -> InstalledPackageIndex -> m [Dependency]
dependenciesHeuristics InitFlags
flags FilePath
fp InstalledPackageIndex
pkgIx = InitFlags -> m [Dependency] -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InitFlags -> m [Dependency] -> m [Dependency]
getDependencies InitFlags
flags (m [Dependency] -> m [Dependency])
-> m [Dependency] -> m [Dependency]
forall a b. (a -> b) -> a -> b
$ do
  [SourceFileEntry]
sources <- FilePath -> m [SourceFileEntry]
forall (m :: * -> *).
Interactive m =>
FilePath -> m [SourceFileEntry]
retrieveSourceFiles FilePath
fp

  let mods :: [ModuleName]
mods = case InitFlags -> Flag [ModuleName]
exposedModules InitFlags
flags of
        Flag [ModuleName]
x -> [ModuleName]
x
        Flag [ModuleName]
NoFlag -> (SourceFileEntry -> ModuleName)
-> [SourceFileEntry] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map SourceFileEntry -> ModuleName
moduleName [SourceFileEntry]
sources

      groupedDeps :: [(ModuleName, ModuleName)]
groupedDeps  = (SourceFileEntry -> [(ModuleName, ModuleName)])
-> [SourceFileEntry] -> [(ModuleName, ModuleName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\SourceFileEntry
s -> (ModuleName -> (ModuleName, ModuleName))
-> [ModuleName] -> [(ModuleName, ModuleName)]
forall a b. (a -> b) -> [a] -> [b]
map (\ModuleName
i -> (SourceFileEntry -> ModuleName
moduleName SourceFileEntry
s, ModuleName
i)) (SourceFileEntry -> [ModuleName]
imports SourceFileEntry
s)) [SourceFileEntry]
sources
      filteredDeps :: [(ModuleName, ModuleName)]
filteredDeps = ((ModuleName, ModuleName) -> Bool)
-> [(ModuleName, ModuleName)] -> [(ModuleName, ModuleName)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ModuleName]
mods) (ModuleName -> Bool)
-> ((ModuleName, ModuleName) -> ModuleName)
-> (ModuleName, ModuleName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, ModuleName) -> ModuleName
forall a b. (a, b) -> b
snd) [(ModuleName, ModuleName)]
groupedDeps
      preludeNub :: [(ModuleName, ModuleName)]
preludeNub   = ((ModuleName, ModuleName) -> (ModuleName, ModuleName) -> Bool)
-> [(ModuleName, ModuleName)] -> [(ModuleName, ModuleName)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(ModuleName, ModuleName)
a (ModuleName, ModuleName)
b -> (ModuleName, ModuleName) -> ModuleName
forall a b. (a, b) -> b
snd (ModuleName, ModuleName)
a ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== (ModuleName, ModuleName) -> ModuleName
forall a b. (a, b) -> b
snd (ModuleName, ModuleName)
b) ([(ModuleName, ModuleName)] -> [(ModuleName, ModuleName)])
-> [(ModuleName, ModuleName)] -> [(ModuleName, ModuleName)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
fromString FilePath
"Prelude", FilePath -> ModuleName
forall a. IsString a => FilePath -> a
fromString FilePath
"Prelude") (ModuleName, ModuleName)
-> [(ModuleName, ModuleName)] -> [(ModuleName, ModuleName)]
forall a. a -> [a] -> [a]
: [(ModuleName, ModuleName)]
filteredDeps

  Verbosity
-> InitFlags
-> [(ModuleName, ModuleName)]
-> InstalledPackageIndex
-> m [Dependency]
forall (m :: * -> *).
Interactive m =>
Verbosity
-> InitFlags
-> [(ModuleName, ModuleName)]
-> InstalledPackageIndex
-> m [Dependency]
retrieveDependencies (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ InitFlags -> Flag Verbosity
initVerbosity InitFlags
flags) InitFlags
flags [(ModuleName, ModuleName)]
preludeNub InstalledPackageIndex
pkgIx

-- | Retrieve the list of extensions
otherExtsHeuristics :: Interactive m => InitFlags -> FilePath -> m [Extension]
otherExtsHeuristics :: InitFlags -> FilePath -> m [Extension]
otherExtsHeuristics InitFlags
flags FilePath
fp = case InitFlags -> Flag [Extension]
otherExts InitFlags
flags of
  Flag [Extension]
x -> [Extension] -> m [Extension]
forall (m :: * -> *) a. Monad m => a -> m a
return [Extension]
x
  Flag [Extension]
NoFlag -> do
    Bool
exists <- FilePath -> m Bool
forall (m :: * -> *). Interactive m => FilePath -> m Bool
doesDirectoryExist FilePath
fp
    if Bool
exists
      then do
        [FilePath]
sources     <- FilePath -> m [FilePath]
forall (m :: * -> *). Interactive m => FilePath -> m [FilePath]
listFilesRecursive FilePath
fp
        [[Extension]]
extensions' <- (FilePath -> m [Extension]) -> [FilePath] -> m [[Extension]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> m [Extension]
forall (m :: * -> *). Interactive m => FilePath -> m [Extension]
retrieveModuleExtensions ([FilePath] -> m [[Extension]])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> m [[Extension]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isHaskell ([FilePath] -> m [[Extension]]) -> [FilePath] -> m [[Extension]]
forall a b. (a -> b) -> a -> b
$ [FilePath]
sources

        [Extension] -> m [Extension]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Extension] -> m [Extension]) -> [Extension] -> m [Extension]
forall a b. (a -> b) -> a -> b
$ [Extension] -> [Extension]
forall a. Eq a => [a] -> [a]
nub ([Extension] -> [Extension])
-> ([[Extension]] -> [Extension]) -> [[Extension]] -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Extension]] -> [Extension]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Extension]] -> [Extension]) -> [[Extension]] -> [Extension]
forall a b. (a -> b) -> a -> b
$ [[Extension]]
extensions'
      else
        [Extension] -> m [Extension]
forall (m :: * -> *) a. Monad m => a -> m a
return []