Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
5310aa7e
Commit
5310aa7e
authored
Apr 12, 2014
by
Mikhail Glushenkov
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Address review comments.
parent
c8250aa8
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
60 additions
and
49 deletions
+60
-49
cabal-install/Distribution/Client/Init.hs
cabal-install/Distribution/Client/Init.hs
+21
-41
cabal-install/Distribution/Client/Init/Heuristics.hs
cabal-install/Distribution/Client/Init/Heuristics.hs
+36
-5
cabal-install/Distribution/Client/Init/Types.hs
cabal-install/Distribution/Client/Init/Types.hs
+2
-2
cabal-install/Distribution/Client/Setup.hs
cabal-install/Distribution/Client/Setup.hs
+1
-1
No files found.
cabal-install/Distribution/Client/Init.hs
View file @
5310aa7e
...
...
@@ -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
"
\n
executable"
<+>
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
])
...
...
cabal-install/Distribution/Client/Init/Heuristics.hs
View file @
5310aa7e
...
...
@@ -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
)
...
...
cabal-install/Distribution/Client/Init/Types.hs
View file @
5310aa7e
...
...
@@ -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
...
...
cabal-install/Distribution/Client/Setup.hs
View file @
5310aa7e
...
...
@@ -1404,7 +1404,7 @@ initCommand = CommandUI {
"Specify the main module."
IT
.
mainIs
(
\
v
flags
->
flags
{
IT
.
mainIs
=
v
})
(
reqArg
'
"FILE"
Just
maybeToList
)
(
reqArg
Flag
"FILE"
)
,
option
[]
[
"language"
]
"Specify the default language."
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment