Commit 39c03860 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add lots of new package checks

Check that Setup.(l)hs exists.
Check for ./configure file if build-type: Configure
Check for duplicate modules in library and executables.
Check ghc-options and cc-options for -I -l -L flags that should be elsewhere
Check for lots of insane ghc-options that people have used in real packages.
Check for old ghc -f flags that correspond to extensions
parent f1a833b1
......@@ -47,6 +47,7 @@ module Distribution.PackageDescription.Check (
) where
import Data.Maybe (isNothing, catMaybes)
import Data.List (intersperse, sort, group, isPrefixOf)
import System.Directory (doesFileExist)
import Distribution.PackageDescription
......@@ -56,6 +57,7 @@ import Distribution.Simple.Utils (cabalVersion)
import Distribution.Version (Version(..), withinRange, showVersionRange)
import Distribution.Package (PackageIdentifier(..))
import Language.Haskell.Extension (Extension(..))
import System.FilePath (takeExtension, (</>))
-- | Results of some kind of failed package check.
......@@ -100,8 +102,6 @@ check True pc = Just pc
-- * Standard checks
-- ------------------------------------------------------------
-- TODO: give hints about old extentions. see Simple.GHC, reverse mapping
-- TODO: and allmost ghc -X flags should be extensions
-- TODO: Once we implement striping (ticket #88) we should also reject
-- ghc-options: -optl-Wl,-s.
......@@ -117,6 +117,7 @@ checkPackage pkg =
++ checkFields pkg
++ checkLicense pkg
++ checkGhcOptions pkg
++ checkCCOptions pkg
-- ------------------------------------------------------------
......@@ -160,8 +161,17 @@ checkLibrary lib =
check (buildable (libBuildInfo lib) && null (exposedModules lib)) $
PackageBuildImpossible
"A library was specified, but no 'exposed-modules' list has been given."
, check (not (null moduleDuplicates)) $
PackageBuildWarning $
"Dulicate modules in library: " ++ commaSep moduleDuplicates
]
where moduleDuplicates = [ module_
| let modules = exposedModules lib
++ otherModules (libBuildInfo lib)
, (module_:_:_) <- group (sort modules) ]
checkExecutable :: Executable -> [PackageCheck]
checkExecutable exe =
catMaybes [
......@@ -175,8 +185,16 @@ checkExecutable exe =
PackageBuildImpossible $
"The 'Main-Is' field must specify a '.hs' or '.lhs' file\n"
++ " (even if it is generated by a preprocessor)."
, check (not (null moduleDuplicates)) $
PackageBuildWarning $
"Dulicate modules in executable '" ++ exeName exe ++ "': "
++ commaSep moduleDuplicates
]
where moduleDuplicates = [ module_
| let modules = otherModules (buildInfo exe)
, (module_:_:_) <- group (sort modules) ]
-- ------------------------------------------------------------
-- * Additional pure checks
......@@ -233,24 +251,80 @@ checkGhcOptions pkg =
"'ghc-options: -Werror' makes the package easy to "
++ "break with future GHC versions."
, checkFlag "-fasm" $
, checkFlags ["-fasm"] $
PackageDistInexcusable $
"'ghc-options: -fasm' is unnecessary and breaks on all "
++ "arches except for x86, x86-64 and ppc."
, checkFlag "-O" $
, checkFlags ["-fvia-C"] $
PackageDistSuspicious $
"'ghc-options: -fvia-C' is usually unnecessary."
, checkFlags ["-fhpc"] $
PackageDistInexcusable $
"'ghc-options: -fhpc' is not appropriate for a distributed package."
, check (any ("-d" `isPrefixOf`) all_ghc_options) $
PackageDistInexcusable $
"'ghc-options: -d*' debug flags are not appropriate for a distributed package."
, checkFlags ["-prof"] $
PackageDistInexcusable $
"'ghc-options: -prof' is not needed. Use the --enable-library-profiling configure flag."
, checkFlags ["-o"] $
PackageDistInexcusable $
"'ghc-options: -o' is not allowed. The output files are named automatically."
, checkFlags ["-hide-package"] $
PackageDistInexcusable $
"'ghc-options: -hide-package' is never needed. Cabal hides all packages\n"
, checkFlags ["-main-is"] $
PackageDistSuspicious $
"'ghc-options: -main-is' is not portable."
, checkFlags ["-O0", "-Onot"] $
PackageDistInexcusable $
"'ghc-options: -O0' is not needed. Use the --disable-optimization configure flag."
, checkFlags [ "-O", "-O1"] $
PackageDistInexcusable $
"'ghc-options: -O' is not needed. Cabal automatically adds the '-O' flag.\n"
++ " Setting it yourself interferes with the --disable-optimization flag."
, checkFlag "-O2" $
, checkFlags ["-O2"] $
PackageDistSuspicious $
"'ghc-options: -O2' is rarely needed. Check that it is giving a real benefit\n"
++ " and not just imposing longer compile times on your users."
, check (any (`elem` all_ghc_options) ["-ffi", "-fffi"]) $
, checkFlags ["-split-objs"] $
PackageDistInexcusable $
"Instead of using -ffi or -fffi, use 'extensions: ForeignFunctionInterface'"
"'ghc-options: -split-objs' is not needed. Use the --enable-split-objs configure flag."
, checkFlags ["-fglasgow-exts"] $
PackageDistSuspicious $
"Instead of 'ghc-options: -fglasgow-exts' it is preferable to use the 'extensions' field."
, checkAlternatives "ghc-options" "extensions"
[ (flag, show extension) | flag <- all_ghc_options
, Just extension <- [ghcExtension flag] ]
, checkAlternatives "ghc-options" "extensions"
[ (flag, extension) | flag@('-':'X':extension) <- all_ghc_options ]
, checkAlternatives "ghc-options" "cpp-options" $
[ (flag, flag) | flag@('-':'D':_) <- all_ghc_options ]
++ [ (flag, flag) | flag@('-':'U':_) <- all_ghc_options ]
, checkAlternatives "ghc-options" "include-dirs"
[ (flag, dir) | flag@('-':'I':dir) <- all_ghc_options ]
, checkAlternatives "ghc-options" "extra-libraries"
[ (flag, lib) | flag@('-':'l':lib) <- all_ghc_options ]
, checkAlternatives "ghc-options" "extra-lib-dirs"
[ (flag, dir) | flag@('-':'L':dir) <- all_ghc_options ]
]
where
......@@ -263,8 +337,63 @@ checkGhcOptions pkg =
, (GHC, strs) <- options bi ]
all_ghc_options = concat ghc_options
checkFlag :: String -> PackageCheck -> Maybe PackageCheck
checkFlag flag = check (flag `elem` all_ghc_options)
checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags flags = check (any (`elem` flags) all_ghc_options)
ghcExtension ('-':'f':name) = case name of
"allow-overlapping-instances" -> Just OverlappingInstances
"th" -> Just TemplateHaskell
"ffi" -> Just ForeignFunctionInterface
"fi" -> Just ForeignFunctionInterface
"no-monomorphism-restriction" -> Just NoMonomorphismRestriction
"no-mono-pat-binds" -> Just NoMonoPatBinds
"allow-undecidable-instances" -> Just UndecidableInstances
"allow-incoherent-instances" -> Just IncoherentInstances
"arrows" -> Just Arrows
"generics" -> Just Generics
"no-implicit-prelude" -> Just NoImplicitPrelude
"implicit-params" -> Just ImplicitParams
"bang-patterns" -> Just BangPatterns
"scoped-type-variables" -> Just ScopedTypeVariables
"extended-default-rules" -> Just ExtendedDefaultRules
_ -> Nothing
ghcExtension ('-':'c':"pp") = Just CPP
ghcExtension _ = Nothing
checkCCOptions :: PackageDescription -> [PackageCheck]
checkCCOptions pkg =
catMaybes [
checkAlternatives "cc-options" "include-dirs"
[ (flag, dir) | flag@('-':'I':dir) <- all_ccOptions ]
, checkAlternatives "cc-options" "extra-libraries"
[ (flag, lib) | flag@('-':'l':lib) <- all_ccOptions ]
, checkAlternatives "cc-options" "extra-lib-dirs"
[ (flag, dir) | flag@('-':'L':dir) <- all_ccOptions ]
, checkAlternatives "ld-options" "extra-libraries"
[ (flag, lib) | flag@('-':'l':lib) <- all_ldOptions ]
, checkAlternatives "ld-options" "extra-lib-dirs"
[ (flag, dir) | flag@('-':'L':dir) <- all_ldOptions ]
]
where all_ccOptions = [ opts | bi <- allBuildInfo pkg
, opts <- ccOptions bi ]
all_ldOptions = [ opts | bi <- allBuildInfo pkg
, opts <- ldOptions bi ]
checkAlternatives :: String -> String -> [(String, String)] -> Maybe PackageCheck
checkAlternatives badField goodField flags =
check (not (null badFlags)) $
PackageBuildWarning $
"Instead of " ++ quote (badField ++ ": " ++ unwords badFlags)
++ " use " ++ quote (goodField ++ ": " ++ unwords goodFlags)
where (badFlags, goodFlags) = unzip flags
-- ------------------------------------------------------------
-- * Checks in IO
......@@ -275,9 +404,11 @@ checkGhcOptions pkg =
--
checkPackageFiles :: PackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFiles pkg root = do
licenseError <- checkLicenseExists pkg root
licenseError <- checkLicenseExists pkg root
setupError <- checkSetupExists pkg root
configureError <- checkConfigureExists pkg root
return (catMaybes [licenseError])
return (catMaybes [licenseError, setupError, configureError])
checkLicenseExists :: PackageDescription -> FilePath -> IO (Maybe PackageCheck)
checkLicenseExists pkg root
......@@ -291,4 +422,29 @@ checkLicenseExists pkg root
where
file = licenseFile pkg
quote s = ['"'] ++ s ++ ['"']
checkSetupExists :: PackageDescription -> FilePath -> IO (Maybe PackageCheck)
checkSetupExists _ root = do
hsexists <- doesFileExist (root </> "Setup.hs")
lhsexists <- doesFileExist (root </> "Setup.lhs")
return $ check (not hsexists && not lhsexists) $
PackageDistInexcusable $
"The package is missing a Setup.hs or Setup.lhs script."
checkConfigureExists :: PackageDescription -> FilePath -> IO (Maybe PackageCheck)
checkConfigureExists PackageDescription { buildType = Just Configure } root = do
exists <- doesFileExist (root </> "configure")
return $ check (not exists) $
PackageBuildWarning $
"The 'build-type' is 'Configure' but there is no 'configure' script."
checkConfigureExists _ _ = return Nothing
-- ------------------------------------------------------------
-- * Utils
-- ------------------------------------------------------------
quote :: String -> String
quote s = "'" ++ s ++ "'"
commaSep :: [String] -> String
commaSep = concat . intersperse ","
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