Don't create spurious dirs on init

CONTRIBUTING.md

@@ -147,6 +147,13 @@ There are also other test suites:
 For these test executables, `-p` which applies a regex filter to the test
 names.
 
+**Testing `cabal-install` Locally**
+
+If you are testing `cabal-install` locally, you may refer to its [TESTING.md](cabal-install/TESTING.md) for
+instructions on how to use the `Makefile` to produce the appropriate `.cabal` file
+with test targets. From there, you may add tests in the usual way.
+
+
 Conventions
 -----------
 

cabal-install/TESTING.md

@@ -0,0 +1,24 @@
+# Testing `cabal-install`
+
+Local testing
+=======
+
+In order to effectively test the `cabal-install` library, the `cabal-install.cabal` file must be modified
+to build the targets in the `/test` directory. The current recommended way to set this up is to
+use the [makefile](../Makefile) supplied in the `Cabal` project parent directory, issuing the following command:
+
+
+```
+> make cabal-install-dev
+```
+
+This command will copy the dev `.cabal` generated by a project build into the `cabal-install.cabal`, and set your git index to ignore
+any changes to that file. Any subsequent changes to the `.cabal` should unset and reset the git index to make sure you don't end up committing it.
+From there, tests may be built with `cabal test` as usual. To choose a particular test so you don't end up running the whole thing, you can issue
+`tasty`-style pattern expressions like the following:
+
+```
+> cabal run cabal-install:unit-tests -- -p /cabal init/
+```
+
+Please remember to test your changes! Happy hacking.

cabal-install/cabal-install.cabal.dev

@@ -351,7 +351,7 @@ Test-Suite unit-tests
     UnitTests.Distribution.Client.Get
     UnitTests.Distribution.Client.Glob
     UnitTests.Distribution.Client.GZipUtils
-    UnitTests.Distribution.Client.Init.FileCreators
+    UnitTests.Distribution.Client.Init
     UnitTests.Distribution.Client.Store
     UnitTests.Distribution.Client.Tar
     UnitTests.Distribution.Client.TreeDiffInstances

cabal-install/cabal-install.cabal.zinza

@@ -420,7 +420,7 @@ Test-Suite unit-tests
     UnitTests.Distribution.Client.Get
     UnitTests.Distribution.Client.Glob
     UnitTests.Distribution.Client.GZipUtils
-    UnitTests.Distribution.Client.Init.FileCreators
+    UnitTests.Distribution.Client.Init
     UnitTests.Distribution.Client.Store
     UnitTests.Distribution.Client.Tar
     UnitTests.Distribution.Client.TreeDiffInstances

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

@@ -13,12 +13,30 @@
 --
 -----------------------------------------------------------------------------
 
-module Distribution.Client.Init.Command (
-
-    -- * Commands
+module Distribution.Client.Init.Command
+  ( -- * Commands
     initCabal
   , incVersion
 
+    -- * Helpers
+  , getSimpleProject
+  , getLibOrExec
+  , getCabalVersion
+  , getPackageName
+  , getVersion
+  , getLicense
+  , getAuthorInfo
+  , getHomepage
+  , getSynopsis
+  , getCategory
+  , getExtraSourceFiles
+  , getAppDir
+  , getSrcDir
+  , getGenTests
+  , getTestDir
+  , getLanguage
+  , getGenComments
+  , getModulesBuildToolsAndDeps
   ) where
 
 import Prelude ()
@@ -475,21 +493,17 @@ getGenComments flags = do
 -- | Ask for the application root directory.
 getAppDir :: InitFlags -> IO InitFlags
 getAppDir flags = do
-  appDirs <-
-    return (applicationDirs flags)
-    ?>> noAppDirIfLibraryOnly
+  appDirs <- noAppDirIfLibraryOnly
     ?>> guessAppDir flags
     ?>> promptUserForApplicationDir
     ?>> setDefault
   return $ flags { applicationDirs = appDirs }
-
   where
-    -- If the packageType==Library, then there is no application dir.
+    -- If the packageType==Library, ignore defined appdir.
     noAppDirIfLibraryOnly :: IO (Maybe [String])
-    noAppDirIfLibraryOnly =
-      if (packageType flags) == Flag Library
-      then return (Just [])
-      else return Nothing
+    noAppDirIfLibraryOnly
+      | packageType flags == Flag Library = return $ Just []
+      | otherwise = return $ applicationDirs flags
 
     -- Set the default application directory.
     setDefault :: IO (Maybe [String])
@@ -530,22 +544,19 @@ guessAppDir flags = do
 -- | Ask for the source (library) root directory.
 getSrcDir :: InitFlags -> IO InitFlags
 getSrcDir flags = do
-  srcDirs <-
-    return (sourceDirs flags)
-    ?>> noSourceDirIfExecutableOnly
+  srcDirs <- noSourceDirIfExecutableOnly
     ?>> guessSourceDir flags
     ?>> promptUserForSourceDir
     ?>> setDefault
 
   return $ flags { sourceDirs = srcDirs }
 
   where
-    -- If the packageType==Executable, then there is no source dir.
+    -- If the packageType==Executable, then ignore source dir
     noSourceDirIfExecutableOnly :: IO (Maybe [String])
-    noSourceDirIfExecutableOnly =
-      if (packageType flags) == Flag Executable
-      then return (Just [])
-      else return Nothing
+    noSourceDirIfExecutableOnly
+      | packageType flags == Flag Executable = return $ Just []
+      | otherwise = return $ sourceDirs flags
 
     -- Set the default source directory.
     setDefault :: IO (Maybe [String])

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

@@ -79,7 +79,7 @@ data InitFlags =
               , initVerbosity :: Flag Verbosity
               , overwrite     :: Flag Bool
               }
-  deriving (Show, Generic)
+  deriving (Eq, Show, Generic)
 
   -- the Monoid instance for Flag has later values override earlier
   -- ones, which is why we want Maybe [foo] for collecting foo values,

cabal-install/tests/UnitTests.hs

@@ -19,7 +19,7 @@ import qualified UnitTests.Distribution.Client.Described
 import qualified UnitTests.Distribution.Client.FileMonitor
 import qualified UnitTests.Distribution.Client.Glob
 import qualified UnitTests.Distribution.Client.GZipUtils
-import qualified UnitTests.Distribution.Client.Init.FileCreators
+import qualified UnitTests.Distribution.Client.Init
 import qualified UnitTests.Distribution.Client.Store
 import qualified UnitTests.Distribution.Client.Tar
 import qualified UnitTests.Distribution.Client.Targets
@@ -57,8 +57,8 @@ tests mtimeChangeCalibrated =
         UnitTests.Distribution.Client.Glob.tests
   , testGroup "Distribution.Client.GZipUtils"
        UnitTests.Distribution.Client.GZipUtils.tests
-  , testGroup "Distribution.Client.Init.FileCreators"
-       UnitTests.Distribution.Client.Init.FileCreators.tests
+  , testGroup "Distribution.Client.Init"
+       UnitTests.Distribution.Client.Init.tests
   , testGroup "Distribution.Client.Store"
        UnitTests.Distribution.Client.Store.tests
   , testGroup "Distribution.Client.Tar"

cabal-install/tests/UnitTests/Distribution/Client/Init/FileCreators.hs → cabal-install/tests/UnitTests/Distribution/Client/Init.hs

@@ -1,18 +1,21 @@
-module UnitTests.Distribution.Client.Init.FileCreators (
-  tests
+module UnitTests.Distribution.Client.Init
+  ( tests
   ) where
 
 import Distribution.Client.Init.FileCreators
   ( generateCabalFile )
 
 import Test.Tasty
+import Test.Tasty.HUnit
 import Test.Tasty.Golden (goldenVsString)
 
 import System.FilePath
   ( (</>) )
 import qualified Data.ByteString.Lazy as BS
 import qualified Data.ByteString.Lazy.Char8 as BS8
 
+import Distribution.Client.Init.Command
+  ( getLibOrExec, getAppDir, getSrcDir )
 import Distribution.Client.Init.Types
   ( InitFlags(..), PackageType(..), defaultInitFlags )
 import Distribution.Simple.Setup
@@ -40,6 +43,11 @@ tests = [ testGroup "cabal init goldens"
           , checkCabalFileGolden libExeAndTestFlags "lib-exe-and-test-golden.cabal"
           , checkCabalFileGolden libExeAndTestWithCommentsFlags "lib-exe-and-test-with-comments-golden.cabal"
           ]
+        , testGroup "Check init flag outputs against init script builds"
+          [ checkInitFlags "Check library-only build flags"  libFlags Library
+          , checkInitFlags "Check lib+exe build flags" libAndExeFlags LibraryAndExecutable
+          , checkInitFlags "Check exe-only build flags" exeFlags Executable
+          ]
         ]
 
 checkCabalFileGolden :: InitFlags -> FilePath -> TestTree
@@ -52,6 +60,22 @@ checkCabalFileGolden flags goldenFileName =
     generatedCabalFile :: IO BS.ByteString
     generatedCabalFile = pure . BS8.pack $ generateCabalFile goldenFileName flags
 
+checkInitFlags :: String -> InitFlags -> PackageType -> TestTree
+checkInitFlags label flags pkgType = testCase label $ do
+    flags' <- getLibOrExec rawFlags
+      >>= getAppDir
+      >>= getSrcDir
+
+    flags @=? flags'
+ where
+   rawFlags
+     | pkgType == Executable = baseFlags
+       { packageType = Flag pkgType
+       , exposedModules = Nothing
+       }
+     | otherwise = baseFlags { packageType = Flag pkgType }
+
+
 -- ==================================================
 -- Base flags to set common InitFlags values.
 
@@ -90,12 +114,23 @@ baseFlags = defaultInitFlags {
   , mainIs = Flag "Main.hs"
   , applicationDirs = Just ["app"]
   , sourceDirs = Nothing
-  , exposedModules = Nothing
+  , exposedModules = Just [ModuleName.fromString "MyLib"]
   , initializeTestSuite = Flag False
   , testDirs = Nothing
   }
 
 
+-- ==================================================
+-- Simple library flags
+
+libFlags :: InitFlags
+libFlags = baseFlags
+  { packageType = Flag Library
+  , mainIs = NoFlag
+  , sourceDirs = Just ["src"]
+  , applicationDirs = Just []
+  }
+
 -- ==================================================
 -- Simple exe.
 
@@ -104,7 +139,9 @@ exeFlags = baseFlags {
   -- Create an executable only, with main living in app/Main.hs.
     packageType = Flag Executable
   , mainIs = Flag "Main.hs"
+  , sourceDirs = Just []
   , applicationDirs = Just ["app"]
+  , exposedModules = Nothing
   }
 
 
@@ -127,7 +164,6 @@ libAndExeFlags = baseFlags {
 
   -- Library sources live in src/ and expose the module MyLib.
   , sourceDirs = Just ["src"]
-  , exposedModules = Just (map ModuleName.fromString ["MyLib"])
   }
 
 

changelog.d/pr-7262

@@ -0,0 +1,12 @@
+synopsis: Bugfix - stop creating spurious dirs on `init`
+packages: cabal-install
+prs: #7262
+issues: #6772
+
+description {
+
+- Add `TESTING.md` to `cabal-install` providing instructions for locally `cabal-install` testing,
+  along with corresponding entry in `CONTRIBUTING.md`.
+- Base directory output on package type when using the `init` command.
+
+}