Merge pull request #3980 from phadej/gen-extra-source-files-hs

Reimpelement gen-extra-source-files in Haskell

.travis.yml

@@ -19,8 +19,9 @@ branches:
 # lines listings versions you don't need/want testing for.
 matrix:
   include:
-   - env: GHCVER=none SCRIPT=meta BUILDER=none
+   - env: GHCVER=8.0.1 SCRIPT=meta BUILDER=none
      os: linux
+     sudo: required
    # These don't have -dyn/-prof whitelisted yet, so we have to
    # do the old-style installation
    - env: GHCVER=7.4.2 SCRIPT=script CABAL_LIB_ONLY=YES

Cabal/Cabal.cabal

@@ -583,9 +583,11 @@ test-suite package-tests
     PackageTests.AutogenModules.Package.Check
     PackageTests.AutogenModules.SrcDist.Check
     PackageTests.BenchmarkStanza.Check
+    PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check
+    PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check
     PackageTests.CaretOperator.Check
-    PackageTests.TestStanza.Check
     PackageTests.DeterministicAr.Check
+    PackageTests.TestStanza.Check
     PackageTests.TestSuiteTests.ExeV10.Check
     PackageTests.PackageTester
   hs-source-dirs: tests

Cabal/misc/gen-extra-source-files.hs

+#!/usr/bin/env runhaskell
+
+import Data.List                             (isPrefixOf, isSuffixOf, sort)
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Parse (ParseResult (..), parsePackageDescription)
+import Distribution.Verbosity                (silent)
+import System.Environment                    (getArgs, getProgName)
+import System.FilePath                       (takeExtension, takeFileName)
+import System.Process                        (readProcess)
+
+import qualified Distribution.ModuleName as ModuleName
+import qualified System.IO               as IO
+
+main' :: FilePath -> IO ()
+main' fp = do
+    -- Read cabal file, so we can determine test modules
+    contents <- strictReadFile fp
+    cabal <- case parsePackageDescription contents of
+        ParseOk _ x      -> pure x
+        ParseFailed errs -> fail (show errs)
+
+    -- We skip some files
+    let testModuleFiles = getOtherModulesFiles cabal
+    let skipPredicates' = skipPredicates ++ map (==) testModuleFiles
+
+    -- Read all files git knows about under tests/
+    files0 <- lines <$> readProcess "git" ["ls-files", "tests"] ""
+
+    -- Filter
+    let files1 = filter (\f -> takeExtension f `elem` whitelistedExtensionss ||
+                               takeFileName f `elem` whitelistedFiles)
+                        files0
+    let files2 = filter (\f -> not $ any ($ dropTestsDir f) skipPredicates') files1
+    let files3 = sort files2
+    let files = files3
+
+    -- Read current file
+    let inputLines  = lines contents
+        linesBefore = takeWhile (/= topLine) inputLines
+        linesAfter  = dropWhile (/= bottomLine) inputLines
+
+    -- Output
+    let outputLines = linesBefore ++ [topLine] ++ map ("  " ++) files ++ linesAfter
+    writeFile fp (unlines outputLines)
+
+
+topLine, bottomLine :: String
+topLine = "  -- BEGIN gen-extra-source-files"
+bottomLine = "  -- END gen-extra-source-files"
+
+dropTestsDir :: FilePath -> FilePath
+dropTestsDir fp
+    | pfx `isPrefixOf` fp = drop (length pfx) fp
+    | otherwise           = fp
+  where
+    pfx = "tests/"
+
+whitelistedFiles :: [FilePath]
+whitelistedFiles = [ "ghc", "ghc-pkg", "ghc-7.10", "ghc-pkg-7.10", "ghc-pkg-ghc-7.10" ]
+
+whitelistedExtensionss :: [String]
+whitelistedExtensionss = map ('.' : )
+    [ "hs", "lhs", "c", "sh", "cabal", "hsc", "err", "out", "in", "project" ]
+
+getOtherModulesFiles :: GenericPackageDescription -> [FilePath]
+getOtherModulesFiles gpd = mainModules ++ map fromModuleName otherModules'
+  where
+    testSuites        :: [TestSuite]
+    testSuites        = map (foldCondTree . snd) (condTestSuites gpd)
+
+    mainModules       = concatMap (mainModule   . testInterface) testSuites
+    otherModules'     = concatMap (otherModules . testBuildInfo) testSuites
+
+    fromModuleName mn = ModuleName.toFilePath mn ++ ".hs"
+
+    mainModule (TestSuiteLibV09 _ mn) = [fromModuleName mn]
+    mainModule (TestSuiteExeV10 _ fp) = [fp]
+    mainModule _                      = []
+
+skipPredicates :: [FilePath -> Bool]
+skipPredicates =
+    [ isSuffixOf "register.sh"
+    ]
+  where
+    -- eq = (==)
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+        [fp] -> main' fp
+        _    -> do
+            progName <- getProgName
+            putStrLn "Error too few arguments!"
+            putStrLn $ "Usage: " ++ progName ++ " FILE"
+            putStrLn "  where FILE is Cabal.cabal or cabal-install.cabal"
+
+strictReadFile :: FilePath -> IO String
+strictReadFile fp = do
+    handle <- IO.openFile fp IO.ReadMode
+    contents <- get handle
+    IO.hClose handle
+    return contents
+  where
+    get h = IO.hGetContents h >>= \s -> length s `seq` return s
+
+foldCondTree :: Monoid a => CondTree v c a -> a
+foldCondTree (CondNode x _ cs)
+    = mappend x
+    -- list, 3-tuple, maybe
+    $ (foldMap . foldMapTriple . foldMap) foldCondTree cs
+  where
+    foldMapTriple :: (c -> x) -> (a, b, c) -> x
+    foldMapTriple f (_, _, x) = f x

Cabal/misc/gen-extra-source-files.sh

-#!/bin/sh
-
-if [ "$#" -ne 1 ]; then
-    echo "Error: too few arguments!"
-    echo "Usage: $0 FILE"
-    exit 1
-fi
-
-set -ex
-
-git ls-files tests \
-    | awk '/\.(hs|lhs|c|sh|cabal|hsc|err|out|in|project)$|ghc/ { print } { next }' \
-    | awk '/Check.hs$|UnitTests|PackageTester|autogen|register.sh|PackageTests.hs|IntegrationTests.hs|CreatePipe|^tests\/Test/ { next } { print }' \
-    | LC_ALL=C sort \
-    | sed -e 's/^/  /' \
-    > source-file-list
-
-lead='^  -- BEGIN gen-extra-source-files'
-tail='^  -- END gen-extra-source-files'
-# cribbed off of http://superuser.com/questions/440013/how-to-replace-part-of-a-text-file-between-markers-with-another-text-file
-sed -i.bak -e "/$lead/,/$tail/{ /$lead/{p; r source-file-list
-              }; /$tail/p; d }" $1

cabal-install/cabal-install.cabal

@@ -196,7 +196,6 @@ Extra-Source-Files:
   tests/IntegrationTests/user-config/runs_without_error.sh
   tests/IntegrationTests/user-config/uses_CABAL_CONFIG.out
   tests/IntegrationTests/user-config/uses_CABAL_CONFIG.sh
-  tests/IntegrationTests2.hs
   tests/IntegrationTests2/build/keep-going/cabal.project
   tests/IntegrationTests2/build/keep-going/p/P.hs
   tests/IntegrationTests2/build/keep-going/p/p.cabal

travis-install.sh

@@ -6,7 +6,9 @@ travis_retry () {
 }
 
 if [ "$GHCVER" = "none" ]; then
-    exit 0
+    travis_retry sudo add-apt-repository -y ppa:hvr/ghc
+    travis_retry sudo apt-get update
+    travis_retry sudo apt-get install --force-yes ghc-$GHCVER
 fi
 
 if [ -z ${STACKAGE_RESOLVER+x} ]; then

travis-meta.sh

@@ -11,10 +11,10 @@
 #./Cabal/misc/gen-authors.sh > AUTHORS
 
 # Regenerate the 'extra-source-files' field in Cabal.cabal.
-(cd Cabal && timed ./misc/gen-extra-source-files.sh Cabal.cabal) || exit $?
+(cd Cabal && timed ./misc/gen-extra-source-files.hs Cabal.cabal) || exit $?
 
 # Regenerate the 'extra-source-files' field in cabal-install.cabal.
-(cd cabal-install && ../Cabal/misc/gen-extra-source-files.sh cabal-install.cabal) || exit $?
+(cd cabal-install && ../Cabal/misc/gen-extra-source-files.hs cabal-install.cabal) || exit $?
 
 # Fail if the diff is not empty.
 timed ./Cabal/misc/travis-diff-files.sh