Commit 5310aa7e authored by Mikhail Glushenkov's avatar Mikhail Glushenkov

Address review comments.

parent c8250aa8
......@@ -34,13 +34,9 @@ import Data.Time
import Data.Char
( toUpper )
import Data.List
( intercalate, nub, groupBy, (\\), sortBy, isInfixOf, isSuffixOf )
( intercalate, nub, groupBy, (\\) )
import Data.Maybe
( fromMaybe, isJust, catMaybes, listToMaybe )
import Data.Ord
( comparing )
import Data.Monoid
( mappend )
import Data.Function
( on )
import qualified Data.Map as M
......@@ -73,7 +69,8 @@ import Distribution.Client.Init.Types
import Distribution.Client.Init.Licenses
( bsd2, bsd3, gplv2, gplv3, lgpl21, lgpl3, agplv3, apache20, mit, mpl20 )
import Distribution.Client.Init.Heuristics
( guessPackageName, guessAuthorNameMail, SourceFileEntry(..),
( guessPackageName, guessAuthorNameMail, guessMainFileCandidates,
SourceFileEntry(..),
scanForModules, neededBuildPrograms )
import Distribution.License
......@@ -271,44 +268,27 @@ getLibOrExec flags = do
Nothing display False)
?>> return (Just Library)
mainFile <- if isLib /= Just Executable then return Nothing else
return (mainIs flags)
?>> guessAndPromptMainFile flags
getMainFile flags
return $ flags { packageType = maybeToFlag isLib
, mainIs = mainFile
, mainIs = maybeToFlag mainFile
}
-- | Try to guess the main file of the executable, and prompt the user to
-- choose one of them. Top-level modules including the word 'Main' will
-- be candidates, and shorter filenames will be preferred.
guessAndPromptMainFile :: InitFlags -> IO (Maybe FilePath)
guessAndPromptMainFile flags = do
dir <-
maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
files <- getDirectoryContents dir
let existingCandidates = filter isMain files
-- We always want to give the user at least one default choice. If
-- either Main.hs or Main.lhs has already been created, then we don't
-- want to suggest the other; however, if neither has been
-- created, then we suggest both.
newCandidates =
if any (`elem` existingCandidates) ["Main.hs", "Main.lhs"]
then []
else ["Main.hs", "Main.lhs"]
candidates =
sortBy (\x y -> comparing (length . either id id) x y `mappend` compare x y)
(map Left newCandidates ++ map Right existingCandidates)
showCandidate = either (++" (does not yet exist)") id
defaultFile = listToMaybe candidates
maybePrompt flags (either id (either id id) `fmap`
promptList "What is the main module of the executable"
candidates
defaultFile showCandidate True)
?>> return (fmap (either id id) defaultFile)
where
isMain f = isInfixOf "Main" f
&& (isSuffixOf ".hs" f || isSuffixOf ".lhs" f)
-- | Try to guess the main file of the executable, and prompt the user to choose
-- one of them. Top-level modules including the word 'Main' in the file name
-- will be candidates, and shorter filenames will be preferred.
getMainFile :: InitFlags -> IO (Maybe FilePath)
getMainFile flags =
return (flagToMaybe $ mainIs flags)
?>> do
candidates <- guessMainFileCandidates flags
let showCandidate = either (++" (does not yet exist)") id
defaultFile = listToMaybe candidates
maybePrompt flags (either id (either id id) `fmap`
promptList "What is the main module of the executable"
candidates
defaultFile showCandidate True)
?>> return (fmap (either id id) defaultFile)
-- | Ask for the base language of the package.
getLanguage :: InitFlags -> IO InitFlags
......@@ -756,7 +736,7 @@ generateCabalFile fileName c =
text "\nexecutable" <+>
text (maybe "" display . flagToMaybe $ packageName c) $$
nest 2 (vcat
[ fieldS "main-is" (maybeToFlag $ mainIs c) (Just ".hs or .lhs file containing the Main module.") True
[ fieldS "main-is" (mainIs c) (Just ".hs or .lhs file containing the Main module.") True
, generateBuildInfo Executable c
])
......
......@@ -15,11 +15,12 @@ module Distribution.Client.Init.Heuristics (
guessPackageName,
scanForModules, SourceFileEntry(..),
neededBuildPrograms,
guessMainFileCandidates,
guessAuthorNameMail,
knownCategories,
) where
import Distribution.Text (simpleParse)
import Distribution.Simple.Setup (Flag(..))
import Distribution.Simple.Setup (Flag(..), flagToMaybe)
import Distribution.ModuleName
( ModuleName, toFilePath )
import Distribution.Client.PackageIndex
......@@ -39,19 +40,49 @@ import Control.Arrow ( first )
import Control.Monad ( liftM )
import Data.Char ( isAlphaNum, isNumber, isUpper, isLower, isSpace )
import Data.Either ( partitionEithers )
import Data.List ( isPrefixOf )
import Data.Maybe ( mapMaybe, catMaybes, maybeToList )
import Data.Monoid ( mempty, mconcat )
import Data.List ( isInfixOf, isPrefixOf, isSuffixOf, sortBy )
import Data.Maybe ( mapMaybe, catMaybes, maybeToList, listToMaybe )
import Data.Monoid ( mempty, mappend, mconcat, )
import Data.Ord ( comparing )
import qualified Data.Set as Set ( fromList, toList )
import System.Directory ( getDirectoryContents,
import System.Directory ( getCurrentDirectory, getDirectoryContents,
doesDirectoryExist, doesFileExist, getHomeDirectory, )
import Distribution.Compat.Environment ( getEnvironment )
import System.FilePath ( takeExtension, takeBaseName, dropExtension,
(</>), (<.>), splitDirectories, makeRelative )
import Distribution.Client.Init.Types ( InitFlags(..) )
import Distribution.Client.Compat.Process ( readProcessWithExitCode )
import System.Exit ( ExitCode(..) )
-- | Return a list of candidate main files for this executable: top-level
-- modules including the word 'Main' in the file name. The list is sorted in
-- order of preference, shorter file names are preferred. 'Right's are existing
-- candidates and 'Left's are those that do not yet exist.
guessMainFileCandidates :: InitFlags -> IO [Either FilePath FilePath]
guessMainFileCandidates flags = do
dir <-
maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
files <- getDirectoryContents dir
let existingCandidates = filter isMain files
-- We always want to give the user at least one default choice. If either
-- Main.hs or Main.lhs has already been created, then we don't want to
-- suggest the other; however, if neither has been created, then we
-- suggest both.
newCandidates =
if any (`elem` existingCandidates) ["Main.hs", "Main.lhs"]
then []
else ["Main.hs", "Main.lhs"]
candidates =
sortBy (\x y -> comparing (length . either id id) x y
`mappend` compare x y)
(map Left newCandidates ++ map Right existingCandidates)
return candidates
where
isMain f = (isInfixOf "Main" f || isInfixOf "main" f)
&& (isSuffixOf ".hs" f || isSuffixOf ".lhs" f)
-- | Guess the package name based on the given root directory.
guessPackageName :: FilePath -> IO P.PackageName
guessPackageName = liftM (P.PackageName . repair . last . splitDirectories)
......
......@@ -54,7 +54,7 @@ data InitFlags =
, extraSrc :: Maybe [String]
, packageType :: Flag PackageType
, mainIs :: Maybe FilePath
, mainIs :: Flag FilePath
, language :: Flag Language
, exposedModules :: Maybe [ModuleName]
......@@ -127,7 +127,7 @@ instance Monoid InitFlags where
, category = combine category
, extraSrc = combine extraSrc
, packageType = combine packageType
, mainIs = getLast $ combine (Last . mainIs)
, mainIs = combine mainIs
, language = combine language
, exposedModules = combine exposedModules
, otherModules = combine otherModules
......
......@@ -1404,7 +1404,7 @@ initCommand = CommandUI {
"Specify the main module."
IT.mainIs
(\v flags -> flags { IT.mainIs = v })
(reqArg' "FILE" Just maybeToList)
(reqArgFlag "FILE")
, option [] ["language"]
"Specify the default language."
......
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