Commit 5acf7597 authored by byorgey's avatar byorgey
Browse files

Merge pull request #1989 from fujimura/prompt-source-directory

Ask source directory in cabal init
parents f72b01cc 96181995
......@@ -25,7 +25,7 @@ import System.IO
( hSetBuffering, stdout, BufferMode(..) )
import System.Directory
( getCurrentDirectory, doesDirectoryExist, doesFileExist, copyFile
, getDirectoryContents )
, getDirectoryContents, createDirectoryIfMissing )
import System.FilePath
( (</>), (<.>), takeBaseName )
import Data.Time
......@@ -45,7 +45,7 @@ import Data.Traversable
import Control.Applicative
( (<$>) )
import Control.Monad
( when, unless, (>=>), join )
( when, unless, (>=>), join, forM_ )
import Control.Arrow
( (&&&), (***) )
......@@ -107,6 +107,7 @@ initCabal verbosity packageDBs comp conf initFlags = do
writeLicense initFlags'
writeSetupFile initFlags'
createSourceDirectories initFlags'
success <- writeCabalFile initFlags'
when success $ generateWarnings initFlags'
......@@ -313,24 +314,27 @@ getGenComments flags = do
where
promptMsg = "Include documentation on what each field means (y/n)"
-- | Try to guess the source root directory (don't prompt the user).
-- | Ask for the source root directory.
getSrcDir :: InitFlags -> IO InitFlags
getSrcDir flags = do
srcDirs <- return (sourceDirs flags)
?>> Just `fmap` guessSourceDirs flags
srcDirs <- return (sourceDirs flags)
?>> fmap (:[]) `fmap` guessSourceDir flags
?>> fmap (fmap ((:[]) . either id id) . join) (maybePrompt
flags
(promptListOptional' "Source directory" ["src"] id))
return $ flags { sourceDirs = srcDirs }
-- | Try to guess source directories. Could try harder; for the
-- | Try to guess source directory. Could try harder; for the
-- moment just looks to see whether there is a directory called 'src'.
guessSourceDirs :: InitFlags -> IO [String]
guessSourceDirs flags = do
guessSourceDir :: InitFlags -> IO (Maybe String)
guessSourceDir flags = do
dir <-
maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
srcIsDir <- doesDirectoryExist (dir </> "src")
if srcIsDir
then return ["src"]
else return []
return $ if srcIsDir
then Just "src"
else Nothing
-- | Get the list of exposed modules and extra tools needed to build them.
getModulesBuildToolsAndDeps :: PackageIndex -> InitFlags -> IO InitFlags
......@@ -498,10 +502,17 @@ promptListOptional :: (Text t, Eq t)
=> String -- ^ prompt
-> [t] -- ^ choices
-> IO (Maybe (Either String t))
promptListOptional pr choices =
promptListOptional pr choices = promptListOptional' pr choices display
promptListOptional' :: Eq t
=> String -- ^ prompt
-> [t] -- ^ choices
-> (t -> String) -- ^ show an item
-> IO (Maybe (Either String t))
promptListOptional' pr choices displayItem =
fmap rearrange
$ promptList pr (Nothing : map Just choices) (Just Nothing)
(maybe "(none)" display) True
(maybe "(none)" displayItem) True
where
rearrange = either (Just . Left) (fmap Right)
......@@ -630,6 +641,12 @@ writeFileSafe flags fileName content = do
moveExistingFile flags fileName
writeFile fileName content
-- | Create source directories, if they were given.
createSourceDirectories :: InitFlags -> IO ()
createSourceDirectories flags = case sourceDirs flags of
Just dirs -> forM_ dirs (createDirectoryIfMissing True)
Nothing -> return ()
-- | Move an existing file, if there is one, and the overwrite flag is
-- not set.
moveExistingFile :: InitFlags -> FilePath -> IO ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment