{-# LANGUAGE LambdaCase #-}
module Distribution.Client.Init.FlagExtractors
( -- * Flag extractors
  getPackageDir
, getSimpleProject
, getMinimal
, getCabalVersion
, getCabalVersionNoPrompt
, getPackageName
, getVersion
, getLicense
, getAuthor
, getEmail
, getHomepage
, getSynopsis
, getCategory
, getExtraSrcFiles
, getExtraDocFiles
, getPackageType
, getMainFile
, getInitializeTestSuite
, getTestDirs
, getLanguage
, getNoComments
, getAppDirs
, getSrcDirs
, getExposedModules
, getBuildTools
, getDependencies
, getOtherExts
, getOverwrite
, getOtherModules
  -- * Shared prompts
, simpleProjectPrompt
, initializeTestSuitePrompt
, packageTypePrompt
, testMainPrompt
, dependenciesPrompt
) where


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

import qualified Data.List.NonEmpty as NEL

import Distribution.CabalSpecVersion (CabalSpecVersion(..))
import Distribution.Version (Version)
import Distribution.ModuleName (ModuleName)
import Distribution.Types.Dependency (Dependency(..))
import Distribution.Types.PackageName (PackageName)
import Distribution.Client.Init.Defaults
import Distribution.FieldGrammar.Newtypes (SpecLicense)
import Distribution.Client.Init.Types
import Distribution.Simple.Setup (Flag(..), fromFlagOrDefault, flagToMaybe)
import Distribution.Simple.Flag (flagElim)

import Language.Haskell.Extension (Language(..), Extension(..))
import Distribution.Client.Init.Prompt
import qualified Data.Set as Set
import Distribution.Simple.PackageIndex
import Distribution.Client.Init.Utils



-- -------------------------------------------------------------------- --
-- Flag extraction

getPackageDir :: Interactive m => InitFlags -> m FilePath
getPackageDir :: InitFlags -> m FilePath
getPackageDir = m FilePath
-> (FilePath -> m FilePath) -> Flag FilePath -> m FilePath
forall b a. b -> (a -> b) -> Flag a -> b
flagElim m FilePath
forall (m :: * -> *). Interactive m => m FilePath
getCurrentDirectory FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (Flag FilePath -> m FilePath)
-> (InitFlags -> Flag FilePath) -> InitFlags -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag FilePath
packageDir

-- | Ask if a simple project with sensible defaults should be created.
getSimpleProject :: Interactive m => InitFlags -> m Bool -> m Bool
getSimpleProject :: InitFlags -> m Bool -> m Bool
getSimpleProject InitFlags
flags = Flag Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Bool
simpleProject InitFlags
flags)

-- | Extract minimal cabal file flag (implies nocomments)
getMinimal :: Interactive m => InitFlags -> m Bool
getMinimal :: InitFlags -> m Bool
getMinimal = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (InitFlags -> Bool) -> InitFlags -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool)
-> (InitFlags -> Flag Bool) -> InitFlags -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag Bool
minimal

-- | 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 user is prompted to pick from a list of
-- supported versions (see code below).
getCabalVersion :: Interactive m => InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
getCabalVersion :: InitFlags -> m CabalSpecVersion -> m CabalSpecVersion
getCabalVersion InitFlags
flags = Flag CabalSpecVersion -> m CabalSpecVersion -> m CabalSpecVersion
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag CabalSpecVersion
cabalVersion InitFlags
flags)

getCabalVersionNoPrompt :: InitFlags -> CabalSpecVersion
getCabalVersionNoPrompt :: InitFlags -> CabalSpecVersion
getCabalVersionNoPrompt = CabalSpecVersion -> Flag CabalSpecVersion -> CabalSpecVersion
forall a. a -> Flag a -> a
fromFlagOrDefault CabalSpecVersion
defaultCabalVersion (Flag CabalSpecVersion -> CabalSpecVersion)
-> (InitFlags -> Flag CabalSpecVersion)
-> InitFlags
-> CabalSpecVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag CabalSpecVersion
cabalVersion

-- | 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.
getPackageName :: Interactive m => InitFlags -> m PackageName -> m PackageName
getPackageName :: InitFlags -> m PackageName -> m PackageName
getPackageName InitFlags
flags = Flag PackageName -> m PackageName -> m PackageName
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag PackageName
packageName InitFlags
flags)

-- | Package version: use 0.1.0.0 as a last resort, but try prompting the user
--  if possible.
getVersion :: Interactive m => InitFlags -> m Version -> m Version
getVersion :: InitFlags -> m Version -> m Version
getVersion InitFlags
flags = Flag Version -> m Version -> m Version
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Version
version InitFlags
flags)

-- | 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.
getLicense :: Interactive m => InitFlags -> m SpecLicense -> m SpecLicense
getLicense :: InitFlags -> m SpecLicense -> m SpecLicense
getLicense InitFlags
flags = Flag SpecLicense -> m SpecLicense -> m SpecLicense
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag SpecLicense
license InitFlags
flags)

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

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

-- | Prompt for a homepage URL for the package.
getHomepage :: Interactive m => InitFlags -> m String -> m String
getHomepage :: InitFlags -> m FilePath -> m FilePath
getHomepage InitFlags
flags = Flag FilePath -> m FilePath -> m FilePath
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag FilePath
homepage InitFlags
flags)

-- | Prompt for a project synopsis.
getSynopsis :: Interactive m => InitFlags -> m String -> m String
getSynopsis :: InitFlags -> m FilePath -> m FilePath
getSynopsis InitFlags
flags = Flag FilePath -> m FilePath -> m FilePath
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag FilePath
synopsis InitFlags
flags)

-- | 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.
getCategory :: Interactive m => InitFlags -> m String -> m String
getCategory :: InitFlags -> m FilePath -> m FilePath
getCategory InitFlags
flags = Flag FilePath -> m FilePath -> m FilePath
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag FilePath
category InitFlags
flags)

-- | Try to guess extra source files (don't prompt the user).
getExtraSrcFiles :: Interactive m => InitFlags -> m (Set String)
getExtraSrcFiles :: InitFlags -> m (Set FilePath)
getExtraSrcFiles = Set FilePath -> m (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set FilePath -> m (Set FilePath))
-> (InitFlags -> Set FilePath) -> InitFlags -> m (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Flag [FilePath] -> Set FilePath)
-> (InitFlags -> Flag [FilePath]) -> InitFlags -> Set FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [FilePath]
extraSrc

-- | Try to guess extra source files (don't prompt the user).
getExtraDocFiles :: Interactive m => InitFlags -> m (Maybe (Set String))
getExtraDocFiles :: InitFlags -> m (Maybe (Set FilePath))
getExtraDocFiles = Maybe (Set FilePath) -> m (Maybe (Set FilePath))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (Maybe (Set FilePath) -> m (Maybe (Set FilePath)))
-> (InitFlags -> Maybe (Set FilePath))
-> InitFlags
-> m (Maybe (Set FilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set FilePath -> Maybe (Set FilePath)
forall a. a -> Maybe a
Just
  (Set FilePath -> Maybe (Set FilePath))
-> (InitFlags -> Set FilePath) -> InitFlags -> Maybe (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set FilePath
-> ([FilePath] -> Set FilePath) -> Flag [FilePath] -> Set FilePath
forall b a. b -> (a -> b) -> Flag a -> b
flagElim (FilePath -> Set FilePath
forall a. a -> Set a
Set.singleton FilePath
defaultChangelog) [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList
  (Flag [FilePath] -> Set FilePath)
-> (InitFlags -> Flag [FilePath]) -> InitFlags -> Set FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [FilePath]
extraDoc

-- | Ask whether the project builds a library or executable.
getPackageType :: Interactive m => InitFlags -> m PackageType -> m PackageType
getPackageType :: InitFlags -> m PackageType -> m PackageType
getPackageType InitFlags
  { initializeTestSuite :: InitFlags -> Flag Bool
initializeTestSuite = Flag Bool
True
  , packageType :: InitFlags -> Flag PackageType
packageType         = Flag PackageType
NoFlag
  } m PackageType
_ = PackageType -> m PackageType
forall (m :: * -> *) a. Monad m => a -> m a
return PackageType
TestSuite
getPackageType InitFlags
flags m PackageType
act = Flag PackageType -> m PackageType -> m PackageType
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag PackageType
packageType InitFlags
flags) m PackageType
act

getMainFile :: Interactive m => InitFlags -> m HsFilePath -> m HsFilePath
getMainFile :: InitFlags -> m HsFilePath -> m HsFilePath
getMainFile InitFlags
flags m HsFilePath
act = case InitFlags -> Flag FilePath
mainIs InitFlags
flags of
    Flag FilePath
a
      | FilePath -> Bool
isHsFilePath FilePath
a -> HsFilePath -> m HsFilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (HsFilePath -> m HsFilePath) -> HsFilePath -> m HsFilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> HsFilePath
toHsFilePath FilePath
a
      | Bool
otherwise -> m HsFilePath
act
    Flag FilePath
NoFlag -> m HsFilePath
act

getInitializeTestSuite :: Interactive m => InitFlags -> m Bool -> m Bool
getInitializeTestSuite :: InitFlags -> m Bool -> m Bool
getInitializeTestSuite InitFlags
flags = Flag Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Bool
initializeTestSuite InitFlags
flags)

getTestDirs :: Interactive m => InitFlags -> m [String] -> m [String]
getTestDirs :: InitFlags -> m [FilePath] -> m [FilePath]
getTestDirs InitFlags
flags = Flag [FilePath] -> m [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag [FilePath]
testDirs InitFlags
flags)

-- | Ask for the Haskell base language of the package.
getLanguage :: Interactive m => InitFlags -> m Language -> m Language
getLanguage :: InitFlags -> m Language -> m Language
getLanguage InitFlags
flags = Flag Language -> m Language -> m Language
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Language
language InitFlags
flags)

-- | Ask whether to generate explanatory comments.
getNoComments :: Interactive m => InitFlags -> m Bool -> m Bool
getNoComments :: InitFlags -> m Bool -> m Bool
getNoComments InitFlags
flags = Flag Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag Bool
noComments InitFlags
flags)

-- | Ask for the application root directory.
getAppDirs :: Interactive m => InitFlags -> m [String] -> m [String]
getAppDirs :: InitFlags -> m [FilePath] -> m [FilePath]
getAppDirs InitFlags
flags = Flag [FilePath] -> m [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag [FilePath]
applicationDirs InitFlags
flags)

-- | Ask for the source (library) root directory.
getSrcDirs :: Interactive m => InitFlags -> m [String] -> m [String]
getSrcDirs :: InitFlags -> m [FilePath] -> m [FilePath]
getSrcDirs InitFlags
flags = Flag [FilePath] -> m [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag [FilePath]
sourceDirs InitFlags
flags)

-- | Retrieve the list of exposed modules
getExposedModules :: Interactive m => InitFlags -> m (NonEmpty ModuleName)
getExposedModules :: InitFlags -> m (NonEmpty ModuleName)
getExposedModules = NonEmpty ModuleName -> m (NonEmpty ModuleName)
forall (m :: * -> *) a. Monad m => a -> m a
return
    (NonEmpty ModuleName -> m (NonEmpty ModuleName))
-> (InitFlags -> NonEmpty ModuleName)
-> InitFlags
-> m (NonEmpty ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ModuleName
-> Maybe (NonEmpty ModuleName) -> NonEmpty ModuleName
forall a. a -> Maybe a -> a
fromMaybe (ModuleName
myLibModule ModuleName -> [ModuleName] -> NonEmpty ModuleName
forall a. a -> [a] -> NonEmpty a
NEL.:| [])
    (Maybe (NonEmpty ModuleName) -> NonEmpty ModuleName)
-> (InitFlags -> Maybe (NonEmpty ModuleName))
-> InitFlags
-> NonEmpty ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe (NonEmpty ModuleName)) -> Maybe (NonEmpty ModuleName)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    (Maybe (Maybe (NonEmpty ModuleName))
 -> Maybe (NonEmpty ModuleName))
-> (InitFlags -> Maybe (Maybe (NonEmpty ModuleName)))
-> InitFlags
-> Maybe (NonEmpty ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag (Maybe (NonEmpty ModuleName))
-> Maybe (Maybe (NonEmpty ModuleName))
forall a. Flag a -> Maybe a
flagToMaybe
    (Flag (Maybe (NonEmpty ModuleName))
 -> Maybe (Maybe (NonEmpty ModuleName)))
-> (InitFlags -> Flag (Maybe (NonEmpty ModuleName)))
-> InitFlags
-> Maybe (Maybe (NonEmpty ModuleName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ModuleName] -> Maybe (NonEmpty ModuleName))
-> Flag [ModuleName] -> Flag (Maybe (NonEmpty ModuleName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ModuleName] -> Maybe (NonEmpty ModuleName)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty
    (Flag [ModuleName] -> Flag (Maybe (NonEmpty ModuleName)))
-> (InitFlags -> Flag [ModuleName])
-> InitFlags
-> Flag (Maybe (NonEmpty ModuleName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [ModuleName]
exposedModules

-- | Retrieve the list of other modules
getOtherModules :: Interactive m => InitFlags -> m [ModuleName]
getOtherModules :: InitFlags -> m [ModuleName]
getOtherModules = [ModuleName] -> m [ModuleName]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ModuleName] -> m [ModuleName])
-> (InitFlags -> [ModuleName]) -> InitFlags -> m [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Flag [ModuleName] -> [ModuleName]
forall a. a -> Flag a -> a
fromFlagOrDefault [] (Flag [ModuleName] -> [ModuleName])
-> (InitFlags -> Flag [ModuleName]) -> InitFlags -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [ModuleName]
otherModules

-- | Retrieve the list of build tools
getBuildTools :: Interactive m => InitFlags -> m [Dependency]
getBuildTools :: InitFlags -> m [Dependency]
getBuildTools = m [Dependency]
-> ([FilePath] -> m [Dependency])
-> Flag [FilePath]
-> m [Dependency]
forall b a. b -> (a -> b) -> Flag a -> b
flagElim ([Dependency] -> m [Dependency]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (([Dependency] -> FilePath -> m [Dependency])
-> [Dependency] -> [FilePath] -> m [Dependency]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [Dependency] -> FilePath -> m [Dependency]
forall a (m :: * -> *).
(Parsec a, Interactive m) =>
[a] -> FilePath -> m [a]
go []) (Flag [FilePath] -> m [Dependency])
-> (InitFlags -> Flag [FilePath]) -> InitFlags -> m [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitFlags -> Flag [FilePath]
buildTools
  where
    go :: [a] -> FilePath -> m [a]
go [a]
acc FilePath
dep = case FilePath -> Either FilePath a
forall a. Parsec a => FilePath -> Either FilePath a
eitherParsec FilePath
dep of
      Left FilePath
e -> do
        FilePath -> m ()
forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse dependency: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e
        FilePath -> m ()
forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn FilePath
"Skipping..."

        [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
acc
      Right a
d -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [a]
acc [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
d]

-- | Retrieve the list of dependencies
getDependencies
    :: Interactive m
    => InitFlags
    -> m [Dependency]
    -> m [Dependency]
getDependencies :: InitFlags -> m [Dependency] -> m [Dependency]
getDependencies InitFlags
flags = Flag [Dependency] -> m [Dependency] -> m [Dependency]
forall (m :: * -> *) a. Interactive m => Flag a -> m a -> m a
fromFlagOrPrompt (InitFlags -> Flag [Dependency]
dependencies InitFlags
flags)


-- | Retrieve the list of extensions
getOtherExts :: Interactive m => InitFlags -> m [Extension]
getOtherExts :: InitFlags -> m [Extension]
getOtherExts = [Extension] -> m [Extension]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Extension] -> m [Extension])
-> (InitFlags -> [Extension]) -> InitFlags -> m [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> Flag [Extension] -> [Extension]
forall a. a -> Flag a -> a
fromFlagOrDefault [] (Flag [Extension] -> [Extension])
-> (InitFlags -> Flag [Extension]) -> InitFlags -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  InitFlags -> Flag [Extension]
otherExts

-- | Tell whether to overwrite files on write
--
getOverwrite :: Interactive m => InitFlags -> m Bool
getOverwrite :: InitFlags -> m Bool
getOverwrite = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (InitFlags -> Bool) -> InitFlags -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool)
-> (InitFlags -> Flag Bool) -> InitFlags -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  InitFlags -> Flag Bool
overwrite

-- -------------------------------------------------------------------- --
-- Shared prompts

simpleProjectPrompt :: Interactive m => InitFlags -> m Bool
simpleProjectPrompt :: InitFlags -> m Bool
simpleProjectPrompt InitFlags
flags = InitFlags -> m Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
InitFlags -> m Bool -> m Bool
getSimpleProject InitFlags
flags (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$
    FilePath -> DefaultPrompt Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo
      FilePath
"Should I generate a simple project with sensible defaults"
      (Bool -> DefaultPrompt Bool
forall t. t -> DefaultPrompt t
DefaultPrompt Bool
True)

initializeTestSuitePrompt :: Interactive m => InitFlags -> m Bool
initializeTestSuitePrompt :: InitFlags -> m Bool
initializeTestSuitePrompt 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
$
    FilePath -> DefaultPrompt Bool -> m Bool
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo
      FilePath
"Should I generate a test suite for the library"
      (Bool -> DefaultPrompt Bool
forall t. t -> DefaultPrompt t
DefaultPrompt Bool
True)

packageTypePrompt :: Interactive m => InitFlags -> m PackageType
packageTypePrompt :: InitFlags -> m PackageType
packageTypePrompt 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
$ do
    FilePath
pt <- FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList FilePath
"What does the package build"
      [FilePath]
packageTypes
      (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
"Executable")
      Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
      Bool
False

    PackageType -> m PackageType
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageType -> m PackageType) -> PackageType -> m PackageType
forall a b. (a -> b) -> a -> b
$ PackageType -> Maybe PackageType -> PackageType
forall a. a -> Maybe a -> a
fromMaybe PackageType
Executable (FilePath -> Maybe PackageType
parsePackageType FilePath
pt)
  where
    packageTypes :: [FilePath]
packageTypes =
      [ FilePath
"Library"
      , FilePath
"Executable"
      , FilePath
"Library and Executable"
      , FilePath
"Test suite"
      ]

    parsePackageType :: FilePath -> Maybe PackageType
parsePackageType = \case
      FilePath
"Library" -> PackageType -> Maybe PackageType
forall a. a -> Maybe a
Just PackageType
Library
      FilePath
"Executable" -> PackageType -> Maybe PackageType
forall a. a -> Maybe a
Just PackageType
Executable
      FilePath
"Library and Executable" -> PackageType -> Maybe PackageType
forall a. a -> Maybe a
Just PackageType
LibraryAndExecutable
      FilePath
"Test suite" -> PackageType -> Maybe PackageType
forall a. a -> Maybe a
Just PackageType
TestSuite
      FilePath
_ -> Maybe PackageType
forall a. Maybe a
Nothing

testMainPrompt :: Interactive m => m HsFilePath
testMainPrompt :: m HsFilePath
testMainPrompt = do
    FilePath
fp <- FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
forall (m :: * -> *).
Interactive m =>
FilePath
-> [FilePath]
-> DefaultPrompt FilePath
-> Maybe (FilePath -> FilePath)
-> Bool
-> m FilePath
promptList FilePath
"What is the main module of the test suite?"
      [FilePath
defaultMainIs', FilePath
"Main.lhs"]
      (FilePath -> DefaultPrompt FilePath
forall t. t -> DefaultPrompt t
DefaultPrompt FilePath
defaultMainIs')
      Maybe (FilePath -> FilePath)
forall a. Maybe a
Nothing
      Bool
True

    let hs :: HsFilePath
hs = FilePath -> HsFilePath
toHsFilePath FilePath
fp

    case HsFilePath -> HsFileType
_hsFileType HsFilePath
hs of
      HsFileType
InvalidHsPath -> do
        FilePath -> m ()
forall (m :: * -> *). Interactive m => FilePath -> m ()
putStrLn (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ FilePath
"Main file "
          , HsFilePath -> FilePath
forall a. Show a => a -> FilePath
show HsFilePath
hs
          , FilePath
" is not a valid haskell file. Source files must end in .hs or .lhs."
          ]
        m HsFilePath
forall (m :: * -> *). Interactive m => m HsFilePath
testMainPrompt
      HsFileType
_ -> HsFilePath -> m HsFilePath
forall (m :: * -> *) a. Monad m => a -> m a
return HsFilePath
hs
  where
    defaultMainIs' :: FilePath
defaultMainIs' = HsFilePath -> FilePath
forall a. Show a => a -> FilePath
show HsFilePath
defaultMainIs

dependenciesPrompt
    :: Interactive m
    => InstalledPackageIndex
    -> InitFlags
    -> m [Dependency]
dependenciesPrompt :: InstalledPackageIndex -> InitFlags -> m [Dependency]
dependenciesPrompt InstalledPackageIndex
pkgIx InitFlags
flags = InitFlags -> m [Dependency] -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InitFlags -> m [Dependency] -> m [Dependency]
getDependencies InitFlags
flags (InstalledPackageIndex -> InitFlags -> m [Dependency]
forall (m :: * -> *).
Interactive m =>
InstalledPackageIndex -> InitFlags -> m [Dependency]
getBaseDep InstalledPackageIndex
pkgIx InitFlags
flags)

-- -------------------------------------------------------------------- --
-- utilities

-- | If a flag is defined, return its value or else execute
-- an interactive action.
--
fromFlagOrPrompt
    :: Interactive m
    => Flag a
    -> m a
    -> m a
fromFlagOrPrompt :: Flag a -> m a -> m a
fromFlagOrPrompt Flag a
flag m a
action = m a -> (a -> m a) -> Flag a -> m a
forall b a. b -> (a -> b) -> Flag a -> b
flagElim m a
action a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Flag a
flag