Use Cabal API for more robust tests

.travis.yml

@@ -86,8 +86,7 @@ install:
       (cd "./th-desugar" && autoreconf -i);
     fi
   - rm -f cabal.project.freeze
-  - cabal new-configure -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project"
-  - cabal new-build --dep -j2 ${TARGETS}
+  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 ${TARGETS}
   - rm -rf "."/.ghc.environment.* "./th-desugar"/.ghc.environment.* "."/dist "./th-desugar"/dist
   - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
 
@@ -105,22 +104,16 @@ script:
 
 
   # build & run tests, build benchmarks
-  - cabal new-build ${TARGETS}
-  - |
-    if [ "x$TEST" = "x--enable-tests" ]; then
-      # Why not use `cabal new-test` here? Sadly, it's because `new-test` does
-      # not yet support passing arguments to test suite executables.
-      # See https://github.com/haskell/cabal/issues/4643.
-      CMD="$(find dist-newstyle -type f -iname "singletons-test-suite" -print -quit)" && ${CMD} --rootdir singletons-2.5
-    fi
+  - cabal new-build -w ${HC} ${TEST} ${BENCH} ${TARGETS}
+  - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} ${TARGETS}; fi
 
   # cabal check
   - (cd singletons-* && cabal check)
   - (cd th-desugar-* && cabal check)
 
   # haddock
   - rm -rf ./dist-newstyle
-  - if $HADDOCK; then cabal new-haddock ${TARGETS}; else echo "Skipping haddock generation";fi
+  - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} ${TARGETS}; else echo "Skipping haddock generation";fi
 
 # REGENDATA ["-o",".travis.yml","--no-no-tests-no-bench","--no-installed","cabal.project"]
 # EOF

Setup.hs

@@ -1,2 +1,138 @@
+{-# OPTIONS_GHC -Wall #-}
+module Main (main) where
+
+import Control.Monad
+
+import Data.List
+import Data.String
+
+import Distribution.PackageDescription
 import Distribution.Simple
-main = defaultMain
+import Distribution.Simple.BuildPaths
+import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.PackageIndex
+import Distribution.Simple.Program
+import Distribution.Simple.Setup
+import Distribution.Simple.Utils
+import Distribution.Text
+
+import System.Directory
+import System.FilePath
+
+main :: IO ()
+main = defaultMainWithHooks simpleUserHooks
+  { buildHook = \pkg lbi hooks flags -> do
+      generateBuildModule flags pkg lbi
+      buildHook simpleUserHooks pkg lbi hooks flags
+  , confHook = \(gpd, hbi) flags ->
+      confHook simpleUserHooks (amendGPD gpd, hbi) flags
+  , haddockHook = \pkg lbi hooks flags -> do
+      generateBuildModule (haddockToBuildFlags flags) pkg lbi
+      haddockHook simpleUserHooks pkg lbi hooks flags
+  }
+
+-- | Convert only flags used by 'generateBuildModule'.
+haddockToBuildFlags :: HaddockFlags -> BuildFlags
+haddockToBuildFlags f = emptyBuildFlags
+    { buildVerbosity = haddockVerbosity f
+    , buildDistPref  = haddockDistPref f
+    }
+
+generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
+generateBuildModule flags pkg lbi = do
+  rootDir <- getCurrentDirectory
+  let verbosity = fromFlag (buildVerbosity flags)
+      distPref  = fromFlag (buildDistPref flags)
+      distPref' | isRelative distPref = rootDir </> distPref
+                | otherwise           = distPref
+      -- Package DBs
+      dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref' </> "package.conf.inplace" ]
+      dbFlags = "-hide-all-packages" : packageDbArgsDb dbStack
+
+      ghc = case lookupProgram ghcProgram (withPrograms lbi) of
+              Just fp -> locationPath $ programLocation fp
+              Nothing -> error "Can't find GHC path"
+  withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testSuiteName) $ do
+    let testAutogenDir = autogenComponentModulesDir lbi suitecfg
+    createDirectoryIfMissingVerbose verbosity True testAutogenDir
+    let buildSingletonsFile = testAutogenDir </> buildSingletonsModule <.> "hs"
+    withLibLBI pkg lbi $ \_ libCLBI -> do
+      let libDeps = map fst $ componentPackageDeps libCLBI
+          pidx = case dependencyClosure (installedPkgs lbi) libDeps of
+                   Left p  -> p
+                   Right _ -> error "Broken dependency closure"
+          libTransDeps = map installedUnitId $ allPackages pidx
+          singletonsUnitId = componentUnitId libCLBI
+          deps = formatDeps (singletonsUnitId:libTransDeps)
+          allFlags = dbFlags ++ deps
+      writeFile buildSingletonsFile $ unlines
+        [ "module Build_singletons where"
+        , ""
+        , "ghcPath :: FilePath"
+        , "ghcPath = " ++ show ghc
+        , ""
+        , "ghcFlags :: [String]"
+        , "ghcFlags = " ++ show allFlags
+        , ""
+        , "rootDir :: FilePath"
+        , "rootDir = " ++ show rootDir
+        ]
+  where
+    formatDeps = map formatOne
+    formatOne installedPkgId = "-package-id=" ++ display installedPkgId
+
+    -- GHC >= 7.6 uses the '-package-db' flag. See
+    -- https://ghc.haskell.org/trac/ghc/ticket/5977.
+    packageDbArgsDb :: [PackageDB] -> [String]
+    -- special cases to make arguments prettier in common scenarios
+    packageDbArgsDb dbstack = case dbstack of
+      (GlobalPackageDB:UserPackageDB:dbs)
+        | all isSpecific dbs              -> concatMap single dbs
+      (GlobalPackageDB:dbs)
+        | all isSpecific dbs              -> "-no-user-package-db"
+                                           : concatMap single dbs
+      dbs                                 -> "-clear-package-db"
+                                           : concatMap single dbs
+     where
+       single (SpecificPackageDB db) = [ "-package-db=" ++ db ]
+       single GlobalPackageDB        = [ "-global-package-db" ]
+       single UserPackageDB          = [ "-user-package-db" ]
+       isSpecific (SpecificPackageDB _) = True
+       isSpecific _                     = False
+
+buildSingletonsModule :: FilePath
+buildSingletonsModule = "Build_singletons"
+
+testSuiteName :: String
+testSuiteName = "singletons-test-suite"
+
+amendGPD :: GenericPackageDescription -> GenericPackageDescription
+amendGPD gpd = gpd
+    { condTestSuites = map f (condTestSuites gpd)
+    }
+  where
+    f (name, condTree)
+        | name == fromString testSuiteName = (name, condTree')
+        | otherwise                        = (name, condTree)
+      where
+        -- I miss 'lens'
+        testSuite = condTreeData condTree
+        bi = testBuildInfo testSuite
+        om = otherModules bi
+        am = autogenModules bi
+
+        -- Cons the module to both other-modules and autogen-modules.
+        -- At the moment, cabal-spec-2.0 and cabal-spec-2.2 don't have
+        -- "all autogen-modules are other-modules if they aren't exposed-modules"
+        -- rule. Hopefully cabal-spec-3.0 will have.
+        --
+        -- Note: we `nub`, because it's unclear if that's ok to have duplicate
+        -- modules in the lists.
+        om' = nub $ mn : om
+        am' = nub $ mn : am
+
+        mn = fromString buildSingletonsModule
+
+        bi' = bi { otherModules = om', autogenModules = am' }
+        testSuite' = testSuite { testBuildInfo = bi' }
+        condTree' = condTree { condTreeData = testSuite' }

singletons.cabal

@@ -22,7 +22,7 @@ extra-source-files: README.md, CHANGES.md,
                     tests/compile-and-dump/Singletons/*.ghc84.template
 license:        BSD3
 license-file:   LICENSE
-build-type:     Simple
+build-type:     Custom
 description:
     This library generates singleton types, promoted functions, and singleton
     functions using Template Haskell. It is useful for programmers who wish
@@ -40,6 +40,13 @@ source-repository this
   location: https://github.com/goldfirere/singletons.git
   tag:      v2.5
 
+custom-setup
+  setup-depends:
+    base      >= 4.11 && < 4.12,
+    Cabal     >= 2.1 && < 2.3,
+    directory >= 1,
+    filepath  >= 1.3
+
 library
   hs-source-dirs:     src
   build-depends:      base >= 4.11 && < 4.12,
@@ -146,5 +153,4 @@ test-suite singletons-test-suite
                       process >= 1.1,
                       singletons,
                       tasty >= 0.6,
-                      tasty-golden >= 2.2,
-                      directory >= 1
+                      tasty-golden >= 2.2

tests/README.md

@@ -30,15 +30,10 @@ tests:
       make clean-tests
       ```
 
- * Running the testsuite currently requires `cabal-install-2.1` later, as it
-   makes extensive use of the `new-exec` feature to invoke `ghc` using the
-   in-tree `singletons` library. Make sure this version of `cabal` is on your
-   `PATH` before invoking the tests.
-
-   Running the testsuite also requires `awk`, `sed` and `diff`. `awk` is used
-   to generate golden files from templates (see below). `sed` is used to
-   normalize output from GHC (see Note [Normalization with sed]).`diff` is used
-   to compare golden and actual files.
+ * Running the testsuite requires `awk`, `sed` and `diff`. `awk` is used to
+   generate golden files from templates (see below). `sed` is used to normalize
+   output from GHC (see Note [Normalization with sed]).`diff` is used to compare
+   golden and actual files.
 
  * Each compile-and-dump test requires a set of GHC options to be used for
    compilation. Testsuite defines a default set of options that enable on the