Commit 3a0a4e12 authored by ijones's avatar ijones
Browse files

cleaning up warnings

parent 5e6c7411
......@@ -140,6 +140,7 @@ emptyInstalledPackageInfo
haddockHTMLs = []
}
noVersion :: Version
noVersion = Version{ versionBranch=[], versionTags=[] }
-- -----------------------------------------------------------------------------
......@@ -147,10 +148,10 @@ noVersion = Version{ versionBranch=[], versionTags=[] }
parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo
parseInstalledPackageInfo inp = do
lines <- singleStanza inp
stLines <- singleStanza inp
-- not interested in stanzas, so just allow blank lines in
-- the package info.
foldM (parseBasicStanza fields) emptyInstalledPackageInfo lines
foldM (parseBasicStanza fields) emptyInstalledPackageInfo stLines
parseBasicStanza ((StanzaField name _ _ set):fields) pkg (lineNo, f, val)
| name == f = set lineNo val pkg
......@@ -165,19 +166,20 @@ showInstalledPackageInfo :: InstalledPackageInfo -> String
showInstalledPackageInfo pkg = render (ppFields fields)
where
ppFields [] = empty
ppFields ((StanzaField _ get _ _):flds) = get pkg $$ ppFields flds
ppFields ((StanzaField _ get' _ _):flds) = get' pkg $$ ppFields flds
showInstalledPackageInfoField
:: String
-> Maybe (InstalledPackageInfo -> String)
showInstalledPackageInfoField field
= case [ get | (StanzaField f get _ _) <- fields, f == field ] of
= case [ get' | (StanzaField f get' _ _) <- fields, f == field ] of
[] -> Nothing
(get:_) -> Just (render . get)
(get':_) -> Just (render . get')
-- -----------------------------------------------------------------------------
-- Description of the fields, for parsing/printing
fields :: [StanzaField InstalledPackageInfo]
fields = basicStanzaFields ++ installedStanzaFields
basicStanzaFields :: [StanzaField InstalledPackageInfo]
......
......@@ -98,7 +98,7 @@ import Distribution.Simple.Utils(currentDir, die)
import Distribution.Compat.ReadP as ReadP hiding (get)
#ifdef DEBUG
import HUnit (Test(..), assertBool, Assertion, runTestTT)
import HUnit (Test(..), assertBool, Assertion, runTestTT, Counts)
import Distribution.ParseUtils (runP)
#endif
......@@ -601,6 +601,7 @@ hasMods pkg_descr
-- * Testing
-- ------------------------------------------------------------
#ifdef DEBUG
testPkgDesc :: String
testPkgDesc = unlines [
"-- Required",
"Name: Cabal",
......@@ -643,6 +644,7 @@ testPkgDesc = unlines [
"Extensions: OverlappingInstances"
]
testPkgDescAnswer :: PackageDescription
testPkgDescAnswer =
PackageDescription {package = PackageIdentifier {pkgName = "Cabal",
pkgVersion = Version {versionBranch = [0,1,1,1,1],
......@@ -739,5 +741,6 @@ assertParseOk mes expected actual
ParseOk v -> v == expected
_ -> False)
test :: IO Counts
test = runTestTT (TestList hunitTests)
#endif
......@@ -165,6 +165,7 @@ splitStanzas = mapM mkStanza . map merge . groupStanzas . filter validLine . zip
groupStanzas xs = let (ys,zs) = break allSpaces xs
in ys : groupStanzas (dropWhile allSpaces zs)
allSpaces :: (a, String) -> Bool
allSpaces (_,xs) = all isSpace xs
-- |Split a file into "Field: value" groups, but blank lines have no
......@@ -177,6 +178,7 @@ singleStanza = mkStanza . merge . filter validLine . zip [1..] . lines
[] -> False -- blank line
_ -> True
merge :: [(a, [Char])] -> [(a, [Char])]
merge ((n,x):(_,c:s):ys)
| c == ' ' || c == '\t' = case dropWhile isSpace s of
('.':s') -> merge ((n,x++"\n"++s'):ys)
......@@ -195,15 +197,15 @@ mkStanza ((n,xs):ys) =
return ((n, fld, dropWhile isSpace val):ss)
(_, _) -> fail $ "Line "++show n++": Invalid syntax (no colon after field name)"
where
checkDuplField fld [] = return ()
checkDuplField fld (x'@(n',fld',val'):xs')
checkDuplField _ [] = return ()
checkDuplField fld ((n',fld',_):xs')
| fld' == fld = fail ("The field "++fld++" is defined on both line "++show n++" and "++show n')
| otherwise = checkDuplField fld xs'
-- |parse a module name
parseModuleNameQ :: ReadP r String
parseModuleNameQ = parseQuoted mod <++ mod
where mod = do
parseModuleNameQ = parseQuoted modu <++ modu
where modu = do
c <- satisfy isUpper
cs <- munch (\x -> isAlphaNum x || x `elem` "_'.")
return (c:cs)
......
......@@ -220,7 +220,7 @@ parseGlobalArgs args =
(flags, _, _, []) | hasHelpFlag flags -> do
printGlobalHelp
exitWith ExitSuccess
(flags, cname:cargs, _, []) -> do
(_, cname:cargs, _, []) -> do
case lookupCommand cname commandList of
Just cmd -> return (cmdAction cmd,cargs)
Nothing -> do putStrLn $ "Unrecognised command: " ++ cname ++ " (try --help)"
......
......@@ -233,8 +233,8 @@ buildHugs pkg_descr lbi verbose = do
copyModule useCpp bi f (destDir `joinFileName` trimSrcDir f)
mapM_ copy_or_cpp (concat fileLists)
-- Pass 2: compile foreign stubs in build directory
stubsFileLists <- sequence [moduleToFilePath [destDir] mod suffixes |
mod <- mods]
stubsFileLists <- sequence [moduleToFilePath [destDir] modu suffixes |
modu <- mods]
mapM_ (compileFFI bi) (concat stubsFileLists)
suffixes = ["hs", "lhs"]
......
......@@ -288,13 +288,13 @@ compilerPkgToolName NHC = "hmake" -- FIX: nhc98-pkg Does not yet exist
compilerPkgToolName Hugs = "hugs" -- FIX (HUGS): hugs-pkg does not yet exist
configCompilerVersion :: CompilerFlavor -> FilePath -> IO Version
configCompilerVersion GHC compiler =
configCompilerVersion GHC compilerPath =
withTempFile "." "" $ \tmp -> do
maybeExit $ system (compiler ++ " --version >" ++ tmp)
maybeExit $ system (compilerPath ++ " --version >" ++ tmp)
str <- readFile tmp
case pCheck (readP_to_S parseVersion (dropWhile (not.isDigit) str)) of
[v] -> return v
_ -> die ("cannot determine version of " ++ compiler ++ ":\n "
_ -> die ("cannot determine version of " ++ compilerPath ++ ":\n "
++ str)
configCompilerVersion _ _ = return Version{ versionBranch=[],versionTags=[] }
......@@ -319,11 +319,11 @@ message s = putStrLn $ "configure: " ++ s
-- Tests
#ifdef DEBUG
packageID = PackageIdentifier "Foo" (Version [1] [])
hunitTests :: [Test]
hunitTests = []
{- Too specific:
packageID = PackageIdentifier "Foo" (Version [1] [])
= [TestCase $
do let simonMarGHCLoc = "/usr/bin/ghc"
simonMarGHC <- configure emptyPackageDescription {package=packageID}
......
......@@ -55,6 +55,7 @@ maybeCreateLocalPackageConfig
-- |Helper function for canReadPackageConfig and canWritePackageConfig
checkPermission :: (Permissions -> Bool) -> IO Bool
checkPermission perm
= do f <- localPackageConfig
exists <- doesFileExist f
......
......@@ -62,14 +62,14 @@ module Distribution.Simple.Install (
import Distribution.PackageDescription (
PackageDescription(..), BuildInfo(..), Executable(..), Library (..),
setupMessage, hasLibs, withLib, libModules, withExe, exeModules,
setupMessage, hasLibs, withLib, libModules, withExe,
hcOptions)
import Distribution.Package (showPackageId, PackageIdentifier(pkgName))
import Distribution.Simple.LocalBuildInfo(LocalBuildInfo(..))
import Distribution.Simple.Utils(smartCopySources, copyFileVerbose, mkLibName, die)
import Distribution.Setup (CompilerFlavor(..), Compiler(..))
import Control.Monad(when, unless)
import Control.Monad(when)
import Data.Maybe(fromMaybe)
import Distribution.Compat.Directory(createDirectoryIfMissing,removeDirectoryRecursive)
import Distribution.Compat.FilePath(joinFileName, dllExtension,
......@@ -143,7 +143,6 @@ installHugs verbose libPref binPref targetLibPref buildPref pkg_descr = do
smartCopySources verbose buildPref pkgDir (libModules pkg_descr) hugsInstallSuffixes
let progBuildDir = buildPref `joinFileName` "programs"
let progInstallDir = libPref `joinFileName` "programs"
let progTargetDir = targetLibPref `joinFileName` "programs"
withExe pkg_descr $ \ exe -> do
let buildDir = progBuildDir `joinFileName` exeName exe
let installDir = progInstallDir `joinFileName` exeName exe
......
......@@ -170,8 +170,8 @@ moduleToFilePath pref s possibleSuffixes
matchList <- mapM (\x -> do y <- doesFileExist x; return (x, y)) possiblePaths
return [x | (x, True) <- matchList]
where searchModuleToPossiblePaths :: String -> [String] -> FilePath -> [FilePath]
searchModuleToPossiblePaths s suffs searchP
= moduleToPossiblePaths searchP s suffs
searchModuleToPossiblePaths s' suffs searchP
= moduleToPossiblePaths searchP s' suffs
-- |Get the possible file paths based on this module name.
moduleToPossiblePaths :: FilePath -- ^search prefix
......@@ -247,13 +247,13 @@ mkLibName pref lib = pref `joinFileName` ("libHS" ++ lib ++ ".a")
withTempFile :: FilePath -> String -> (FilePath -> IO a) -> IO a
withTempFile tmp_dir extn action
= do x <- getProcessID
findTempName tmp_dir x
findTempName x
where
findTempName tmp_dir x
findTempName x
= do let filename = ("tmp" ++ show x) `joinFileExt` extn
path = tmp_dir `joinFileName` filename
b <- doesFileExist path
if b then findTempName tmp_dir (x+1)
if b then findTempName (x+1)
else action path `finally` try (removeFile path)
#ifdef mingw32_TARGET_OS
......@@ -344,16 +344,23 @@ stripComments keepPragmas = stripCommentsLevel 0
-- * Finding the description file
-- ------------------------------------------------------------
oldDescFile :: String
oldDescFile = "Setup.description"
cabalExt :: String
cabalExt = "cabal"
buildInfoExt :: String
buildInfoExt = "buildinfo"
matchesDescFile :: FilePath -> Bool
matchesDescFile p = (snd $ splitFileExt p) == cabalExt
|| p == oldDescFile
noDesc :: IO a
noDesc = die $ "No description file found, please create a cabal-formatted description file with the name <pkgname>." ++ cabalExt
multiDesc :: [String] -> IO a
multiDesc l = die $ "Multiple description files found. Please use only one of : "
++ show (filter (/= oldDescFile) l)
......
CABALVERSION=0.4
GHCFLAGS= --make -W -fno-warn-unused-matches -cpp
GHCFLAGS= --make -Wall -fno-warn-unused-matches -cpp
# later: -Wall
PREF=/usr/local
USER_FLAG =
......
Supports Markdown
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