Commit c8250aa8 authored by ryantrinkle's avatar ryantrinkle Committed by Mikhail Glushenkov

Add support for 'main-is' to cabal init.

This includes a new flag, --main-is, as well as a new prompt that appears if the user selects the 'Executable' option or uses --is-executable.
parent 8024d3e3
......@@ -34,9 +34,13 @@ import Data.Time
import Data.Char
( toUpper )
import Data.List
( intercalate, nub, groupBy, (\\) )
( intercalate, nub, groupBy, (\\), sortBy, isInfixOf, isSuffixOf )
import Data.Maybe
( fromMaybe, isJust, catMaybes )
( fromMaybe, isJust, catMaybes, listToMaybe )
import Data.Ord
( comparing )
import Data.Monoid
( mappend )
import Data.Function
( on )
import qualified Data.Map as M
......@@ -266,8 +270,45 @@ getLibOrExec flags = do
[Library, Executable]
Nothing display False)
?>> return (Just Library)
mainFile <- if isLib /= Just Executable then return Nothing else
return (mainIs flags)
?>> guessAndPromptMainFile flags
return $ flags { packageType = maybeToFlag isLib }
return $ flags { packageType = maybeToFlag isLib
, mainIs = 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)
-- | Ask for the base language of the package.
getLanguage :: InitFlags -> IO InitFlags
......@@ -715,7 +756,7 @@ generateCabalFile fileName c =
text "\nexecutable" <+>
text (maybe "" display . flagToMaybe $ packageName c) $$
nest 2 (vcat
[ fieldS "main-is" NoFlag (Just ".hs or .lhs file containing the Main module.") True
[ fieldS "main-is" (maybeToFlag $ mainIs c) (Just ".hs or .lhs file containing the Main module.") True
, generateBuildInfo Executable c
])
......
......@@ -54,6 +54,7 @@ data InitFlags =
, extraSrc :: Maybe [String]
, packageType :: Flag PackageType
, mainIs :: Maybe FilePath
, language :: Flag Language
, exposedModules :: Maybe [ModuleName]
......@@ -98,6 +99,7 @@ instance Monoid InitFlags where
, category = mempty
, extraSrc = mempty
, packageType = mempty
, mainIs = mempty
, language = mempty
, exposedModules = mempty
, otherModules = mempty
......@@ -125,6 +127,7 @@ instance Monoid InitFlags where
, category = combine category
, extraSrc = combine extraSrc
, packageType = combine packageType
, mainIs = getLast $ combine (Last . mainIs)
, language = combine language
, exposedModules = combine exposedModules
, otherModules = combine otherModules
......
......@@ -1400,6 +1400,12 @@ initCommand = CommandUI {
(\v flags -> flags { IT.packageType = v })
(noArg (Flag IT.Executable))
, option [] ["main-is"]
"Specify the main module."
IT.mainIs
(\v flags -> flags { IT.mainIs = v })
(reqArg' "FILE" Just maybeToList)
, option [] ["language"]
"Specify the default language."
IT.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