Merge pull request #7424 from ptkato/cabal-init-standalone-tests

standalone tests for `cabal init`

cabal-install/src/Distribution/Client/Init/FlagExtractors.hs

@@ -135,7 +135,11 @@ getExtraDocFiles = pure
 
 -- | Ask whether the project builds a library or executable.
 getPackageType :: Interactive m => InitFlags -> m PackageType -> m PackageType
-getPackageType flags = fromFlagOrPrompt (packageType flags)
+getPackageType InitFlags
+  { initializeTestSuite = Flag True
+  , packageType         = NoFlag
+  } _ = return TestSuite
+getPackageType flags act = fromFlagOrPrompt (packageType flags) act
 
 getMainFile :: Interactive m => InitFlags -> m HsFilePath -> m HsFilePath
 getMainFile flags act = case mainIs flags of
@@ -238,12 +242,14 @@ packageTypePrompt flags = getPackageType flags $ do
       [ "Library"
       , "Executable"
       , "Library and Executable"
+      , "Test suite"
       ]
 
     parsePackageType = \case
       "Library" -> Just Library
       "Executable" -> Just Executable
       "Library and Executable" -> Just LibraryAndExecutable
+      "Test suite" -> Just TestSuite 
       _ -> Nothing
 
 testMainPrompt :: Interactive m => m HsFilePath

cabal-install/src/Distribution/Client/Init/Interactive/Command.hs

@@ -137,6 +137,20 @@ createProject v pkgIx srcDb initFlags = do
       return $ ProjectSettings
         (mkOpts comments cabalSpec) pkgDesc (Just libTarget)
         (Just exeTarget) testTarget
+
+    TestSuite -> do
+      -- the line below is necessary because if both package type and test flags
+      -- are *not* passed, the user will be prompted for a package type (which
+      -- includes TestSuite in the list). It prevents that the user end up with a
+      -- TestSuite target with initializeTestSuite set to NoFlag, thus avoiding the prompt.
+      let initFlags' = initFlags { initializeTestSuite = Flag True }
+      testTarget <- genTestTarget initFlags' pkgIx
+
+      comments <- noCommentsPrompt initFlags'
+
+      return $ ProjectSettings
+        (mkOpts comments cabalSpec) pkgDesc
+        Nothing Nothing testTarget
   where
     -- Add package name as dependency of test suite
     --

cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs

@@ -136,6 +136,13 @@ createProject comp v pkgIx srcDb initFlags = do
       return $ ProjectSettings
         (mkOpts comments cabalSpec) pkgDesc (Just libTarget)
         (Just exeTarget) testTarget
+
+    TestSuite -> do
+      testTarget <- genTestTarget initFlags comp pkgIx cabalSpec
+
+      return $ ProjectSettings
+        (mkOpts comments cabalSpec) pkgDesc
+        Nothing Nothing testTarget
 
 genPkgDescription
   :: Interactive m

cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs

@@ -122,20 +122,28 @@ guessExtraDocFiles flags = do
 --   looking for unique characteristics from each type, defaults to Executable.
 guessPackageType :: Interactive m => InitFlags -> m PackageType
 guessPackageType flags = do
-  let lastDir dirs   = L.last . splitDirectories $ dirs
-      srcCandidates  = [defaultSourceDir, "src", "source"]
-      testCandidates = [defaultTestDir, "test", "tests"]
-
-  pkgDir <- fromFlagOrDefault getCurrentDirectory $ return <$> packageDir flags
-  files  <- listFilesInside (\x -> return $ lastDir x `notElem` testCandidates) pkgDir
-
-  let hasExe = not $ null [f | f <- files, isMain $ takeFileName f]
-      hasLib = not $ null [f | f <- files, lastDir f `elem` srcCandidates]
-
-  return $ case (hasLib, hasExe) of
-    (True, True)  -> LibraryAndExecutable
-    (True, False) -> Library
-    _             -> Executable
+  if fromFlagOrDefault False (initializeTestSuite flags)
+    then
+      return TestSuite 
+    else do
+      let lastDir dirs   = L.last . splitDirectories $ dirs
+          srcCandidates  = [defaultSourceDir, "src", "source"]
+          testCandidates = [defaultTestDir, "test", "tests"]
+
+      pkgDir <- fromFlagOrDefault getCurrentDirectory $ return <$> packageDir flags
+      files  <- listFilesInside (\x -> return $ lastDir x `notElem` testCandidates) pkgDir
+      files' <- filter (not . null . map (`elem` testCandidates) . splitDirectories) <$>
+        listFilesRecursive pkgDir
+
+      let hasExe   = not $ null [f | f <- files,  isMain $ takeFileName f]
+          hasLib   = not $ null [f | f <- files,  lastDir f `elem` srcCandidates]
+          hasTest  = not $ null [f | f <- files', isMain $ takeFileName f]
+
+      return $ case (hasLib, hasExe, hasTest) of
+        (True , True , _   ) -> LibraryAndExecutable
+        (True , False, _   ) -> Library
+        (False, False, True) -> TestSuite
+        _                    -> Executable
 
 -- | Try to guess the application directories from the package directory,
 --   using a default value as fallback.

cabal-install/src/Distribution/Client/Init/Simple.hs

@@ -62,6 +62,12 @@ createProject v _pkgIx _srcDb initFlags = do
         return $ ProjectSettings
           (mkOpts False cabalSpec) pkgDesc
           (Just libTarget) (Just exeTarget) testTarget
+
+      TestSuite -> do
+        testTarget <- genSimpleTestTarget initFlags
+        return $ ProjectSettings
+          (mkOpts False cabalSpec) pkgDesc
+          Nothing Nothing testTarget
   where
     -- Add package name as dependency of test suite
     --

cabal-install/src/Distribution/Client/Init/Types.hs

@@ -210,9 +210,9 @@ data ProjectSettings = ProjectSettings
 -- Other types
 
 -- | Enum to denote whether the user wants to build a library target,
--- executable target, or library and executable targets.
+-- executable target, library and executable targets, or a standalone test suite.
 --
-data PackageType = Library | Executable | LibraryAndExecutable
+data PackageType = Library | Executable | LibraryAndExecutable | TestSuite
     deriving (Eq, Show, Generic)
 
 data HsFileType

cabal-install/src/Distribution/Client/Setup.hs

@@ -2135,7 +2135,7 @@ initOptions _ =
     (noArg (Flag IT.LibraryAndExecutable))
 
       , option [] ["tests"]
-        "Generate a test suite for the library."
+        "Generate a test suite, standalone or for a library."
         IT.initializeTestSuite
         (\v flags -> flags { IT.initializeTestSuite = v })
         trueArg

cabal-install/tests/UnitTests/Distribution/Client/Init/Golden.hs

@@ -11,7 +11,7 @@ import Test.Tasty.HUnit
 
 import qualified Data.ByteString.Lazy.Char8 as BS8
 import Data.List.NonEmpty (fromList)
-import Data.List.NonEmpty as NEL (NonEmpty)
+import Data.List.NonEmpty as NEL (NonEmpty, drop)
 #if __GLASGOW_HASKELL__ < 804
 import Data.Semigroup ((<>))
 #endif
@@ -214,6 +214,16 @@ goldenTestTests v pkgIx pkgDir pkgName = testGroup "test golden tests"
       (goldenTest "test-build-tools-with-comments.golden") $
         let opts = WriteOpts False False False v pkgDir Library pkgName defaultCabalVersion
         in runGoldenTest opts testArgs (emptyFlags {buildTools = Flag ["happy"]})
+
+    , goldenVsString "Standalone tests, empty flags, not simple, no options"
+      (goldenTest "standalone-test.golden") $
+        let opts = WriteOpts False False True v pkgDir TestSuite pkgName defaultCabalVersion
+        in runGoldenTest opts testArgs emptyFlags
+
+    , goldenVsString "Standalone tests, empty flags, not simple, with comments + no minimal"
+      (goldenTest "standalone-test-with-comments.golden") $
+        let opts = WriteOpts False False False v pkgDir TestSuite pkgName defaultCabalVersion
+        in runGoldenTest opts testArgs emptyFlags
     ]
   where
     runGoldenTest opts args flags =
@@ -245,6 +255,14 @@ goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
     , goldenVsString "Library, empty flags, not simple, no comments + no minimal"
       (goldenCabal "cabal-lib-no-comments.golden") $
         runGoldenTest (libProjArgs "N") emptyFlags
+
+    , goldenVsString "Test suite, empty flags, not simple, with comments + no minimal"
+      (goldenCabal "cabal-test-suite-with-comments.golden") $
+        runGoldenTest (testProjArgs "Y") emptyFlags
+
+    , goldenVsString "Test suite, empty flags, not simple, no comments + no minimal"
+      (goldenCabal "cabal-test-suite-no-comments.golden") $
+        runGoldenTest (testProjArgs "N") emptyFlags
     ]
   where
     runGoldenTest args flags =
@@ -265,6 +283,12 @@ goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
               testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}
 
           mkStanza $ pkgFields ++ [libStanza, testStanza]
+
+        (Right (ProjectSettings opts pkgDesc Nothing Nothing (Just testTarget), _)) -> do
+          let pkgFields = mkPkgDescription opts pkgDesc
+              testStanza = mkTestStanza opts $ testTarget {_testDependencies = mangleBaseDep testTarget _testDependencies}
+
+          mkStanza $ pkgFields ++ [testStanza]
 
         (Right (ProjectSettings _ _ l e t, _)) -> assertFailure $
           show l ++ "\n" ++ show e ++ "\n" ++ show t
@@ -319,6 +343,12 @@ pkgArgs = fromList
     , "4"
     ]
 
+testProjArgs :: String -> NonEmpty String
+testProjArgs comments = fromList ["4", "foo-package"]
+  <> pkgArgs
+  <> fromList (NEL.drop 1 testArgs)
+  <> fromList [comments]
+
 libProjArgs :: String -> NonEmpty String
 libProjArgs comments = fromList ["1", "foo-package"]
   <> pkgArgs

cabal-install/tests/UnitTests/Distribution/Client/Init/Interactive.hs

@@ -164,6 +164,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- language
               , "2"
               -- test target
+              , "y"
               -- main file
               , "1"
               -- test dir
@@ -174,7 +175,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               , "y"
               ]
 
-        case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
+        case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
           Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
             _optOverwrite  opts @?= False
             _optMinimal    opts @?= False
@@ -258,6 +259,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               -- language
               , "2"
               -- test target
+              , "y"
               -- main file
               , "1"
               -- test dir
@@ -268,7 +270,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               , "y"
               ]
 
-        case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
+        case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
           Right (ProjectSettings opts desc (Just lib) Nothing (Just test), _) -> do
             _optOverwrite  opts @?= False
             _optMinimal    opts @?= False
@@ -311,6 +313,79 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
             exe  @?= Nothing
             test @?! Nothing
           Left e -> assertFailure $ show e
+
+    , testCase "Check the interactive library workflow" $ do
+        let inputs = fromList
+              -- package type
+              [  "4"
+              -- package dir
+              , "test-package"
+              -- package description
+              -- cabal version
+              , "4"
+              -- package name
+              , "test-package"
+              , "test-package"
+              -- version
+              , "3.1.2.3"
+              -- license
+              , "3"
+              -- author
+              , "Foobar"
+              -- email
+              , "[email protected]"
+              -- homepage
+              , "qux.com"
+              -- synopsis
+              , "Qux's package"
+              -- category
+              , "3"
+              -- test target
+              -- main file
+              , "1"
+              -- test dir
+              , "test"
+              -- language
+              , "1"
+              -- comments
+              , "y"
+              ]
+
+        case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+          Right (ProjectSettings opts desc Nothing Nothing (Just test), _) -> do
+            _optOverwrite  opts @?= False
+            _optMinimal    opts @?= False
+            _optNoComments opts @?= False
+            _optVerbosity  opts @?= silent
+            _optPkgDir     opts @?= "/home/test/test-package"
+            _optPkgType    opts @?= TestSuite
+            _optPkgName    opts @?= mkPackageName "test-package"
+
+            _pkgCabalVersion  desc @?= CabalSpecV2_4
+            _pkgName          desc @?= mkPackageName "test-package"
+            _pkgVersion       desc @?= mkVersion [3,1,2,3]
+            _pkgLicense       desc @?! SPDX.NONE
+            _pkgAuthor        desc @?= "Foobar"
+            _pkgEmail         desc @?= "[email protected]"
+            _pkgHomePage      desc @?= "qux.com"
+            _pkgSynopsis      desc @?= "Qux's package"
+            _pkgCategory      desc @?= "Control"
+            _pkgExtraSrcFiles desc @?= mempty
+            _pkgExtraDocFiles desc @?= pure (Set.singleton "CHANGELOG.md")
+
+            _testMainIs       test @?= HsFilePath "Main.hs" Standard
+            _testDirs         test @?= ["test"]
+            _testLanguage     test @?= Haskell2010
+            _testOtherModules test @?= []
+            _testOtherExts    test @?= []
+            _testDependencies test @?! []
+            _testBuildTools   test @?= []
+
+          Right (ProjectSettings _ _ lib exe test, _) -> do
+            lib  @?= Nothing
+            exe  @?= Nothing
+            test @?! Nothing
+          Left e -> assertFailure $ show e
     ]
   , testGroup "without tests"
     [ testCase "Check the interactive library and executable workflow" $ do
@@ -668,13 +743,13 @@ fileCreatorTests pkgIx srcDb _pkgName = testGroup "generators"
   , testGroup "genTestTarget"
     [ testCase "Check test package flags workflow" $ do
         let inputs = fromList
-              [ "1"               -- pick the first main file option in the list
+              [ "y"               -- say yes to tests
+              , "1"               -- pick the first main file option in the list
               , "test"            -- package test dir
               , "1"               -- pick the first language in the list
               ]
 
-        runGenTest inputs $ genTestTarget
-          (emptyFlags {initializeTestSuite = Flag True}) pkgIx
+        runGenTest inputs $ genTestTarget emptyFlags pkgIx
     ]
   ]
   where