{-# LANGUAGE OverloadedStrings #-} module Main where import Data.Maybe (fromMaybe) import GHC.Paths (ghc) import Smuggler2.Options (ExportAction (..), ImportAction (..), Options (..)) import System.Environment (lookupEnv) import System.FilePath ((-<.>), (), takeBaseName) import System.Process.Typed ( ProcessConfig, proc, runProcess_, setEnvInherit, setWorkingDirInherit, ) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.Golden (findByExtension, goldenVsFileDiff, writeBinaryFile) -- | Where the tests are, relative to the project level cabal file testDir :: FilePath testDir = "test" "tests" -- | Combinations of import and export action options to be tested optionsList :: [Options] optionsList = [ mkOptions PreserveInstanceImports NoExportProcessing, mkOptions MinimiseImports ReplaceExports, mkOptions MinimiseImports NoExportProcessing, mkOptions NoImportProcessing AddExplicitExports, mkOptions NoImportProcessing NoExportProcessing, mkOptions NoImportProcessing ReplaceExports ] where mkOptions :: ImportAction -> ExportAction -> Options mkOptions ia ea = Options ia ea (Just $ mkExt ia ea) -- | Make an extention for an output file mkExt :: ImportAction -> ExportAction -> String mkExt ia ea = show ia ++ show ea -- ++ "-" ++ takeFileName ghc -- | Generate test for a list of 'Options' each of which specify what action to -- take on imports and exports testOptions :: [Options] -> IO TestTree testOptions opts = testGroup "All" <$> sequenceA (goldenTests <$> opts) -- | Generate tests for a set of 'Options' (that specifies what to do to -- imports and exports) goldenTests :: Options -> IO TestTree goldenTests opts = do testFiles <- findByExtension [".hs"] testDir return $ testGroup testName [ goldenVsFileDiff (takeBaseName testFile) -- test name (\ref new -> ["git", "diff", "--no-index", ref, new]) -- how to display diffs (testFile -<.> testName ++ "-golden") -- golden file outputFilename ( do -- Write a default output file for those tests where smuggler -- (deliberately) does not generate a new one writeBinaryFile outputFilename "Source file was not touched\r\n" compile testFile opts ) | testFile <- testFiles, let outputFilename = testFile -<.> testName ] where testName = fromMaybe "NoNewExtension" (newExtension opts) -- | Just run all the tests main :: IO () main = defaultMain =<< testOptions optionsList -- | Use `cabal exec` to run the compilation, so that the smuggler plugin is -- picked up from the local database. GHC alone would use the global one. compile :: FilePath -> Options -> IO () compile testcase opts = do cabalPath <- lookupEnv "CABAL" -- find, eg, @/opt/ghc/bin/cabal@ or @cabal -vnormal+nowrap@ let cabalCmd = words $ fromMaybe "cabal" cabalPath -- default to @cabal@ if @CABAL@ is not set let cabalConfig = setWorkingDirInherit . setEnvInherit $ proc (head cabalCmd) (tail cabalCmd ++ cabalArgs) :: ProcessConfig () () () runProcess_ cabalConfig where cabalArgs :: [String] cabalArgs = -- - not sure why it is necessary to mention the smuggler2 package explicitly, -- but it appears to be hidden otherwise. -- - This puts the .imports files that smuggler generates somewhere they -- can easily be found [ "--with-compiler=" ++ ghc, "exec", ghc, "--", "-package smuggler2", "-v0", "-dumpdir=" ++ testDir, "-fno-code", "-fplugin=Smuggler2.Plugin" ] ++ map ("-fplugin-opt=Smuggler2.Plugin:" ++) ( let ia = importAction opts ea = exportAction opts p = [show ia, show ea] in case newExtension opts of Nothing -> mkExt ia ea : p -- provide a default extension Just e -> e : p ) ++ [testcase]