Cabal Init Omnibus

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

@@ -45,7 +45,7 @@ initCmd v packageDBs repoCtxt comp progdb initFlags = do
     installedPkgIndex <- getInstalledPackages v comp packageDBs progdb
     sourcePkgDb <- getSourcePackages v repoCtxt
     hSetBuffering stdout NoBuffering
-    settings <- createProject v installedPkgIndex sourcePkgDb initFlags
+    settings <- createProject v comp installedPkgIndex sourcePkgDb initFlags
     writeProject settings
   where
     -- When no flag is set, default to interactive.

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

@@ -61,6 +61,7 @@ import Distribution.Client.Types (SourcePackageDb(..))
 import Distribution.Solver.Types.PackageIndex (elemByPackageName)
 
 import Language.Haskell.Extension (Language(..))
+import Distribution.Simple.Compiler
 
 
 
@@ -69,11 +70,12 @@ import Language.Haskell.Extension (Language(..))
 createProject
     :: Interactive m
     => Verbosity
+    -> Compiler
     -> InstalledPackageIndex
     -> SourcePackageDb
     -> InitFlags
     -> m ProjectSettings
-createProject v pkgIx srcDb initFlags = do
+createProject v _comp pkgIx srcDb initFlags = do
 
   -- The workflow is as follows:
   --

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

@@ -60,18 +60,20 @@ import Distribution.Utils.Generic (safeHead)
 import Language.Haskell.Extension (Language(..), Extension(..))
 
 import System.FilePath (splitDirectories, (</>))
+import Distribution.Simple.Compiler
 
 
 -- | Main driver for interactive prompt code.
 --
 createProject
     :: Interactive m
     => Verbosity
+    -> Compiler
     -> InstalledPackageIndex
     -> SourcePackageDb
     -> InitFlags
     -> m ProjectSettings
-createProject v pkgIx srcDb initFlags = do
+createProject v comp pkgIx srcDb initFlags = do
 
   -- The workflow is as follows:
   --
@@ -109,24 +111,24 @@ createProject v pkgIx srcDb initFlags = do
 
   case pkgType of
     Library -> do
-      libTarget <- genLibTarget initFlags pkgIx
-      testTarget <- genTestTarget initFlags pkgIx
+      libTarget <- genLibTarget initFlags comp pkgIx
+      testTarget <- genTestTarget initFlags comp pkgIx
 
       return $ ProjectSettings
         (mkOpts comments) pkgDesc
         (Just libTarget) Nothing testTarget
 
     Executable -> do
-      exeTarget <- genExeTarget initFlags pkgIx
+      exeTarget <- genExeTarget initFlags comp pkgIx
 
       return $ ProjectSettings
         (mkOpts comments) pkgDesc Nothing
         (Just exeTarget) Nothing
 
     LibraryAndExecutable -> do
-      libTarget <- genLibTarget initFlags pkgIx
-      exeTarget <- genExeTarget initFlags pkgIx
-      testTarget <- genTestTarget initFlags pkgIx
+      libTarget <- genLibTarget initFlags comp pkgIx
+      exeTarget <- genExeTarget initFlags comp pkgIx
+      testTarget <- genTestTarget initFlags comp pkgIx
 
       return $ ProjectSettings
         (mkOpts comments) pkgDesc (Just libTarget)
@@ -152,13 +154,14 @@ genPkgDescription flags srcDb = PkgDescription
 genLibTarget
   :: Interactive m
   => InitFlags
+  -> Compiler
   -> InstalledPackageIndex
   -> m LibTarget
-genLibTarget flags pkgs = do
+genLibTarget flags comp pkgs = do
   srcDirs   <- srcDirsHeuristics flags
   let srcDir = fromMaybe defaultSourceDir $ safeHead srcDirs
   LibTarget srcDirs
-    <$> languageHeuristics flags
+    <$> languageHeuristics flags comp
     <*> exposedModulesHeuristics flags
     <*> libOtherModulesHeuristics flags
     <*> otherExtsHeuristics flags srcDir
@@ -168,15 +171,16 @@ genLibTarget flags pkgs = do
 genExeTarget
   :: Interactive m
   => InitFlags
+  -> Compiler
   -> InstalledPackageIndex
   -> m ExeTarget
-genExeTarget flags pkgs = do
+genExeTarget flags comp pkgs = do
   appDirs   <- appDirsHeuristics flags
   let appDir = fromMaybe defaultApplicationDir $ safeHead appDirs
   ExeTarget
     <$> mainFileHeuristics flags
     <*> pure appDirs
-    <*> languageHeuristics flags
+    <*> languageHeuristics flags comp
     <*> exeOtherModulesHeuristics flags
     <*> otherExtsHeuristics flags appDir
     <*> dependenciesHeuristics flags appDir pkgs
@@ -185,9 +189,10 @@ genExeTarget flags pkgs = do
 genTestTarget
   :: Interactive m
   => InitFlags
+  -> Compiler
   -> InstalledPackageIndex
   -> m (Maybe TestTarget)
-genTestTarget flags pkgs = do
+genTestTarget flags comp pkgs = do
   initialized <- initializeTestSuiteHeuristics flags
   testDirs' <- testDirsHeuristics flags
   let testDir = fromMaybe defaultTestDir $ safeHead testDirs'
@@ -196,7 +201,7 @@ genTestTarget flags pkgs = do
   else fmap Just $ TestTarget
     <$> testMainHeuristics flags
     <*> pure testDirs'
-    <*> languageHeuristics flags
+    <*> languageHeuristics flags comp
     <*> testOtherModulesHeuristics flags
     <*> otherExtsHeuristics flags testDir
     <*> dependenciesHeuristics flags testDir pkgs
@@ -304,8 +309,8 @@ testDirsHeuristics :: Interactive m => InitFlags -> m [String]
 testDirsHeuristics flags = getTestDirs flags $ return [defaultTestDir]
 
 -- | Ask for the Haskell base language of the package.
-languageHeuristics :: Interactive m => InitFlags -> m Language
-languageHeuristics flags = getLanguage flags guessLanguage
+languageHeuristics :: Interactive m => InitFlags -> Compiler -> m Language
+languageHeuristics flags comp = getLanguage flags $ guessLanguage comp
 
 -- | Ask whether to generate explanatory comments.
 noCommentsHeuristics :: Interactive m => InitFlags -> m Bool

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

@@ -44,6 +44,7 @@ import Distribution.CabalSpecVersion
 import Language.Haskell.Extension
 import Distribution.Version
 import Distribution.Types.PackageName (PackageName, mkPackageName)
+import Distribution.Simple.Compiler
 
 
 
@@ -72,15 +73,12 @@ guessCabalSpecVersion = do
     format' (x:xs) = x : format' xs
 
 -- | Guess the language specification based on the GHC version
-guessLanguage :: Interactive m => m Language
-guessLanguage = do
-  (_, verString, _) <- readProcessWithExitCode "ghc" ["--version"] ""
-  case simpleParsec <$> runParser versionParser () "" verString of
-    Right (Just ver) -> return $
-      if ver < mkVersion [7,0,1]
-        then Haskell98
-        else Haskell2010
-    _ -> return defaultLanguage
+guessLanguage :: Interactive m => Compiler -> m Language
+guessLanguage Compiler {compilerId = CompilerId GHC ver} =
+    return $ if ver < mkVersion [7,0,1]
+      then Haskell98
+      else Haskell2010
+guessLanguage _ = return defaultLanguage
 
 -- | Guess the package name based on the given root directory.
 guessPackageName :: Interactive m => FilePath -> m PackageName

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

@@ -18,16 +18,18 @@ import Distribution.Client.Init.Utils (currentDirPkgName, mkPackageNameDep)
 import Distribution.Client.Init.Defaults
 import Distribution.Simple.Flag (fromFlagOrDefault, flagElim)
 import Distribution.Client.Init.FlagExtractors
+import Distribution.Simple.Compiler
 
 
 createProject
     :: Interactive m
     => Verbosity
+    -> Compiler
     -> InstalledPackageIndex
     -> SourcePackageDb
     -> InitFlags
     -> m ProjectSettings
-createProject v _pkgIx _srcDb initFlags = do
+createProject v _comp _pkgIx _srcDb initFlags = do
     pkgType <- packageTypePrompt initFlags
     isMinimal <- getMinimal initFlags
     doOverwrite <- getOverwrite initFlags

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

@@ -58,12 +58,12 @@ tests
     -> InstalledPackageIndex
     -> SourcePackageDb
     -> TestTree
-tests v initFlags _comp pkgIx srcDb = testGroup "golden"
+tests v initFlags comp pkgIx srcDb = testGroup "golden"
     [ goldenLibTests v pkgIx pkgDir pkgName
     , goldenExeTests v pkgIx pkgDir pkgName
     , goldenTestTests v pkgIx pkgDir pkgName
     , goldenPkgDescTests v srcDb pkgDir pkgName
-    , goldenCabalTests v pkgIx srcDb
+    , goldenCabalTests v comp pkgIx srcDb
     ]
   where
     pkgDir = evalPrompt (getPackageDir initFlags)
@@ -232,10 +232,11 @@ goldenTestTests v pkgIx pkgDir pkgName = testGroup "test golden tests"
 -- | Full cabal file golden tests
 goldenCabalTests
     :: Verbosity
+    -> Compiler
     -> InstalledPackageIndex
     -> SourcePackageDb
     -> TestTree
-goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
+goldenCabalTests v comp pkgIx srcDb = testGroup ".cabal file golden tests"
     [ goldenVsString "Library and executable, empty flags, not simple, with comments + no minimal"
       (goldenCabal "cabal-lib-and-exe-with-comments.golden") $
         runGoldenTest (fullProjArgs "Y") emptyFlags
@@ -254,7 +255,7 @@ goldenCabalTests v pkgIx srcDb = testGroup ".cabal file golden tests"
     ]
   where
     runGoldenTest args flags =
-      case _runPrompt (createProject v pkgIx srcDb flags) args of
+      case _runPrompt (createProject v comp pkgIx srcDb flags) args of
         Left e -> assertFailure $ show e
 
         (Right (ProjectSettings opts pkgDesc (Just libTarget) (Just exeTarget) (Just testTarget), _)) -> do

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

@@ -39,9 +39,9 @@ tests
     -> InstalledPackageIndex
     -> SourcePackageDb
     -> TestTree
-tests _v initFlags _comp pkgIx srcDb =
+tests _v initFlags comp pkgIx srcDb =
   testGroup "Distribution.Client.Init.Interactive.Command.hs"
-    [ createProjectTest pkgIx srcDb
+    [ createProjectTest comp pkgIx srcDb
     , fileCreatorTests pkgIx srcDb pkgName
     , interactiveTests srcDb
     ]
@@ -52,10 +52,11 @@ tests _v initFlags _comp pkgIx srcDb =
     -- pkgNm  = evalPrompt (getPackageName srcDb initFlags) $ fromList ["test-package", "y"]
 
 createProjectTest
-  :: InstalledPackageIndex
+  :: Compiler
+  -> InstalledPackageIndex
   -> SourcePackageDb
   -> TestTree
-createProjectTest pkgIx srcDb = testGroup "createProject tests"
+createProjectTest comp pkgIx srcDb = testGroup "createProject tests"
   [ testGroup "with flags"
     [ testCase "Check the non-interactive workflow" $ do
         let dummyFlags' = dummyFlags
@@ -72,7 +73,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               , dependencies = Flag []
               }
 
-        case (_runPrompt $ createProject silent pkgIx srcDb dummyFlags') (fromList ["3", "quxTest/Main.hs"]) of
+        case (_runPrompt $ createProject silent comp pkgIx srcDb dummyFlags') (fromList ["3", "quxTest/Main.hs"]) of
           Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
             _optOverwrite  opts @?= False
             _optMinimal    opts @?= False
@@ -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 comp pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
           Right (ProjectSettings opts desc (Just lib) (Just exe) (Just test), _) -> do
             _optOverwrite  opts @?= False
             _optMinimal    opts @?= False
@@ -267,7 +268,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               , "y"
               ]
 
-        case (_runPrompt $ createProject silent pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
+        case (_runPrompt $ createProject silent comp pkgIx srcDb (emptyFlags {initializeTestSuite = Flag True})) inputs of
           Right (ProjectSettings opts desc (Just lib) Nothing (Just test), _) -> do
             _optOverwrite  opts @?= False
             _optMinimal    opts @?= False
@@ -355,7 +356,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               , "y"
               ]
 
-        case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+        case (_runPrompt $ createProject silent comp pkgIx srcDb emptyFlags) inputs of
           Right (ProjectSettings opts desc (Just lib) (Just exe) Nothing, _) -> do
             _optOverwrite  opts @?= False
             _optMinimal    opts @?= False
@@ -435,7 +436,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               , "y"
               ]
 
-        case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+        case (_runPrompt $ createProject silent comp pkgIx srcDb emptyFlags) inputs of
           Right (ProjectSettings opts desc (Just lib) Nothing Nothing, _) -> do
             _optOverwrite  opts @?= False
             _optMinimal    opts @?= False
@@ -507,7 +508,7 @@ createProjectTest pkgIx srcDb = testGroup "createProject tests"
               , "y"
               ]
 
-        case (_runPrompt $ createProject silent pkgIx srcDb emptyFlags) inputs of
+        case (_runPrompt $ createProject silent comp pkgIx srcDb emptyFlags) inputs of
           Right (ProjectSettings opts desc Nothing (Just exe) Nothing, _) -> do
             _optOverwrite  opts @?= False
             _optMinimal    opts @?= False