{-# LANGUAGE LambdaCase #-}
module Distribution.Client.Init.FlagExtractors
(
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
, 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
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
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)
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
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
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)
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)
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)
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)
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)
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)
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)
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)
getExtraSrcFiles :: Interactive m => InitFlags -> m (Set String)
= 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
getExtraDocFiles :: Interactive m => InitFlags -> m (Maybe (Set String))
= 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
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)
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)
getNoComments :: Interactive m => InitFlags -> m Bool -> m Bool
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)
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)
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)
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
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
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]
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)
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
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
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)
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