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)

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 )

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)

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
@@ -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
 
@@ -231,7 +241,7 @@ executable ghcup
     , 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

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,13 +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.Directories
 import           GHCup.Types
 import           GHCup.Types.Optics
+import           GHCup.System.Directory
+import           GHCup.System.Process.Common
 
 import           Control.Concurrent
 import           Control.DeepSeq

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
@@ -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
@@ -1141,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