WIP

.gitlab-ci.yml

@@ -182,12 +182,12 @@ variables:
     - export HOMEBREW_CHANGE_ARCH_TO_ARM=1
 
     # make sure to not pollute the machine with temp files etc
-    - mkdir -p $CI_PROJECT_DIR/.brew_cache
-    - export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
-    - mkdir -p $CI_PROJECT_DIR/.brew_logs
-    - export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
-    - mkdir -p $CI_PROJECT_DIR/.brew_tmp
-    - export HOMEBREW_TEMP=$CI_PROJECT_DIR/.brew_tmp
+    - mkdir -p $CI_PROJECT_DIR/.bc
+    - export HOMEBREW_CACHE=$CI_PROJECT_DIR/.bc
+    - mkdir -p $CI_PROJECT_DIR/.bl
+    - export HOMEBREW_LOGS=$CI_PROJECT_DIR/.bl
+    - mkdir -p $CI_PROJECT_DIR/.bt
+    - export HOMEBREW_TEMP=$CI_PROJECT_DIR/.bt
 
     # update and install packages
     - brew update
@@ -541,12 +541,12 @@ release:darwin:aarch64:
     - export HOMEBREW_CHANGE_ARCH_TO_ARM=1
 
     # make sure to not pollute the machine with temp files etc
-    - mkdir -p $CI_PROJECT_DIR/.brew_cache
-    - export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
-    - mkdir -p $CI_PROJECT_DIR/.brew_logs
-    - export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
-    - mkdir -p $CI_PROJECT_DIR/.brew_tmp
-    - export HOMEBREW_TEMP=$CI_PROJECT_DIR/.brew_tmp
+    - mkdir -p $CI_PROJECT_DIR/.bc
+    - export HOMEBREW_CACHE=$CI_PROJECT_DIR/.bc
+    - mkdir -p $CI_PROJECT_DIR/.bl
+    - export HOMEBREW_LOGS=$CI_PROJECT_DIR/.bl
+    - mkdir -p $CI_PROJECT_DIR/.bt
+    - export HOMEBREW_TEMP=$CI_PROJECT_DIR/.bt
 
     # update and install packages
     - brew update

app/ghcup/BrickMain.hs

@@ -13,9 +13,9 @@ import           GHCup.Errors
 import           GHCup.Types.Optics ( getDirs )
 import           GHCup.Types         hiding ( LeanAppState(..) )
 import           GHCup.Utils
-import           GHCup.Utils.Logger
-import           GHCup.Utils.Prelude ( decUTF8Safe )
-import           GHCup.Utils.File
+import           GHCup.Logger
+import           GHCup.Prelude ( decUTF8Safe )
+import           GHCup.System.Process
 
 import           Brick
 import           Brick.Widgets.Border

app/ghcup/GHCup/OptParse/ChangeLog.hs

@@ -12,9 +12,9 @@ module GHCup.OptParse.ChangeLog where
 
 
 import           GHCup.Types
-import           GHCup.Utils.Logger
+import           GHCup.Logger
 import           GHCup.OptParse.Common
-import           GHCup.Utils.String.QQ
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -34,8 +34,8 @@ import GHCup.Types.Optics
 import GHCup.Utils
 import Data.Versions
 import URI.ByteString (serializeURIRef')
-import GHCup.Utils.Prelude
-import GHCup.Utils.File (exec)
+import GHCup.Prelude
+import GHCup.System.Process (exec)
 import Data.Char (toLower)
 
 

app/ghcup/GHCup/OptParse/Common.hs

@@ -14,9 +14,9 @@ import           GHCup.Platform
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
-import           GHCup.Utils.Logger
-import           GHCup.Utils.MegaParsec
-import           GHCup.Utils.Prelude
+import           GHCup.Logger
+import           GHCup.MegaParsec
+import           GHCup.Prelude
 
 import           Control.Exception.Safe
 #if !MIN_VERSION_base(4,13,0)
@@ -89,18 +89,6 @@ toolVersionArgument criteria tool =
   mv _          = "VERSION|TAG"
 
 
-toolVersionOption :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
-toolVersionOption criteria tool =
-  option (eitherReader toolVersionEither)
-    (  sh tool
-    <> completer (tagCompleter (fromMaybe GHC tool) [])
-    <> foldMap (completer . versionCompleter criteria) tool)
- where
-  sh (Just GHC) = long "ghc" <> metavar "GHC_VERSION|TAG"
-  sh (Just HLS) = long "hls" <> metavar "HLS_VERSION|TAG"
-  sh _          = long "version" <> metavar "VERSION|TAG"
-
-
 versionParser :: Parser GHCTargetVersion
 versionParser = option
   (eitherReader tVersionEither)
@@ -208,8 +196,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
     ]
 
 
-uriParser :: String -> Either String URI
-uriParser = first show . parseURI strictURIParserOptions . UTF8.fromString
+bindistParser :: String -> Either String URI
+bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
 
 
 absolutePathParser :: FilePath -> Either String FilePath
@@ -258,6 +246,18 @@ criteriaParser s' | t == T.pack "installed" = Right ListInstalled
   where t = T.toLower (T.pack s')
 
 
+toolVersionParser :: Parser ToolVersion
+toolVersionParser = verP' <|> toolP
+ where
+  verP' = ToolVersion <$> versionParser
+  toolP =
+    ToolTag
+      <$> option
+            (eitherReader tagEither)
+            (short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
+
+
+
 
 keepOnParser :: String -> Either String KeepDirs
 keepOnParser s' | t == T.pack "always" = Right Always

app/ghcup/GHCup/OptParse/Compile.hs

@@ -13,13 +13,13 @@ module GHCup.OptParse.Compile where
 
 import           GHCup
 import           GHCup.Errors
-import           GHCup.Utils.File
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
-import           GHCup.Utils.Logger
+import           GHCup.Logger
 import           GHCup.OptParse.Common
-import           GHCup.Utils.String.QQ
+import           GHCup.QQ.String
+import           GHCup.System.Process
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -40,7 +40,6 @@ import           Prelude                 hiding ( appendFile )
 import           System.Exit
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
-import           URI.ByteString          hiding ( uriParser )
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
 import System.FilePath (isPathSeparator)
@@ -69,7 +68,7 @@ data GHCCompileOptions = GHCCompileOptions
   , bootstrapGhc :: Either Version FilePath
   , jobs         :: Maybe Int
   , buildConfig  :: Maybe FilePath
-  , patches      :: Maybe (Either FilePath [URI])
+  , patchDir     :: Maybe FilePath
   , crossTarget  :: Maybe Text
   , addConfArgs  :: [Text]
   , setCompile   :: Bool
@@ -85,11 +84,10 @@ data HLSCompileOptions = HLSCompileOptions
   , setCompile   :: Bool
   , ovewrwiteVer :: Maybe Version
   , isolateDir   :: Maybe FilePath
-  , cabalProject :: Maybe (Either FilePath URI)
-  , cabalProjectLocal :: Maybe URI
-  , patches      :: Maybe (Either FilePath [URI])
+  , cabalProject :: Maybe FilePath
+  , cabalProjectLocal :: Maybe FilePath
+  , patchDir     :: Maybe FilePath
   , targetGHCs   :: [ToolVersion]
-  , cabalArgs    :: [Text]
   }
 
 
@@ -150,10 +148,7 @@ Examples:
   These need to be available in PATH prior to compilation.
 
 Examples:
-  # compile 1.4.0 for ghc 8.10.5 and 8.10.7
-  ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
-  # compile from master for ghc 8.10.7, linking everything dynamically
-  ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
+  ghcup compile hls -v 1.4.0 -j 12 8.10.5 8.10.7 9.0.1|]
 
 
 ghcCompileOpts :: Parser GHCCompileOptions
@@ -200,23 +195,13 @@ ghcCompileOpts =
               "Absolute path to build config file"
             )
           )
-    <*> (optional
-          (
-            (fmap Right $ many $ option
-              (eitherReader uriParser)
-              (long "patch" <> metavar "PATCH_URI" <> help
-                "URI to a patch (https/http/file)"
-              )
-            )
-            <|>
-            (fmap Left $ option
-              str
-              (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
-                "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
-              )
+    <*> optional
+          (option
+            str
+            (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
+              "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
             )
           )
-        )
     <*> optional
           (option
             str
@@ -311,37 +296,26 @@ hlsCompileOpts =
            )
     <*> optional
           (option
-            ((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
+            str
             (long "cabal-project" <> metavar "CABAL_PROJECT" <> help
-              "If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
+              "If relative, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. If absolute, will copy the file over."
             )
           )
     <*> optional
           (option
-            (eitherReader uriParser)
+            (eitherReader absolutePathParser)
             (long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
-              "URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
+              "Absolute path to a cabal.project.local to be used for the build. Will be copied over."
             )
           )
-    <*> (optional
-          (
-            (fmap Right $ many $ option
-              (eitherReader uriParser)
-              (long "patch" <> metavar "PATCH_URI" <> help
-                "URI to a patch (https/http/file)"
-              )
-            )
-            <|>
-            (fmap Left $ option
-              str
-              (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
-                "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
-              )
+    <*> optional
+          (option
+            (eitherReader absolutePathParser)
+            (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
+              "Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
             )
           )
-        )
-    <*> some (toolVersionOption Nothing (Just GHC))
-    <*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
+    <*> some (toolVersionArgument Nothing (Just GHC))
 
 
 
@@ -456,8 +430,7 @@ compile compileCommand settings runAppState runLogger = do
                     isolateDir
                     cabalProject
                     cabalProjectLocal
-                    patches
-                    cabalArgs
+                    patchDir
         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
         let vi = getVersionInfo targetVer HLS dls
         when setCompile $ void $ liftE $
@@ -504,7 +477,7 @@ compile compileCommand settings runAppState runLogger = do
                     bootstrapGhc
                     jobs
                     buildConfig
-                    patches
+                    patchDir
                     addConfArgs
                     buildFlavour
                     hadrian

app/ghcup/GHCup/OptParse/Config.hs

@@ -14,9 +14,9 @@ module GHCup.OptParse.Config where
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Utils
-import           GHCup.Utils.Prelude
-import           GHCup.Utils.Logger
-import           GHCup.Utils.String.QQ
+import           GHCup.Prelude
+import           GHCup.Logger
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

app/ghcup/GHCup/OptParse/DInfo.hs

@@ -17,9 +17,10 @@ import           GHCup
 import           GHCup.Errors
 import           GHCup.Version
 import           GHCup.Types
-import           GHCup.Utils.Prelude
-import           GHCup.Utils.Dirs
-import           GHCup.Utils.Logger
+import           GHCup.Prelude
+import           GHCup.Directories
+import           GHCup.Logger
+import           GHCup.System.Process
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -36,7 +37,6 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
-import GHCup.Utils.File
 import Language.Haskell.TH
 
 

app/ghcup/GHCup/OptParse/GC.hs

@@ -14,8 +14,8 @@ module GHCup.OptParse.GC where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.Logger
-import           GHCup.Utils.String.QQ
+import           GHCup.Logger
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

app/ghcup/GHCup/OptParse/Install.hs

@@ -17,9 +17,9 @@ import           GHCup.OptParse.Common
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.File
-import           GHCup.Utils.Logger
-import           GHCup.Utils.String.QQ
+import           GHCup.Logger
+import           GHCup.QQ.String
+import           GHCup.System.Process
 
 import           Codec.Archive
 #if !MIN_VERSION_base(4,13,0)
@@ -37,7 +37,7 @@ import           Options.Applicative.Help.Pretty ( text )
 import           Prelude                 hiding ( appendFile )
 import           System.Exit
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
-import           URI.ByteString          hiding ( uriParser )
+import           URI.ByteString
 
 import qualified Data.Text                     as T
 
@@ -187,7 +187,7 @@ installOpts tool =
     <*> (   (   (,)
             <$> optional
                   (option
-                    (eitherReader uriParser)
+                    (eitherReader bindistParser)
                     (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
                       "Install the specified version from this bindist"
                     )

app/ghcup/GHCup/OptParse/List.hs

@@ -11,7 +11,7 @@ module GHCup.OptParse.List where
 
 
 import           GHCup
-import           GHCup.Utils.Prelude
+import           GHCup.Prelude
 import           GHCup.Types
 import           GHCup.OptParse.Common
 

app/ghcup/GHCup/OptParse/Nuke.hs

@@ -14,7 +14,7 @@ module GHCup.OptParse.Nuke where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.Logger
+import           GHCup.Logger
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

app/ghcup/GHCup/OptParse/Prefetch.hs

@@ -14,9 +14,9 @@ module GHCup.OptParse.Prefetch where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.Logger
+import           GHCup.Logger
 import           GHCup.OptParse.Common
-import           GHCup.Utils.String.QQ
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -33,7 +33,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
-import GHCup.Utils.Prelude
+import GHCup.Prelude
 import GHCup.Download (getDownloadsF)
 
 

app/ghcup/GHCup/OptParse/Rm.hs

@@ -18,9 +18,9 @@ import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
-import           GHCup.Utils.Logger
+import           GHCup.Logger
 import           GHCup.OptParse.Common
-import           GHCup.Utils.String.QQ
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

app/ghcup/GHCup/OptParse/Set.hs

@@ -17,8 +17,8 @@ import           GHCup.OptParse.Common
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.Logger
-import           GHCup.Utils.String.QQ
+import           GHCup.Logger
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

app/ghcup/GHCup/OptParse/ToolRequirements.hs

@@ -10,7 +10,7 @@ module GHCup.OptParse.ToolRequirements where
 
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.Logger
+import           GHCup.Logger
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -28,7 +28,7 @@ import qualified Data.Text.IO                  as T
 import Control.Exception.Safe (MonadMask)
 import GHCup.Types.Optics
 import GHCup.Platform
-import GHCup.Utils.Prelude
+import GHCup.Prelude
 import GHCup.Requirements
 import System.IO
 

app/ghcup/GHCup/OptParse/UnSet.hs

@@ -16,8 +16,8 @@ module GHCup.OptParse.UnSet where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.Logger
-import           GHCup.Utils.String.QQ
+import           GHCup.Logger
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

app/ghcup/GHCup/OptParse/Upgrade.hs

@@ -14,7 +14,7 @@ module GHCup.OptParse.Upgrade where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Utils.Logger
+import           GHCup.Logger
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

app/ghcup/GHCup/OptParse/Whereis.hs

@@ -17,8 +17,8 @@ import           GHCup
 import           GHCup.Errors
 import           GHCup.OptParse.Common
 import           GHCup.Types
-import           GHCup.Utils.Logger
-import           GHCup.Utils.String.QQ
+import           GHCup.Logger
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

app/ghcup/Main.hs

@@ -21,9 +21,9 @@ import           GHCup.Errors
 import           GHCup.Platform
 import           GHCup.Types
 import           GHCup.Utils
-import           GHCup.Utils.Logger
-import           GHCup.Utils.Prelude
-import           GHCup.Utils.String.QQ
+import           GHCup.Logger
+import           GHCup.Prelude
+import           GHCup.QQ.String
 import           GHCup.Version
 
 import           Cabal.Plan ( findPlanJson, SearchPlanJson(..) )

cabal.project

@@ -12,6 +12,11 @@ constraints: http-io-streams -brotli,
              any.Cabal ==3.6.2.0,
              any.aeson >= 2.0.1.0
 
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/optparse-applicative
+  tag: 7497a29cb998721a9068d5725d49461f2bba0e7a
+
 package libarchive
   flags: -system-libarchive
 

ghcup.cabal

@@ -51,8 +51,16 @@ flag no-exe
 library
   exposed-modules:
     GHCup
+    GHCup.Data.Versions
+    GHCup.GHC
+    GHCup.GHC.Rm
+    GHCup.GHC.Unset
+    GHCup.GHC.Set
+    GHCup.GHC.Compile
+    GHCup.GHC.Common
+    GHCup.GHC.Install
     GHCup.Download
-    GHCup.Download.Utils
+    GHCup.Download.Common
     GHCup.Errors
     GHCup.Platform
     GHCup.Requirements
@@ -60,14 +68,16 @@ library
     GHCup.Types.JSON
     GHCup.Types.Optics
     GHCup.Utils
-    GHCup.Utils.Dirs
-    GHCup.Utils.File
-    GHCup.Utils.File.Common
-    GHCup.Utils.Logger
-    GHCup.Utils.MegaParsec
-    GHCup.Utils.Prelude
-    GHCup.Utils.String.QQ
-    GHCup.Utils.Version.QQ
+    GHCup.Directories
+    GHCup.System.Process
+    GHCup.System.Directory
+    GHCup.System.Process.Common
+    GHCup.System.Console
+    GHCup.Logger
+    GHCup.MegaParsec
+    GHCup.Prelude
+    GHCup.QQ.String
+    GHCup.QQ.Version
     GHCup.Version
 
   hs-source-dirs:     lib
@@ -110,7 +120,7 @@ library
     , disk-free-space       ^>=0.1.0.1
     , filepath              ^>=1.4.2.1
     , haskus-utils-types    ^>=1.5
-    , haskus-utils-variant  ^>=3.2.1
+    , haskus-utils-variant  >=3.0        && <3.2
     , libarchive            ^>=3.0.3.0
     , lzma-static           ^>=5.2.5.3
     , megaparsec            >=8.0.0      && <9.1
@@ -152,9 +162,9 @@ library
   if os(windows)
     cpp-options:   -DIS_WINDOWS
     other-modules:
-      GHCup.Utils.File.Windows
-      GHCup.Utils.Prelude.Windows
-      GHCup.Utils.Windows
+      GHCup.System.Process.Windows
+      GHCup.Prelude.Windows
+      GHCup.System.Console.Windows
 
     build-depends:
       , bzlib
@@ -163,9 +173,9 @@ library
 
   else
     other-modules:
-      GHCup.Utils.File.Posix
-      GHCup.Utils.Posix
-      GHCup.Utils.Prelude.Posix
+      GHCup.System.Process.Posix
+      GHCup.System.Console.Posix
+      GHCup.Prelude.Posix
       System.Console.Terminal.Common
       System.Console.Terminal.Posix
 
@@ -227,11 +237,11 @@ executable ghcup
     , directory             ^>=1.3.6.0
     , filepath              ^>=1.4.2.1
     , ghcup
-    , haskus-utils-variant  ^>=3.2.1
+    , haskus-utils-variant  >=3.0      && <3.2
     , libarchive            ^>=3.0.3.0
     , megaparsec            >=8.0.0    && <9.1
     , mtl                   ^>=2.2
-    , optparse-applicative  >=0.15.1.0 && <0.17
+    , optparse-applicative-fork  >=0.15.1.0 && <0.17
     , pretty                ^>=1.1.3.1
     , pretty-terminal       ^>=0.1.0.0
     , resourcet             ^>=1.2.2

lib/GHCup/Directories.hs

@@ -5,7 +5,7 @@
 {-# LANGUAGE ViewPatterns          #-}
 
 {-|
-Module      : GHCup.Utils.Dirs
+Module      : GHCup.Directories
 Description : Definition of GHCup directories
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
@@ -13,7 +13,7 @@ Maintainer  : hasufell@hasufell.de
 Stability   : experimental
 Portability : portable
 -}
-module GHCup.Utils.Dirs
+module GHCup.Directories
   ( getAllDirs
   , ghcupBaseDir
   , ghcupConfigFile
@@ -35,9 +35,9 @@ import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.JSON               ( )
 import           GHCup.Types.Optics
-import           GHCup.Utils.MegaParsec
-import           GHCup.Utils.Logger
-import           GHCup.Utils.Prelude
+import           GHCup.MegaParsec
+import           GHCup.Logger
+import           GHCup.Prelude
 
 import           Control.Exception.Safe
 import           Control.Monad

lib/GHCup/Download.hs

@@ -27,16 +27,16 @@ module GHCup.Download where
 
 #if defined(INTERNAL_DOWNLOADER)
 import           GHCup.Download.IOStreams
-import           GHCup.Download.Utils
+import           GHCup.Download.Common
 #endif
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.Dirs
-import           GHCup.Utils.File
-import           GHCup.Utils.Logger
-import           GHCup.Utils.Prelude
+import           GHCup.Directories
+import           GHCup.System.Process
+import           GHCup.Logger
+import           GHCup.Prelude
 import           GHCup.Version
 
 import           Control.Applicative

lib/GHCup/Download/Common.hs

@@ -4,13 +4,13 @@
 {-# LANGUAGE TypeFamilies          #-}
 
 
-module GHCup.Download.Utils where
+module GHCup.Download.Common where
 
 
 import           GHCup.Errors
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.Prelude
+import           GHCup.Prelude
 
 import           Control.Applicative
 import           Control.Monad

lib/GHCup/Download/IOStreams.hs

@@ -7,10 +7,10 @@
 module GHCup.Download.IOStreams where
 
 
-import           GHCup.Download.Utils
+import           GHCup.Download.Common
 import           GHCup.Errors
 import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.Prelude
+import           GHCup.Prelude
 
 import           Control.Applicative
 import           Control.Exception.Safe

lib/GHCup/Logger.hs

@@ -4,7 +4,7 @@
 {-# LANGUAGE OverloadedStrings   #-}
 
 {-|
-Module      : GHCup.Utils.Logger
+Module      : GHCup.Logger
 Description : logger definition
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
@@ -14,12 +14,12 @@ Portability : portable
 
 Here we define our main logger.
 -}
-module GHCup.Utils.Logger where
+module GHCup.Logger where
 
 import           GHCup.Types
 import           GHCup.Types.Optics
-import {-# SOURCE #-} GHCup.Utils.File.Common
-import           GHCup.Utils.String.QQ
+import {-# SOURCE #-} GHCup.System.Directory
+import           GHCup.QQ.String
 
 import           Control.Exception.Safe
 import           Control.Monad
@@ -34,7 +34,7 @@ import           System.IO.Error
 import           Text.Regex.Posix
 
 import qualified Data.ByteString               as B
-import GHCup.Utils.Prelude
+import GHCup.Prelude
 import qualified Data.Text                     as T
 
 logInfo :: ( MonadReader env m

lib/GHCup/Logger.hs-boot

@@ -3,7 +3,7 @@
 {-# LANGUAGE DataKinds        #-}
 {-# LANGUAGE OverloadedStrings   #-}
 
-module GHCup.Utils.Logger where
+module GHCup.Logger where
 
 import           GHCup.Types
 

lib/GHCup/MegaParsec.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings    #-}
 
 {-|
-Module      : GHCup.Utils.MegaParsec
+Module      : GHCup.MegaParsec
 Description : MegaParsec utilities
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
@@ -10,7 +10,7 @@ Maintainer  : hasufell@hasufell.de
 Stability   : experimental
 Portability : portable
 -}
-module GHCup.Utils.MegaParsec where
+module GHCup.MegaParsec where
 
 import           GHCup.Types
 

lib/GHCup/Platform.hs

@@ -23,10 +23,10 @@ import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.File
-import           GHCup.Utils.Logger
-import           GHCup.Utils.Prelude
-import           GHCup.Utils.String.QQ
+import           GHCup.System.Process
+import           GHCup.Logger
+import           GHCup.Prelude
+import           GHCup.QQ.String
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

lib/GHCup/Prelude.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE TypeOperators       #-}
 
 {-|
-Module      : GHCup.Utils.Prelude
+Module      : GHCup.Prelude
 Description : MegaParsec utilities
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
@@ -17,12 +17,12 @@ Portability : portable
 
 GHCup specific prelude. Lots of Excepts functionality.
 -}
-module GHCup.Utils.Prelude
-  (module GHCup.Utils.Prelude,
+module GHCup.Prelude
+  (module GHCup.Prelude,
 #if defined(IS_WINDOWS)
-   module GHCup.Utils.Prelude.Windows
+   module GHCup.Prelude.Windows
 #else
-   module GHCup.Utils.Prelude.Posix
+   module GHCup.Prelude.Posix
 #endif
   )
 where
@@ -30,11 +30,11 @@ where
 import           GHCup.Types
 import           GHCup.Errors
 import           GHCup.Types.Optics
-import {-# SOURCE #-} GHCup.Utils.Logger
+import {-# SOURCE #-} GHCup.Logger
 #if defined(IS_WINDOWS)
-import           GHCup.Utils.Prelude.Windows
+import           GHCup.Prelude.Windows
 #else
-import           GHCup.Utils.Prelude.Posix
+import           GHCup.Prelude.Posix
 #endif
 
 import           Control.Applicative

lib/GHCup/Prelude/Posix.hs

@@ -1,4 +1,4 @@
-module GHCup.Utils.Prelude.Posix where
+module GHCup.Prelude.Posix where
 
 import System.Directory
 import System.Posix.Files

lib/GHCup/Prelude/Windows.hs

@@ -1,4 +1,4 @@
-module GHCup.Utils.Prelude.Windows where
+module GHCup.Prelude.Windows where
 
 import qualified System.Win32.File             as Win32
 

lib/GHCup/QQ/String.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 
 {-|
-Module      : GHCup.Utils.String.QQ
+Module      : GHCup.QQ.String
 Description : String quasi quoters
 Copyright   : (c) Audrey Tang <audreyt@audreyt.org> 2019, Julian Ospald <hasufell@posteo.de> 2020
 License     : LGPL-3.0
@@ -30,7 +30,7 @@ Any instance of the IsString type is permitted.
 (For GHC versions 6, write "[$s||]" instead of "[s||]".)
 
 -}
-module GHCup.Utils.String.QQ
+module GHCup.QQ.String
   ( s
   )
 where

lib/GHCup/QQ/Version.hs

@@ -8,7 +8,7 @@
 
 
 {-|
-Module      : GHCup.Utils.Version.QQ
+Module      : GHCup.QQ.Version
 Description : Version quasi-quoters
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
@@ -16,7 +16,7 @@ Maintainer  : hasufell@hasufell.de
 Stability   : experimental
 Portability : portable
 -}
-module GHCup.Utils.Version.QQ where
+module GHCup.QQ.Version where
 
 import           Data.Data
 import           Data.Text                      ( Text )

lib/GHCup/System/Console.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE CPP #-}
+
+module GHCup.System.Console (
+#if IS_WINDOWS
+  module GHCup.System.Console.Windows
+#else
+  module GHCup.System.Console.Posix
+#endif
+) where
+
+
+#if IS_WINDOWS
+import GHCup.System.Console.Windows
+#else
+import GHCup.System.Console.Posix
+#endif

lib/GHCup/System/Console/Posix.hs

@@ -1,4 +1,4 @@
-module GHCup.Utils.Posix where
+module GHCup.System.Console.Posix where
 
 
 -- | Enables ANSI support on windows, does nothing on unix.

lib/GHCup/System/Console/Windows.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE OverloadedStrings     #-}
 
-module GHCup.Utils.Windows where
+module GHCup.System.Console.Windows where
 
 
 import           Control.Exception.Safe

lib/GHCup/System/Directory.hs

@@ -3,51 +3,24 @@
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE ViewPatterns      #-}
 
-module GHCup.Utils.File.Common where
+module GHCup.System.Directory where
 
-import           GHCup.Utils.Prelude
+import           GHCup.Prelude
 
 import           Control.Monad.Reader
 import           Data.Maybe
 import           Data.Text               ( Text )
 import           Data.Void
 import           GHC.IO.Exception
-import           Optics                  hiding ((<|), (|>))
 import           System.Directory
 import           System.FilePath
-import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
 
 import qualified Data.Text                     as T
-import qualified Data.ByteString.Lazy          as BL
 import qualified Text.Megaparsec               as MP
 
 
 
-data ProcessError = NonZeroExit Int FilePath [String]
-                  | PTerminated FilePath [String]
-                  | PStopped FilePath [String]
-                  | NoSuchPid FilePath [String]
-                  deriving Show
-
-instance Pretty ProcessError where
-  pPrint (NonZeroExit e exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
-  pPrint (PTerminated exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
-  pPrint (PStopped exe args) =
-    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
-  pPrint (NoSuchPid exe args) =
-    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
-
-data CapturedProcess = CapturedProcess
-  { _exitCode :: ExitCode
-  , _stdOut   :: BL.ByteString
-  , _stdErr   :: BL.ByteString
-  }
-  deriving (Eq, Show)
-
-makeLenses ''CapturedProcess
 
 
 

lib/GHCup/System/Directory.hs-boot

@@ -1,4 +1,4 @@
-module GHCup.Utils.File.Common where
+module GHCup.System.Directory where
 
 import           Text.Regex.Posix
 

lib/GHCup/System/Process.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE CPP #-}
+
+module GHCup.System.Process (
+  module GHCup.System.Process.Common,
+#if IS_WINDOWS
+  module GHCup.System.Process.Windows
+#else
+  module GHCup.System.Process.Posix
+#endif
+) where
+
+
+#if IS_WINDOWS
+import GHCup.System.Process.Windows
+#else
+import GHCup.System.Process.Posix
+#endif
+
+import GHCup.System.Process.Common

lib/GHCup/System/Process/Common.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE TemplateHaskell  #-}
+
+module GHCup.System.Process.Common where
+
+
+import           GHC.IO.Exception
+import           Optics                  hiding ((<|), (|>))
+import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
+
+import qualified Data.ByteString.Lazy          as BL
+
+
+
+data ProcessError = NonZeroExit Int FilePath [String]
+                  | PTerminated FilePath [String]
+                  | PStopped FilePath [String]
+                  | NoSuchPid FilePath [String]
+                  deriving Show
+
+instance Pretty ProcessError where
+  pPrint (NonZeroExit e exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "failed with exit code" <+> text (show e <> ".")
+  pPrint (PTerminated exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "terminated."
+  pPrint (PStopped exe args) =
+    text "Process" <+> pPrint exe <+> text "with arguments" <+> pPrint args <+> text "stopped."
+  pPrint (NoSuchPid exe args) =
+    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
+
+data CapturedProcess = CapturedProcess
+  { _exitCode :: ExitCode
+  , _stdOut   :: BL.ByteString
+  , _stdErr   :: BL.ByteString
+  }
+  deriving (Eq, Show)
+
+makeLenses ''CapturedProcess

lib/GHCup/System/Process/Posix.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE FlexibleContexts  #-}
 
 {-|
-Module      : GHCup.Utils.File.Posix
+Module      : GHCup.System.Process.Posix
 Description : File and unix APIs
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
@@ -13,13 +13,13 @@ Portability : POSIX
 This module handles file and executable handling.
 Some of these functions use sophisticated logging.
 -}
-module GHCup.Utils.File.Posix where
+module GHCup.System.Process.Posix where
 
-import           GHCup.Utils.File.Common
-import           GHCup.Utils.Prelude
-import           GHCup.Utils.Logger
+import           GHCup.Prelude
+import           GHCup.Logger
 import           GHCup.Types
 import           GHCup.Types.Optics
+import           GHCup.System.Process.Common
 
 import           Control.Concurrent
 import           Control.Concurrent.Async
@@ -73,7 +73,6 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
 
 execLogged :: ( MonadReader env m
               , HasSettings env
-              , HasLog env
               , HasDirs env
               , MonadIO m
               , MonadThrow m)
@@ -86,7 +85,6 @@ execLogged :: ( MonadReader env m
 execLogged exe args chdir lfile env = do
   Settings {..} <- getSettings
   Dirs {..} <- getDirs
-  logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
   let logfile = logsDir </> lfile <> ".log"
   liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
                    closeFd

lib/GHCup/System/Process/Windows.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE FlexibleContexts  #-}
 
 {-|
-Module      : GHCup.Utils.File.Windows
+Module      : GHCup.System.Process.Windows
 Description : File and windows APIs
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
@@ -13,14 +13,14 @@ Portability : Windows
 This module handles file and executable handling.
 Some of these functions use sophisticated logging.
 -}
-module GHCup.Utils.File.Windows where
+module GHCup.System.Process.Windows where
 
 import {-# SOURCE #-} GHCup.Utils ( getLinkTarget, pathIsLink )
-import           GHCup.Utils.Dirs
-import           GHCup.Utils.File.Common
-import           GHCup.Utils.Logger
+import           GHCup.Directories
 import           GHCup.Types
 import           GHCup.Types.Optics
+import           GHCup.System.Directory
+import           GHCup.System.Process.Common
 
 import           Control.Concurrent
 import           Control.DeepSeq
@@ -41,7 +41,6 @@ import qualified Control.Exception             as EX
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Map.Strict               as Map
-import qualified Data.Text                     as T
 
 
 
@@ -151,7 +150,6 @@ executeOut path args chdir = do
 
 execLogged :: ( MonadReader env m
               , HasDirs env
-              , HasLog env
               , HasSettings env
               , MonadIO m
               , MonadThrow m)
@@ -163,7 +161,6 @@ execLogged :: ( MonadReader env m
            -> m (Either ProcessError ())
 execLogged exe args chdir lfile env = do
   Dirs {..} <- getDirs
-  logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
   let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
       stderrLogfile = logsDir </> lfile <> ".stderr.log"
   cp <- createProcessWithMingwPath ((proc exe args)

lib/GHCup/Types/JSON.hs

@@ -22,9 +22,9 @@ Portability : portable
 module GHCup.Types.JSON where
 
 import           GHCup.Types
-import           GHCup.Utils.MegaParsec
-import           GHCup.Utils.Prelude
-import           GHCup.Utils.Logger             () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
+import           GHCup.MegaParsec
+import           GHCup.Prelude
+import           GHCup.Logger             () -- TH is broken shite and needs GHCup.Logger for linking, although we don't depend on the file.
                                                    -- This is due to the boot file.
 
 import           Control.Applicative            ( (<|>) )

lib/GHCup/Utils.hs

@@ -20,33 +20,37 @@ This module contains GHCup helpers specific to
 installation and introspection of files/versions etc.
 -}
 module GHCup.Utils
-  ( module GHCup.Utils.Dirs
+  ( module GHCup.Directories
   , module GHCup.Utils
 #if defined(IS_WINDOWS)
-  , module GHCup.Utils.Windows
+  , module GHCup.System.Console.Windows
 #else
-  , module GHCup.Utils.Posix
+  , module GHCup.System.Console.Posix
 #endif
   )
 where
 
 
 #if defined(IS_WINDOWS)
-import GHCup.Utils.Windows
+import GHCup.System.Console.Windows
 #else
-import GHCup.Utils.Posix
+import GHCup.System.Console.Posix
 #endif
+import {-# SOURCE #-} GHCup.GHC.Common
+import {-# SOURCE #-} GHCup.GHC.Set
+import           GHCup.Data.Versions
 import           GHCup.Download
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.Dirs
-import           GHCup.Utils.File
-import           GHCup.Utils.Logger
-import           GHCup.Utils.MegaParsec
-import           GHCup.Utils.Prelude
-import           GHCup.Utils.String.QQ
+import           GHCup.Directories
+import           GHCup.Logger
+import           GHCup.MegaParsec
+import           GHCup.Prelude
+import           GHCup.QQ.String
+import           GHCup.System.Directory
+import           GHCup.System.Process
 
 import           Codec.Archive           hiding ( Directory )
 import           Control.Applicative
@@ -67,7 +71,7 @@ import           Data.List
 import           Data.List.NonEmpty             ( NonEmpty( (:|) ))
 import           Data.Maybe
 import           Data.Text                      ( Text )
-import           Data.Versions         hiding   ( patch )
+import           Data.Versions
 import           GHC.IO.Exception
 import           Haskus.Utils.Variant.Excepts
 import           Optics
@@ -77,6 +81,7 @@ import           System.FilePath
 import           System.IO.Error
 import           Text.Regex.Posix
 import           URI.ByteString
+import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Codec.Compression.BZip        as BZip
 import qualified Codec.Compression.GZip        as GZip
@@ -97,14 +102,14 @@ import qualified Data.List.NonEmpty            as NE
 -- >>> import System.Directory
 -- >>> import URI.ByteString
 -- >>> import qualified Data.Text as T
--- >>> import GHCup.Utils.Prelude
+-- >>> import GHCup.Prelude
 -- >>> import GHCup.Download
 -- >>> import GHCup.Version
 -- >>> import GHCup.Errors
 -- >>> import GHCup.Types
 -- >>> import GHCup.Types.Optics
 -- >>> import Optics
--- >>> import GHCup.Utils.Version.QQ
+-- >>> import GHCup.QQ.Version
 -- >>> import qualified Data.Text.Encoding as E
 -- >>> import Control.Monad.Reader
 -- >>> import Haskus.Utils.Variant.Excepts
@@ -120,161 +125,6 @@ import qualified Data.List.NonEmpty            as NE
 
 
 
-    ------------------------
-    --[ Symlink handling ]--
-    ------------------------
-
-
--- | The symlink destination of a ghc tool.
-ghcLinkDestination :: ( MonadReader env m
-                      , HasDirs env
-                      , MonadThrow m, MonadIO m)
-                   => FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
-                   -> GHCTargetVersion
-                   -> m FilePath
-ghcLinkDestination tool ver = do
-  Dirs {..}  <- getDirs
-  ghcd <- ghcupGHCDir ver
-  pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
-
-
--- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
-rmMinorSymlinks :: ( MonadReader env m
-                   , HasDirs env
-                   , MonadIO m
-                   , HasLog env
-                   , MonadThrow m
-                   , MonadFail m
-                   , MonadMask m
-                   )
-                => GHCTargetVersion
-                -> Excepts '[NotInstalled] m ()
-rmMinorSymlinks tv@GHCTargetVersion{..} = do
-  Dirs {..}  <- lift getDirs
-
-  files                         <- liftE $ ghcToolFiles tv
-  forM_ files $ \f -> do
-    let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
-    let fullF = binDir </> f_xyz
-    lift $ logDebug ("rm -f " <> T.pack fullF)
-    lift $ hideError doesNotExistErrorType $ rmLink fullF
-
-
--- | Removes the set ghc version for the given target, if any.
-rmPlain :: ( MonadReader env m
-           , HasDirs env
-           , HasLog env
-           , MonadThrow m
-           , MonadFail m
-           , MonadIO m
-           , MonadMask m
-           )
-        => Maybe Text -- ^ target
-        -> Excepts '[NotInstalled] m ()
-rmPlain target = do
-  Dirs {..}  <- lift getDirs
-  mtv                           <- lift $ ghcSet target
-  forM_ mtv $ \tv -> do
-    files <- liftE $ ghcToolFiles tv
-    forM_ files $ \f -> do
-      let fullF = binDir </> f <> exeExt
-      lift $ logDebug ("rm -f " <> T.pack fullF)
-      lift $ hideError doesNotExistErrorType $ rmLink fullF
-    -- old ghcup
-    let hdc_file = binDir </> "haddock-ghc" <> exeExt
-    lift $ logDebug ("rm -f " <> T.pack hdc_file)
-    lift $ hideError doesNotExistErrorType $ rmLink hdc_file
-
-
--- | Remove the major GHC symlink, e.g. ghc-8.6.
-rmMajorSymlinks :: ( MonadReader env m
-                   , HasDirs env
-                   , MonadIO m
-                   , HasLog env
-                   , MonadThrow m
-                   , MonadFail m
-                   , MonadMask m
-                   )
-                => GHCTargetVersion
-                -> Excepts '[NotInstalled] m ()
-rmMajorSymlinks tv@GHCTargetVersion{..} = do
-  Dirs {..}  <- lift getDirs
-  (mj, mi) <- getMajorMinorV _tvVersion
-  let v' = intToText mj <> "." <> intToText mi
-
-  files                         <- liftE $ ghcToolFiles tv
-  forM_ files $ \f -> do
-    let f_xy = f <> "-" <> T.unpack v' <> exeExt
-    let fullF = binDir </> f_xy
-    lift $ logDebug ("rm -f " <> T.pack fullF)
-    lift $ hideError doesNotExistErrorType $ rmLink fullF
-
-
-
-
-    -----------------------------------
-    --[ Set/Installed introspection ]--
-    -----------------------------------
-
-
--- | Whether the given GHC versin is installed.
-ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
-ghcInstalled ver = do
-  ghcdir <- ghcupGHCDir ver
-  liftIO $ doesDirectoryExist ghcdir
-
-
--- | Whether the given GHC version is installed from source.
-ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
-ghcSrcInstalled ver = do
-  ghcdir <- ghcupGHCDir ver
-  liftIO $ doesFileExist (ghcdir </> ghcUpSrcBuiltFile)
-
-
--- | Whether the given GHC version is set as the current.
-ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
-       => Maybe Text   -- ^ the target of the GHC version, if any
-                       --  (e.g. armv7-unknown-linux-gnueabihf)
-       -> m (Maybe GHCTargetVersion)
-ghcSet mtarget = do
-  Dirs {..}  <- getDirs
-  let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
-  let ghcBin = binDir </> ghc <> exeExt
-
-  -- link destination is of the form ../ghc/<ver>/bin/ghc
-  -- for old ghcup, it is ../ghc/<ver>/bin/ghc-<ver>
-  liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
-    link <- liftIO $ getLinkTarget ghcBin
-    Just <$> ghcLinkVersion link
- where
-  ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion
-  ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
-   where
-    parser =
-        (do
-           _    <- parseUntil1 ghcSubPath
-           _    <- ghcSubPath
-           r    <- parseUntil1 pathSep
-           rest <- MP.getInput
-           MP.setInput r
-           x <- ghcTargetVerP
-           MP.setInput rest
-           pure x
-         )
-        <* pathSep
-        <* MP.takeRest
-        <* MP.eof
-    ghcSubPath = pathSep <* MP.chunk "ghc" *> pathSep
-
--- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
--- If a dir cannot be parsed, returns left.
-getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
-getInstalledGHCs = do
-  ghcdir <- ghcupGHCBaseDir
-  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory ghcdir
-  forM fs $ \f -> case parseGHCupGHCDir f of
-    Right r -> pure $ Right r
-    Left  _ -> pure $ Left f
 
 
 -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
@@ -588,79 +438,6 @@ hlsSymlinks = do
 
 
 
-    -----------------------------------------
-    --[ Major version introspection (X.Y) ]--
-    -----------------------------------------
-
-
--- | Extract (major, minor) from any version.
-getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
-getMajorMinorV Version {..} = case _vChunks of
-  ((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y)
-  _ -> throwM $ ParseError "Could not parse X.Y from version"
-
-
-matchMajor :: Version -> Int -> Int -> Bool
-matchMajor v' major' minor' = case getMajorMinorV v' of
-  Just (x, y) -> x == major' && y == minor'
-  Nothing     -> False
-
--- | Match PVP prefix.
---
--- >>> matchPVPrefix [pver|8.8|] [pver|8.8.4|]
--- True
--- >>> matchPVPrefix [pver|8|] [pver|8.8.4|]
--- True
--- >>> matchPVPrefix [pver|8.10|] [pver|8.8.4|]
--- False
--- >>> matchPVPrefix [pver|8.10|] [pver|8.10.7|]
--- True
-matchPVPrefix :: PVP -> PVP -> Bool
-matchPVPrefix (toL -> prefix) (toL -> full) = and $ zipWith (==) prefix full
-
-toL :: PVP -> [Int]
-toL (PVP inner) = fmap fromIntegral $ NE.toList inner
-
-
--- | Get the latest installed full GHC version that satisfies the given (possibly partial)
--- PVP version.
-getGHCForPVP :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
-             => PVP
-             -> Maybe Text -- ^ the target triple
-             -> m (Maybe GHCTargetVersion)
-getGHCForPVP pvpIn mt = do
-  ghcs <- rights <$> getInstalledGHCs
-  -- we're permissive here... failed parse just means we have no match anyway
-  let ghcs' = catMaybes $ flip fmap ghcs $ \GHCTargetVersion{..} -> do
-        (pvp_, rest) <- versionToPVP _tvVersion
-        pure (pvp_, rest, _tvTarget)
-
-  getGHCForPVP' pvpIn ghcs' mt
-
--- | Like 'getGHCForPVP', except with explicit input parameter.
---
--- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
--- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}})
--- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
--- "Just 8.8.4"
--- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
--- "Just 8.10.4"
-getGHCForPVP' :: MonadThrow m
-             => PVP
-             -> [(PVP, Text, Maybe Text)] -- ^ installed GHCs
-             -> Maybe Text          -- ^ the target triple
-             -> m (Maybe GHCTargetVersion)
-getGHCForPVP' pvpIn ghcs' mt = do
-  let mResult = lastMay
-                  . sortBy (\(x, _, _) (y, _, _) -> compare x y)
-                  . filter
-                      (\(pvp_, _, target) ->
-                        target == mt && matchPVPrefix pvp_ pvpIn
-                      )
-                  $ ghcs'
-  forM mResult $ \(pvp_, rest, target) -> do
-    ver' <- pvpToVersion pvp_ rest
-    pure (GHCTargetVersion target ver')
 
 
 -- | Get the latest available ghc for the given PVP version, which
@@ -810,39 +587,6 @@ getLatestBaseVersion av pvpVer =
     -------------
 
 
--- | Get tool files from @~\/.ghcup\/bin\/ghc\/\<ver\>\/bin\/\*@
--- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
---
--- Returns unversioned relative files without extension, e.g.:
---
---   - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
-ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
-             => GHCTargetVersion
-             -> Excepts '[NotInstalled] m [FilePath]
-ghcToolFiles ver = do
-  ghcdir <- lift $ ghcupGHCDir ver
-  let bindir = ghcdir </> "bin"
-
-  -- fail if ghc is not installed
-  whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
-        (throwE (NotInstalled GHC ver))
-
-  files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
-  pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
-
- where
-
-  groupToolFiles :: [FilePath] -> [[(FilePath, String)]]
-  groupToolFiles = groupBy (\(a, _) (b, _) -> a == b) . fmap (splitOnPVP "-")
-
-  getUniqueTools :: [[(FilePath, String)]] -> [String]
-  getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . filter ((== "") . snd) . concat
-
-  blackListedTools :: [String]
-  blackListedTools = ["haddock-ghc"]
-
-  isNotAnyInfix :: [String] -> String -> Bool
-  isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
 
 
 -- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
@@ -856,7 +600,6 @@ make :: ( MonadThrow m
         , MonadIO m
         , MonadReader env m
         , HasDirs env
-        , HasLog env
         , HasSettings env
         )
      => [String]
@@ -892,22 +635,15 @@ applyPatches pdir ddir = do
                      execBlank
                      ([s|.+\.(patch|diff)$|] :: ByteString)
       )
-  forM_ (sort patches) $ \patch' -> applyPatch patch' ddir
-
-
-applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
-           => FilePath   -- ^ Patch
-           -> FilePath   -- ^ dir to apply patches in
-           -> Excepts '[PatchFailed] m ()
-applyPatch patch ddir = do
-  lift $ logInfo $ "Applying patch " <> T.pack patch
-  fmap (either (const Nothing) Just)
-       (exec
-         "patch"
-         ["-p1", "-s", "-f", "-i", patch]
-         (Just ddir)
-         Nothing)
-    !? PatchFailed
+  forM_ (sort patches) $ \patch' -> do
+    lift $ logInfo $ "Applying patch " <> T.pack patch'
+    fmap (either (const Nothing) Just)
+         (exec
+           "patch"
+           ["-p1", "-i", patch']
+           (Just ddir)
+           Nothing)
+      !? PatchFailed
 
 
 -- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
@@ -1149,3 +885,33 @@ ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir) = do
 ghcBinaryName :: GHCTargetVersion -> String
 ghcBinaryName (GHCTargetVersion (Just t) v') = T.unpack (t <> "-ghc-" <> prettyVer v' <> T.pack exeExt)
 ghcBinaryName (GHCTargetVersion Nothing  v') = T.unpack ("ghc-" <> prettyVer v' <> T.pack exeExt)
+
+
+
+-- | Warn if the installed and set HLS is not compatible with the installed and
+-- set GHC version.
+warnAboutHlsCompatibility :: ( MonadReader env m
+                             , HasDirs env
+                             , HasLog env
+                             , MonadThrow m
+                             , MonadCatch m
+                             , MonadIO m
+                             )
+                          => m ()
+warnAboutHlsCompatibility = do
+  supportedGHC <- hlsGHCVersions
+  currentGHC   <- fmap _tvVersion <$> ghcSet Nothing
+  currentHLS   <- hlsSet
+
+  case (currentGHC, currentHLS) of
+    (Just gv, Just hv) | gv `notElem` supportedGHC -> do
+      logWarn $
+        "GHC " <> T.pack (prettyShow gv) <> " is not compatible with " <>
+        "Haskell Language Server " <> T.pack (prettyShow hv) <> "." <> "\n" <>
+        "Haskell IDE support may not work until this is fixed." <> "\n" <>
+        "Install a different HLS version, or install and set one of the following GHCs:" <> "\n" <>
+        T.pack (prettyShow supportedGHC)
+        
+    _ -> return ()
+
+

lib/GHCup/Utils/File.hs

@@ -1,17 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module GHCup.Utils.File (
-  module GHCup.Utils.File.Common,
-#if IS_WINDOWS
-  module GHCup.Utils.File.Windows
-#else
-  module GHCup.Utils.File.Posix
-#endif
-) where
-
-import GHCup.Utils.File.Common
-#if IS_WINDOWS
-import GHCup.Utils.File.Windows
-#else
-import GHCup.Utils.File.Posix
-#endif

stack.yaml

@@ -16,6 +16,7 @@ extra-deps:
   - composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
   - haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
   - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
+  - haskus-utils-variant-3.1@sha256:e602dd23e068c98d03c1027af20503addef8df6368577622453f44ccabea2a5b,2159
   - heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
   - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
   - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
@@ -39,11 +40,6 @@ extra-deps:
   - xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
   - yaml-streamly-0.12.0
 
-  - git: https://github.com/hasufell/packages.git
-    commit: cc0b4688f8bb374fa92f17c856949de795b56291
-    subdirs:
-      - haskus-utils-variant
-
 flags:
   http-io-streams:
     brotli: false