module Distribution.Client.Init.Simple
  ( -- * Project creation
    createProject

    -- * Gen targets
  , genSimplePkgDesc
  , genSimpleLibTarget
  , genSimpleExeTarget
  , genSimpleTestTarget
  ) where

import qualified Data.List.NonEmpty as NEL
import qualified Data.Set as Set
import Distribution.Client.Init.Defaults
import Distribution.Client.Init.FlagExtractors
import Distribution.Client.Init.Types
import Distribution.Client.Init.Utils (currentDirPkgName, fixupDocFiles, mkPackageNameDep)
import Distribution.Client.Types.SourcePackageDb (SourcePackageDb (..))
import Distribution.Simple.Flag (Flag (..), flagElim, fromFlagOrDefault)
import Distribution.Simple.PackageIndex
import Distribution.Types.Dependency
import Distribution.Types.PackageName (unPackageName)
import Distribution.Verbosity

createProject
  :: Interactive m
  => Verbosity
  -> InstalledPackageIndex
  -> SourcePackageDb
  -> InitFlags
  -> m ProjectSettings
createProject :: forall (m :: * -> *).
Interactive m =>
Verbosity
-> InstalledPackageIndex
-> SourcePackageDb
-> InitFlags
-> m ProjectSettings
createProject Verbosity
v InstalledPackageIndex
pkgIx SourcePackageDb
_srcDb InitFlags
initFlags = do
  pkgType <- InitFlags -> m PackageType
forall (m :: * -> *). Interactive m => InitFlags -> m PackageType
packageTypePrompt InitFlags
initFlags
  isMinimal <- getMinimal initFlags
  doOverwrite <- getOverwrite initFlags
  pkgDir <- getPackageDir initFlags
  pkgDesc <- fixupDocFiles v =<< genSimplePkgDesc initFlags

  let pkgName = PkgDescription -> PackageName
_pkgName PkgDescription
pkgDesc
      cabalSpec = PkgDescription -> CabalSpecVersion
_pkgCabalVersion PkgDescription
pkgDesc
      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

  basedFlags <- addBaseDepToFlags pkgIx initFlags

  case pkgType of
    PackageType
Library -> do
      libTarget <- InitFlags -> m LibTarget
forall (m :: * -> *). Interactive m => InitFlags -> m LibTarget
genSimpleLibTarget InitFlags
basedFlags
      testTarget <- addLibDepToTest pkgName <$> genSimpleTestTarget basedFlags
      return $
        ProjectSettings
          (mkOpts False cabalSpec)
          pkgDesc
          (Just libTarget)
          Nothing
          testTarget
    PackageType
Executable -> do
      exeTarget <- InitFlags -> m ExeTarget
forall (m :: * -> *). Interactive m => InitFlags -> m ExeTarget
genSimpleExeTarget InitFlags
basedFlags
      return $
        ProjectSettings
          (mkOpts False cabalSpec)
          pkgDesc
          Nothing
          (Just exeTarget)
          Nothing
    PackageType
LibraryAndExecutable -> do
      libTarget <- InitFlags -> m LibTarget
forall (m :: * -> *). Interactive m => InitFlags -> m LibTarget
genSimpleLibTarget InitFlags
basedFlags
      testTarget <- addLibDepToTest pkgName <$> genSimpleTestTarget basedFlags
      exeTarget <- addLibDepToExe pkgName <$> genSimpleExeTarget basedFlags
      return $
        ProjectSettings
          (mkOpts False cabalSpec)
          pkgDesc
          (Just libTarget)
          (Just exeTarget)
          testTarget
    PackageType
TestSuite -> do
      testTarget <- InitFlags -> m (Maybe TestTarget)
forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Maybe TestTarget)
genSimpleTestTarget InitFlags
basedFlags
      return $
        ProjectSettings
          (mkOpts False cabalSpec)
          pkgDesc
          Nothing
          Nothing
          testTarget
  where
    -- Add package name as dependency of test suite
    --
    addLibDepToTest :: PackageName -> Maybe TestTarget -> Maybe TestTarget
addLibDepToTest PackageName
_ Maybe TestTarget
Nothing = Maybe TestTarget
forall a. Maybe a
Nothing
    addLibDepToTest PackageName
n (Just TestTarget
t) =
      TestTarget -> Maybe TestTarget
forall a. a -> Maybe a
Just (TestTarget -> Maybe TestTarget) -> TestTarget -> Maybe TestTarget
forall a b. (a -> b) -> a -> b
$
        TestTarget
t
          { _testDependencies = _testDependencies t ++ [mkPackageNameDep n]
          }

    -- Add package name as dependency of executable
    --
    addLibDepToExe :: PackageName -> ExeTarget -> ExeTarget
addLibDepToExe PackageName
n ExeTarget
exe =
      ExeTarget
exe
        { _exeDependencies = _exeDependencies exe ++ [mkPackageNameDep n]
        }

genSimplePkgDesc :: Interactive m => InitFlags -> m PkgDescription
genSimplePkgDesc :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m PkgDescription
genSimplePkgDesc InitFlags
flags = PackageName -> PkgDescription
mkPkgDesc (PackageName -> PkgDescription)
-> m PackageName -> m PkgDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PackageName
forall (m :: * -> *). Interactive m => m PackageName
currentDirPkgName
  where
    defaultExtraDoc :: Maybe (Set FilePath)
defaultExtraDoc = 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. a -> Set a
Set.singleton FilePath
defaultChangelog

    extractExtraDoc :: [FilePath] -> Maybe (Set FilePath)
extractExtraDoc [] = Maybe (Set FilePath)
defaultExtraDoc
    extractExtraDoc [FilePath]
fs = 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]
fs

    mkPkgDesc :: PackageName -> PkgDescription
mkPkgDesc PackageName
pkgName =
      CabalSpecVersion
-> PackageName
-> Version
-> SpecLicense
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Set FilePath
-> Maybe (Set FilePath)
-> PkgDescription
PkgDescription
        (CabalSpecVersion -> Flag CabalSpecVersion -> CabalSpecVersion
forall a. a -> Flag a -> a
fromFlagOrDefault CabalSpecVersion
defaultCabalVersion (InitFlags -> Flag CabalSpecVersion
cabalVersion InitFlags
flags))
        PackageName
pkgName
        (Version -> Flag Version -> Version
forall a. a -> Flag a -> a
fromFlagOrDefault Version
defaultVersion (InitFlags -> Flag Version
version InitFlags
flags))
        (SpecLicense -> Flag SpecLicense -> SpecLicense
forall a. a -> Flag a -> a
fromFlagOrDefault (CabalSpecVersion -> SpecLicense
defaultLicense (CabalSpecVersion -> SpecLicense)
-> CabalSpecVersion -> SpecLicense
forall a b. (a -> b) -> a -> b
$ InitFlags -> CabalSpecVersion
getCabalVersionNoPrompt InitFlags
flags) (InitFlags -> Flag SpecLicense
license InitFlags
flags))
        (FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" (InitFlags -> Flag FilePath
author InitFlags
flags))
        (FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" (InitFlags -> Flag FilePath
email InitFlags
flags))
        (FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" (InitFlags -> Flag FilePath
homepage InitFlags
flags))
        (FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" (InitFlags -> Flag FilePath
synopsis InitFlags
flags))
        (FilePath -> Flag FilePath -> FilePath
forall a. a -> Flag a -> a
fromFlagOrDefault FilePath
"" (InitFlags -> Flag FilePath
category InitFlags
flags))
        (Set FilePath
-> ([FilePath] -> Set FilePath) -> Flag [FilePath] -> Set FilePath
forall b a. b -> (a -> b) -> Flag a -> b
flagElim Set FilePath
forall a. Monoid a => a
mempty [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList (InitFlags -> Flag [FilePath]
extraSrc InitFlags
flags))
        (Maybe (Set FilePath)
-> ([FilePath] -> Maybe (Set FilePath))
-> Flag [FilePath]
-> Maybe (Set FilePath)
forall b a. b -> (a -> b) -> Flag a -> b
flagElim Maybe (Set FilePath)
defaultExtraDoc [FilePath] -> Maybe (Set FilePath)
extractExtraDoc (InitFlags -> Flag [FilePath]
extraDoc InitFlags
flags))

genSimpleLibTarget :: Interactive m => InitFlags -> m LibTarget
genSimpleLibTarget :: forall (m :: * -> *). Interactive m => InitFlags -> m LibTarget
genSimpleLibTarget InitFlags
flags = do
  buildToolDeps <- InitFlags -> m [Dependency]
forall (m :: * -> *). Interactive m => InitFlags -> m [Dependency]
getBuildTools InitFlags
flags
  return $
    LibTarget
      { _libSourceDirs = fromFlagOrDefault [defaultSourceDir] $ sourceDirs flags
      , _libLanguage = fromFlagOrDefault defaultLanguage $ language flags
      , _libExposedModules =
          flagElim (myLibModule NEL.:| []) extractMods $ exposedModules flags
      , _libOtherModules = fromFlagOrDefault [] $ otherModules flags
      , _libOtherExts = fromFlagOrDefault [] $ otherExts flags
      , _libDependencies = fromFlagOrDefault [] $ dependencies flags
      , _libBuildTools = buildToolDeps
      }
  where
    extractMods :: [ModuleName] -> NonEmpty ModuleName
extractMods [] = ModuleName
myLibModule ModuleName -> [ModuleName] -> NonEmpty ModuleName
forall a. a -> [a] -> NonEmpty a
NEL.:| []
    extractMods [ModuleName]
as = [ModuleName] -> NonEmpty ModuleName
forall a. HasCallStack => [a] -> NonEmpty a
NEL.fromList [ModuleName]
as

genSimpleExeTarget :: Interactive m => InitFlags -> m ExeTarget
genSimpleExeTarget :: forall (m :: * -> *). Interactive m => InitFlags -> m ExeTarget
genSimpleExeTarget InitFlags
flags = do
  buildToolDeps <- InitFlags -> m [Dependency]
forall (m :: * -> *). Interactive m => InitFlags -> m [Dependency]
getBuildTools InitFlags
flags
  return $
    ExeTarget
      { _exeMainIs = flagElim defaultMainIs toHsFilePath $ mainIs flags
      , _exeApplicationDirs =
          fromFlagOrDefault [defaultApplicationDir] $ applicationDirs flags
      , _exeLanguage = fromFlagOrDefault defaultLanguage $ language flags
      , _exeOtherModules = fromFlagOrDefault [] $ otherModules flags
      , _exeOtherExts = fromFlagOrDefault [] $ otherExts flags
      , _exeDependencies = fromFlagOrDefault [] $ dependencies flags
      , _exeBuildTools = buildToolDeps
      }

genSimpleTestTarget :: Interactive m => InitFlags -> m (Maybe TestTarget)
genSimpleTestTarget :: forall (m :: * -> *).
Interactive m =>
InitFlags -> m (Maybe TestTarget)
genSimpleTestTarget InitFlags
flags = Bool -> m (Maybe TestTarget)
forall {m :: * -> *}. Interactive m => Bool -> m (Maybe TestTarget)
go (Bool -> m (Maybe TestTarget)) -> m Bool -> m (Maybe TestTarget)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InitFlags -> m Bool
forall (m :: * -> *). Interactive m => InitFlags -> m Bool
initializeTestSuitePrompt InitFlags
flags
  where
    go :: Bool -> m (Maybe TestTarget)
go Bool
initialized
      | Bool -> Bool
not Bool
initialized = Maybe TestTarget -> m (Maybe TestTarget)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TestTarget
forall a. Maybe a
Nothing
      | Bool
otherwise = do
          buildToolDeps <- InitFlags -> m [Dependency]
forall (m :: * -> *). Interactive m => InitFlags -> m [Dependency]
getBuildTools InitFlags
flags
          return $
            Just $
              TestTarget
                { _testMainIs = flagElim defaultMainIs toHsFilePath $ mainIs flags
                , _testDirs = fromFlagOrDefault [defaultTestDir] $ testDirs flags
                , _testLanguage = fromFlagOrDefault defaultLanguage $ language flags
                , _testOtherModules = fromFlagOrDefault [] $ otherModules flags
                , _testOtherExts = fromFlagOrDefault [] $ otherExts flags
                , _testDependencies = fromFlagOrDefault [] $ dependencies flags
                , _testBuildTools = buildToolDeps
                }

-- -------------------------------------------------------------------- --
-- Utils

-- | If deps are defined, and base is present, we skip the search for base.
-- otherwise, we look up @base@ and add it to the list.
addBaseDepToFlags :: Interactive m => InstalledPackageIndex -> InitFlags -> m InitFlags
addBaseDepToFlags :: forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m InitFlags
addBaseDepToFlags InstalledPackageIndex
pkgIx InitFlags
initFlags = case InitFlags -> Flag [Dependency]
dependencies InitFlags
initFlags of
  Flag [Dependency]
as
    | (Dependency -> Bool) -> [Dependency] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) FilePath
"base" (FilePath -> Bool)
-> (Dependency -> FilePath) -> Dependency -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
unPackageName (PackageName -> FilePath)
-> (Dependency -> PackageName) -> Dependency -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PackageName
depPkgName) [Dependency]
as -> InitFlags -> m InitFlags
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return InitFlags
initFlags
    | Bool
otherwise -> do
        based <- InstalledPackageIndex -> InitFlags -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgIx InitFlags
initFlags
        return $
          initFlags
            { dependencies = Flag $ based ++ as
            }
  Flag [Dependency]
NoFlag -> do
    based <- InstalledPackageIndex -> InitFlags -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgIx InitFlags
initFlags
    return initFlags{dependencies = Flag based}