Commit 0b3d4691 authored by ijones's avatar ijones
Browse files

fixes to parser from krasimir, fixes to sdist from ross

Krasimir says:
  Small fixes in the parser/printer. When there is a package description with
  executables only then the old implementation of pretty printer was written
  to print empty "exposed-modules" field while there isn`t any library. After
  that the parser will generate PackageDescription with (Just emptyLibrary)
  instead of Nothing. Now exposed-modules field is printed only if
  library /= Nothing

Ross says:
  In smartCopySources, don't try to strip the prefix if it was ".",
  because joinFileName "." x == x
  (fixes bug reported by Iavor Diatchki)

  Improve sdist a bit: copy files named in main-is, license-file and c-sources.
  Also supply a default Setup.hs if none is present.
  
  This will get it working for only the simplest of packages.  It omits
  header files, configure stuff and files named in the buildinfo file.
  To do it properly, we'd need a field in the package description listing
  extra files to copy into a source distribution.
parent 22527dd2
......@@ -369,12 +369,6 @@ basicStanzaFields =
, listField "tested-with"
showTestedWith parseTestedWithQ
testedWith (\val pkg -> pkg{testedWith=val})
, listField "exposed-modules"
text parseModuleNameQ
(\p -> maybe [] exposedModules (library p))
(\xs pkg -> let lib = fromMaybe emptyLibrary (library pkg) in
pkg{library = Just lib{exposedModules=xs}})
]
executableStanzaFields :: [StanzaField Executable]
......@@ -464,10 +458,22 @@ parseDescription inp = do (st:sts) <- splitStanzas inp
parseBasicStanza ((StanzaField name _ set):fields) pkg (lineNo, f, val)
| name == f = set lineNo val pkg
| otherwise = parseBasicStanza fields pkg (lineNo, f, val)
parseBasicStanza [] pkg (lineNo, f, val) = do
let lib = fromMaybe emptyLibrary (library pkg)
bi <- parseBInfoField binfoFields (libBuildInfo lib) (lineNo, f, val)
return pkg{library=Just lib{libBuildInfo=bi}}
{-
, listField "exposed-modules"
text parseModuleNameQ
(\p -> maybe [] exposedModules (library p))
(\xs pkg -> let lib = fromMaybe emptyLibrary (library pkg) in
pkg{library = Just lib{exposedModules=xs}})
-}
parseBasicStanza [] pkg (lineNo, f, val)
| "exposed-modules" == f = do
mods <- runP lineNo f (parseOptCommaList parseModuleNameQ) val
return pkg{library=Just lib{exposedModules=mods}}
| otherwise = do
bi <- parseBInfoField binfoFields (libBuildInfo lib) (lineNo, f, val)
return pkg{library=Just lib{libBuildInfo=bi}}
where
lib = fromMaybe emptyLibrary (library pkg)
parseExecutableStanza st@((_, "executable",eName):_) =
case lookupField "main-is" st of
......@@ -534,7 +540,9 @@ showPackageDescription pkg = render $
ppFields pkg basicStanzaFields $$
(case library pkg of
Nothing -> empty
Just lib -> ppFields (libBuildInfo lib) binfoFields) $$
Just lib ->
text "exposed-modules" <> colon <+> fsep (punctuate comma (map text (exposedModules lib))) $$
ppFields (libBuildInfo lib) binfoFields) $$
vcat (map ppExecutable (executables pkg))
where
ppExecutable exe =
......
......@@ -50,7 +50,7 @@ module Distribution.ParseUtils (
parseFilePathQ, parseTokenQ,
parseModuleNameQ, parseDependency, parseOptVersion,
parsePackageNameQ, parseVersionRangeQ,
parseTestedWithQ, parseLicenseQ, parseExtensionQ, parseCommaList,
parseTestedWithQ, parseLicenseQ, parseExtensionQ, parseCommaList, parseOptCommaList,
showFilePath, showToken, showTestedWith, showDependency, showFreeText,
simpleField, listField, commaListField, optsField,
parseReadS, parseQuoted,
......@@ -272,7 +272,8 @@ showFilePath = showToken
showToken :: String -> Doc
showToken str
| not (any dodgy str) = text str
| not (any dodgy str) &&
not (null str) = text str
| otherwise = text (show str)
where dodgy c = isSpace c || c == ','
......
......@@ -84,7 +84,6 @@ import Distribution.Simple.Utils (die, currentDir, rawSystemVerbose,
defaultPackageDesc, defaultHookedPackageDesc,
moduleToFilePath)
-- Base
import System.Cmd (rawSystem)
import System.Environment(getArgs)
import System.Exit(ExitCode(..))
import System.Directory(removeFile, doesFileExist)
......@@ -406,7 +405,8 @@ emptyUserHooks
--
-- * on non-Windows systems, 'postConf' runs @.\/configure@, if present.
--
-- * all pre-hooks except 'preConf' read additional build information from
-- * the pre-hooks 'preBuild', 'preClean', 'preCopy', 'preInst',
-- 'preReg' and 'preUnreg' read additional build information from
-- /package/@.buildinfo@, if present.
--
-- Thus @configure@ can use local system information to generate
......@@ -423,7 +423,6 @@ defaultUserHooks
preClean = readHook id,
preCopy = readHook snd,
preInst = readHook snd,
preSDist = readHook id,
preReg = readHook thd3,
preUnreg = readHook thd3
}
......
......@@ -53,13 +53,15 @@ import Distribution.PackageDescription
(PackageDescription(..), BuildInfo(..), Executable(..), Library(..),
setupMessage, libModules)
import Distribution.Package (showPackageId)
import Distribution.Simple.Utils(smartCopySources, die, findPackageDesc)
import Distribution.Simple.Utils
(smartCopySources, die, findPackageDesc, copyFileVerbose)
import Distribution.PreProcess (PPSuffixHandler, ppSuffixes, removePreprocessed)
import Control.Monad(when)
import System.Cmd (system)
import Distribution.Compat.Directory (doesDirectoryExist, getCurrentDirectory, copyFile)
import Distribution.Compat.FilePath (joinFileName)
import Distribution.Compat.Directory (doesFileExist, doesDirectoryExist,
getCurrentDirectory, createDirectoryIfMissing)
import Distribution.Compat.FilePath (joinFileName, splitFileName)
#ifdef DEBUG
import HUnit (Test)
......@@ -82,14 +84,26 @@ sdist tmpDir targetPref verbose pps pkg_descr = do
maybe (return ()) (\l -> prepareDir verbose targetDir pps (libModules pkg_descr) (libBuildInfo l))
(library pkg_descr)
-- move the executables into place
sequence_ [prepareDir verbose targetDir pps [] exeBi | (Executable _ _ exeBi) <- executables pkg_descr]
flip mapM_ (executables pkg_descr) $ \ (Executable _ mainPath exeBi) -> do
prepareDir verbose targetDir pps [] exeBi
copyFileTo verbose targetDir (hsSourceDir exeBi `joinFileName` mainPath)
when (not (null (licenseFile pkg_descr))) $
copyFileTo verbose targetDir (licenseFile pkg_descr)
-- setup isn't listed in the description file.
smartCopySources verbose "" targetDir ["Setup"] ["lhs", "hs"]
hsExists <- doesFileExist "Setup.hs"
lhsExists <- doesFileExist "Setup.lhs"
if hsExists then copyFileTo verbose targetDir "Setup.hs"
else if lhsExists then copyFileTo verbose targetDir "Setup.lhs"
else writeFile (targetDir `joinFileName` "Setup.hs") $ unlines [
"import Distribution.Simple",
"main = defaultMainWithHooks defaultUserHooks"]
-- the description file itself
descFile <- getCurrentDirectory >>= findPackageDesc
copyFile descFile (joinFileName targetDir descFile)
system $ "tar --directory=" ++ tmpDir ++ " -zcf " ++
(targetPref `joinFileName` (tarBallName pkg_descr))
++ " " ++ (nameVersion pkg_descr)
copyFileTo verbose targetDir descFile
system $ "(cd " ++ tmpDir
++ ";tar cf - " ++ (nameVersion pkg_descr) ++ ") | gzip -9 >"
++ (targetPref `joinFileName` (tarBallName pkg_descr))
system $ "rm -rf " ++ tmpDir
putStrLn "Source tarball created."
......@@ -100,11 +114,18 @@ prepareDir :: Int -- ^verbose
-> [String] -- ^Exposed modules
-> BuildInfo
-> IO ()
prepareDir verbose inPref pps mods BuildInfo{hsSourceDir=srcDir, otherModules=mods'}
prepareDir verbose inPref pps mods BuildInfo{hsSourceDir=srcDir, otherModules=mods', cSources=cfiles}
= do let pref = inPref `joinFileName` srcDir
let suff = ppSuffixes pps ++ ["hs", "lhs"]
smartCopySources verbose srcDir pref (mods++mods') suff
removePreprocessed pref mods suff
mapM_ (copyFileTo verbose inPref) cfiles
copyFileTo :: Int -> FilePath -> FilePath -> IO ()
copyFileTo verbose dir file = do
let targetFile = dir `joinFileName` file
createDirectoryIfMissing True (fst (splitFileName targetFile))
copyFileVerbose verbose file targetFile
------------------------------------------------------------
......
......@@ -205,7 +205,7 @@ smartCopySources verbose pref targetDir sources searchSuffixes
sourceLocs' <- mapM moduleToFPErr sources
let sourceLocs = concat sourceLocs'
let sourceLocsNoPref -- get rid of the prefix, for target location.
= if null pref then sourceLocs
= if null pref || pref == currentDir then sourceLocs
else map (drop ((length pref) +1)) sourceLocs
mapM (createDirectoryIfMissing True)
$ nub [fst (splitFileName (targetDir `joinFileName` x))
......
......@@ -26,7 +26,7 @@ all: moduleTest
setup::
mkdir -p dist/tmp
$(HC) $(GHCFLAGS) -odir dist/tmp -hidir dist/tmp Setup -o setup
$(HC) $(GHCFLAGS) -package Cabal -odir dist/tmp -hidir dist/tmp Setup -o setup
Setup-nhc:
hmake -nhc98 -package base -prelude Setup
......
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