Port hie changes in install script of pull #1665

install/src/Cabal.hs

@@ -1,27 +1,19 @@
 {-# LANGUAGE CPP #-}
-
 module Cabal where
 
 import           Development.Shake
-import           Development.Shake.Command
 import           Development.Shake.FilePath
 import           Control.Monad
-import           Data.Maybe                               ( isNothing
-                                                          , isJust
-                                                          )
-import           Control.Monad.Extra                      ( whenMaybe )
-import           System.Directory                         ( findExecutable
-                                                          , copyFile
-                                                          )
+import           System.Directory                         ( copyFile )
 
 import           Version
 import           Print
 import           Env
-import           Data.Functor.Identity
 #if RUN_FROM_STACK
 import           Control.Exception                        ( throwIO )
 #else
 import           Cabal.Config
+import           Data.Functor.Identity
 #endif
 
 getInstallDir :: IO FilePath
@@ -38,10 +30,10 @@ execCabal = command [] "cabal"
 execCabal_ :: [String] -> Action ()
 execCabal_ = execCabal
 
-cabalBuildData :: Action ()
-cabalBuildData = do
-  execCabal_ ["v2-build", "hoogle"]
-  execCabal_ ["v2-exec", "hoogle", "generate"]
+cabalBuildData :: [String] -> Action ()
+cabalBuildData args = do
+  execCabal_ $ ["v2-build", "hoogle"] ++ args
+  execCabal_ $ ["v2-exec", "hoogle", "generate"] ++ args
 
 getGhcPathOfOrThrowError :: VersionNumber -> Action GhcPath
 getGhcPathOfOrThrowError versionNumber =
@@ -51,17 +43,20 @@ getGhcPathOfOrThrowError versionNumber =
       error (ghcVersionNotFoundFailMsg versionNumber)
     Just p -> return p
 
-cabalInstallHie :: VersionNumber -> Action ()
-cabalInstallHie versionNumber = do
+cabalInstallHie :: VersionNumber -> [String] -> Action ()
+cabalInstallHie versionNumber args = do
   localBin <- liftIO $ getInstallDir
-  cabalVersion <- getCabalVersion
+  cabalVersion <- getCabalVersion args
   ghcPath <- getGhcPathOfOrThrowError versionNumber
 
   let isCabal3 = checkVersion [3,0,0,0] cabalVersion
       installDirOpt | isCabal3 = "--installdir"
                     | otherwise = "--symlink-bindir"
       installMethod | isWindowsSystem && isCabal3 = ["--install-method=copy"]
                     | otherwise = []
+
+  projectFile <- getProjectFile versionNumber
+
   execCabal_ $
     [ "v2-install"
     , "exe:haskell-language-server"
@@ -71,8 +66,10 @@ cabalInstallHie versionNumber = do
     , installDirOpt, localBin
     , "--max-backjumps=5000"
     , "--overwrite-policy=always"
+    , "--project-file=" ++ projectFile
     ]
     ++ installMethod
+    ++ args
 
   let minorVerExe = "haskell-language-server-" ++ versionNumber <.> exe
       majorVerExe = "haskell-language-server-" ++ dropExtension versionNumber <.> exe
@@ -88,20 +85,27 @@ cabalInstallHie versionNumber = do
              ++ minorVerExe
              ++ " to " ++ localBin
 
-checkCabal_ :: Action ()
-checkCabal_ = checkCabal >> return ()
+getProjectFile :: VersionNumber -> Action FilePath
+getProjectFile ver = do
+  existFile <- doesFileExist $ "cabal.project-" ++ ver
+  return $ if existFile
+            then "cabal.project-" ++ ver
+            else "cabal.project"
+
+checkCabal_ :: [String] -> Action ()
+checkCabal_ args = checkCabal args >> return ()
 
 -- | check `cabal` has the required version
-checkCabal :: Action String
-checkCabal = do
-  cabalVersion <- getCabalVersion
+checkCabal :: [String] -> Action String
+checkCabal args = do
+  cabalVersion <- getCabalVersion args
   unless (checkVersion requiredCabalVersion cabalVersion) $ do
     printInStars $ cabalInstallIsOldFailMsg cabalVersion
     error $ cabalInstallIsOldFailMsg cabalVersion
   return cabalVersion
 
-getCabalVersion :: Action String
-getCabalVersion = trimmedStdout <$> execCabal ["--numeric-version"]
+getCabalVersion :: [String] -> Action String
+getCabalVersion args = trimmedStdout <$> (execCabal $ ["--numeric-version"] ++ args)
 
 -- | Error message when the `cabal` binary is an older version
 cabalInstallIsOldFailMsg :: String -> String
@@ -120,3 +124,21 @@ requiredCabalVersion | isWindowsSystem = requiredCabalVersionForWindows
 
 requiredCabalVersionForWindows :: RequiredVersion
 requiredCabalVersionForWindows = [3, 0, 0, 0]
+
+getVerbosityArg :: Verbosity -> String
+getVerbosityArg v = "-v" ++ cabalVerbosity
+  where cabalVerbosity = case v of
+          Silent ->     "0"
+#if MIN_VERSION_shake(0,18,4)
+          Error ->      "0"
+          Warn ->       "1"
+          Info ->       "1"
+          Verbose ->    "2"
+#else
+          Quiet ->      "0"
+          Normal ->     "1"
+          Loud ->       "2"
+          Chatty ->     "2"
+#endif
+          Diagnostic -> "3"
+

install/src/Env.hs

@@ -1,15 +1,11 @@
 module Env where
 
 import           Development.Shake
-import           Development.Shake.Command
 import           Control.Monad.IO.Class
 import           Control.Monad
 import           Development.Shake.FilePath
-import           System.Info                              ( os
-                                                          , arch
-                                                          )
+import           System.Info                              ( os )
 import           Data.Maybe                               ( isJust
-                                                          , isNothing
                                                           , mapMaybe
                                                           )
 import           System.Directory                         ( findExecutable

install/src/Help.hs

@@ -2,21 +2,18 @@
 module Help where
 
 import           Development.Shake
-import           Data.List                                ( intersperse
-                                                          , intercalate
-                                                          )
+import           Data.List                                ( intercalate )
 
 import           Env
 import           Print
 import           Version
 import           BuildSystem
-import           Cabal
 
 stackCommand :: TargetDescription -> String
-stackCommand target = "stack install.hs " ++ fst target
+stackCommand target = "stack install.hs " ++ fst target ++ " [options]"
 
 cabalCommand :: TargetDescription -> String
-cabalCommand target = "cabal v2-run install.hs --project-file install/shake.project " ++ fst target
+cabalCommand target = "cabal v2-run install.hs --project-file install/shake.project -- " ++ fst target ++ " [options]"
 
 buildCommand :: TargetDescription -> String
 buildCommand | isRunFromCabal = cabalCommand
@@ -37,7 +34,7 @@ shortHelpMessage = do
   printUsage
   printLine ""
   printLine "Targets:"
-  mapM_ (printLineIndented . showTarget (spaces hieVersions)) (targets hieVersions)
+  mapM_ (printLineIndented . showHelpItem (spaces hieVersions)) (targets hieVersions)
   printLine ""
  where
   spaces hieVersions = space (targets hieVersions)
@@ -68,7 +65,10 @@ helpMessage versions@BuildableVersions {..} = do
   printUsage
   printLine ""
   printLine "Targets:"
-  mapM_ (printLineIndented . showTarget spaces) targets
+  mapM_ (printLineIndented . showHelpItem spaces) targets
+  printLine ""
+  printLine "Options:"
+  mapM_ (printLineIndented . showHelpItem spaces) options
   printLine ""
  where
   spaces = space targets
@@ -81,6 +81,10 @@ helpMessage versions@BuildableVersions {..} = do
     , if isRunFromCabal then [cabalGhcsTarget] else [stackDevTarget]
     , [macosIcuTarget]
     ]
+  options = [ ("-s, --silent", "Don't print anything.")
+            , ("-q, --quiet", "Print less (pass repeatedly for even less).")
+            , ("-V, --verbose", "Print more (pass repeatedly for even more).")
+            ]
 
   -- All targets with their respective help message.
   generalTargets = [helpTarget]
@@ -97,10 +101,10 @@ templateTarget = ("<target>", "")
 
 hieTarget :: String -> TargetDescription
 hieTarget version =
-  ("haskell-language-server-" ++ version, "Install haskell-language-server for GHC version " ++ version)
+  ("hls-" ++ version, "Install haskell-language-server for GHC version " ++ version)
 
 buildTarget :: TargetDescription
-buildTarget = ("haskell-language-server", "Install haskell-language-server with the latest available GHC and the data files")
+buildTarget = ("hls", "Install haskell-language-server with the latest available GHC and the data files")
 
 buildLatestTarget :: TargetDescription
 buildLatestTarget = ("latest", "Install haskell-language-server with the latest available GHC")

install/src/HieInstall.hs

@@ -1,43 +1,13 @@
 module HieInstall where
 
 import           Development.Shake
-import           Development.Shake.Command
-import           Development.Shake.FilePath
 import           Control.Monad
-import           Control.Monad.IO.Class
-import           Control.Monad.Extra                      ( unlessM
-                                                          , mapMaybeM
-                                                          )
-import           Data.Maybe                               ( isJust )
-import           System.Directory                         ( listDirectory )
 import           System.Environment                       ( unsetEnv )
-import           System.Info                              ( os
-                                                          , arch
-                                                          )
-
-import           Data.Maybe                               ( isNothing
-                                                          , mapMaybe
-                                                          )
-import           Data.List                                ( dropWhileEnd
-                                                          , intersperse
-                                                          , intercalate
-                                                          , sort
-                                                          , sortOn
-                                                          )
-import qualified Data.Text                     as T
-import           Data.Char                                ( isSpace )
-import           Data.Version                             ( parseVersion
-                                                          , makeVersion
-                                                          , showVersion
-                                                          )
-import           Data.Function                            ( (&) )
-import           Text.ParserCombinators.ReadP             ( readP_to_S )
 
 import           BuildSystem
 import           Stack
 import           Cabal
 import           Version
-import           Print
 import           Env
 import           Help
 
@@ -60,36 +30,54 @@ defaultMain = do
   let latestVersion = last versions
 
   shakeArgs shakeOptions { shakeFiles = "_build" } $ do
+
+    shakeOptionsRules <- getShakeOptionsRules
+
+    let verbosityArg = if isRunFromStack then Stack.getVerbosityArg else Cabal.getVerbosityArg
+
+    let args = [verbosityArg (shakeVerbosity shakeOptionsRules)]
+
+    phony "show-options" $ do
+      putNormal $ "Options:"
+      putNormal $ "    Verbosity level: " ++ show (shakeVerbosity shakeOptionsRules)
+
     want ["short-help"]
     -- general purpose targets
     phony "submodules"  updateSubmodules
     phony "short-help"  shortHelpMessage
     phony "help"        (helpMessage toolsVersions)
 
-    phony "check" (if isRunFromStack then checkStack else checkCabal_)
+    phony "check" (if isRunFromStack then checkStack args else checkCabal_ args)
 
     phony "data" $ do
+      need ["show-options"]
       need ["submodules"]
       need ["check"]
-      if isRunFromStack then stackBuildData else cabalBuildData
+      if isRunFromStack then stackBuildData args else cabalBuildData args
 
     forM_
       versions
-      (\version -> phony ("haskell-language-server-" ++ version) $ do
+      (\version -> phony ("hls-" ++ version) $ do
+        need ["show-options"]
         need ["submodules"]
         need ["check"]
-        if isRunFromStack then do
-          stackInstallHieWithErrMsg (Just version)
+        if isRunFromStack then
+          stackInstallHieWithErrMsg (Just version) args
         else
-          cabalInstallHie version
+          cabalInstallHie version args
       )
 
-    phony "latest" (need ["haskell-language-server-" ++ latestVersion])
-    phony "haskell-language-server"  (need ["data", "latest"])
+    unless (null versions) $ do
+      phony "latest" (need ["hls-" ++ latestVersion])
+      phony "hls"  (need ["data", "latest"])
 
     -- stack specific targets
-    when isRunFromStack $
-      phony "dev" $ stackInstallHieWithErrMsg Nothing
+    -- Default `stack.yaml` uses ghc-8.8.2 and we can't build hie in windows
+    -- TODO: Enable for windows when it uses ghc-8.8.3
+    when (isRunFromStack && not isWindowsSystem) $
+      phony "dev" $ do
+        need ["show-options"]
+        stackInstallHieWithErrMsg Nothing args
 
     -- cabal specific targets
     when isRunFromCabal $ do
@@ -98,20 +86,23 @@ defaultMain = do
       phony "ghcs" $ showInstalledGhcs ghcPaths
 
     -- macos specific targets
-    phony "icu-macos-fix"
-          (need ["icu-macos-fix-install"] >> need ["icu-macos-fix-build"])
+    phony "icu-macos-fix" $ do
+      need ["show-options"]
+      need ["icu-macos-fix-install"]
+      need ["icu-macos-fix-build"]
+
     phony "icu-macos-fix-install" (command_ [] "brew" ["install", "icu4c"])
-    phony "icu-macos-fix-build" $ mapM_ buildIcuMacosFix versions
+    phony "icu-macos-fix-build" $ mapM_ (flip buildIcuMacosFix $ args) versions
 
 
-buildIcuMacosFix :: VersionNumber -> Action ()
-buildIcuMacosFix version = execStackWithGhc_
-  version
+buildIcuMacosFix :: VersionNumber -> [String] -> Action ()
+buildIcuMacosFix version args = execStackWithGhc_
+  version $
   [ "build"
   , "text-icu"
   , "--extra-lib-dirs=/usr/local/opt/icu4c/lib"
   , "--extra-include-dirs=/usr/local/opt/icu4c/include"
-  ]
+  ] ++ args
 
 -- | update the submodules that the project is in the state as required by the `stack.yaml` files
 updateSubmodules :: Action ()

install/src/Print.hs

@@ -1,10 +1,8 @@
 module Print where
 
 import           Development.Shake
-import           Development.Shake.Command
 import           Control.Monad.IO.Class
 import           Data.List                                ( dropWhileEnd
-                                                          , dropWhile
                                                           )
 import           Data.Char                                ( isSpace )
 
@@ -37,11 +35,11 @@ type TargetDescription = (String, String)
 
 -- | Number of spaces the target name including whitespace should have.
 -- At least twenty, maybe more if target names are long. At most the length of the longest target plus five.
-space :: [TargetDescription] -> Int
-space phonyTargets = maximum (20 : map ((+ 5) . length . fst) phonyTargets)
+space :: [(String,String)] -> Int
+space helpItems = maximum (20 : map ((+ 5) . length . fst) helpItems)
 
 -- | Show a target.
 -- Concatenates the target with its help message and inserts whitespace between them.
-showTarget :: Int -> TargetDescription -> String
-showTarget spaces (target, msg) =
-  target ++ replicate (spaces - length target) ' ' ++ msg
+showHelpItem :: Int -> (String,String) -> String
+showHelpItem spaces (helpItemKey, msg) =
+  helpItemKey ++ replicate (spaces - length helpItemKey) ' ' ++ msg