Remove URLSource from Settings

app/ghcup-gen/Validate.hs

@@ -161,7 +161,7 @@ validateTarballs dls = do
 
  where
   downloadAll dli = do
-    let settings = Settings True GHCupURL False
+    let settings = Settings True False
     let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
                                            , colorOutter  = B.hPut stderr
                                            , rawOutter    = (\_ -> pure ())

app/ghcup/Main.hs

@@ -454,9 +454,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
 
 toSettings :: Options -> Settings
 toSettings Options {..} =
-  let cache     = optCache
+  let cache    = optCache
-      urlSource = maybe GHCupURL OwnSource optUrlSource
+      noVerify = optNoVerify
-      noVerify  = optNoVerify
   in  Settings { .. }
 
 
@@ -592,7 +591,8 @@ main = do
             ( runLogger
               . flip runReaderT settings
               . runE @'[JSONError , DownloadFailed]
-              $ liftE getDownloads
+              $ liftE
+              $ getDownloads (maybe GHCupURL OwnSource optUrlSource)
               )
               >>= \case
                     VRight r -> pure r
@@ -607,7 +607,7 @@ main = do
               void
                 $   (runInstTool $ do
                       v <- liftE $ fromVersion dls instVer GHC
-                      liftE $ installGHCBin dls v Nothing
+                      liftE $ installGHCBin dls v optPlatform
                     )
                 >>= \case
                       VRight _ -> runLogger
@@ -630,7 +630,7 @@ Check the logs at ~/ghcup/logs and the build directory #{tmpdir} for more clues.
               void
                 $   (runInstTool $ do
                       v <- liftE $ fromVersion dls instVer Cabal
-                      liftE $ installCabalBin dls v Nothing
+                      liftE $ installCabalBin dls v optPlatform
                     )
                 >>= \case
                       VRight _ -> runLogger

lib/GHCup.hs

@@ -404,19 +404,18 @@ rmGHCVer ver = do
     ------------------
 
 
-getDebugInfo :: (MonadLogger m, MonadCatch m, MonadReader Settings m, MonadIO m)
+getDebugInfo :: (MonadLogger m, MonadCatch m, MonadIO m)
              => Excepts
                   '[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
                   m
                   DebugInfo
 getDebugInfo = do
-  diBaseDir   <- liftIO $ ghcupBaseDir
+  diBaseDir  <- liftIO $ ghcupBaseDir
-  diBinDir    <- liftIO $ ghcupBinDir
+  diBinDir   <- liftIO $ ghcupBinDir
-  diGHCDir    <- liftIO $ ghcupGHCBaseDir
+  diGHCDir   <- liftIO $ ghcupGHCBaseDir
-  diCacheDir  <- liftIO $ ghcupCacheDir
+  diCacheDir <- liftIO $ ghcupCacheDir
-  diURLSource <- lift $ getUrlSource
+  diArch     <- lE getArchitecture
-  diArch      <- lE getArchitecture
+  diPlatform <- liftE $ getPlatform
-  diPlatform  <- liftE $ getPlatform
   pure $ DebugInfo { .. }
 
 

lib/GHCup/Download.hs

@@ -93,14 +93,13 @@ getDownloads :: ( FromJSONKey Tool
                 , FromJSON VersionInfo
                 , MonadIO m
                 , MonadCatch m
-                , MonadReader Settings m
                 , MonadLogger m
                 , MonadThrow m
                 , MonadFail m
                 )
-             => Excepts '[JSONError , DownloadFailed] m GHCupDownloads
+             => URLSource
-getDownloads = do
+             -> Excepts '[JSONError , DownloadFailed] m GHCupDownloads
-  urlSource <- lift getUrlSource
+getDownloads urlSource = do
   lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|]
   case urlSource of
     GHCupURL -> do
@@ -122,18 +121,18 @@ getDownloads = do
   --
   -- Always save the local file with the mod time of the remote file.
   smartDl :: forall m1
-      . (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
+           . (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
-     => URI
+          => URI
-     -> Excepts
+          -> Excepts
-          '[ FileDoesNotExistError
+               '[ FileDoesNotExistError
-           , HTTPStatusError
+                , HTTPStatusError
-           , URIParseError
+                , URIParseError
-           , UnsupportedScheme
+                , UnsupportedScheme
-           , NoLocationHeader
+                , NoLocationHeader
-           , TooManyRedirs
+                , TooManyRedirs
-           ]
+                ]
-          m1
+               m1
-          L.ByteString
+               L.ByteString
   smartDl uri' = do
     let path = view pathL' uri'
     json_file <- (liftIO $ ghcupCacheDir)
@@ -204,11 +203,7 @@ getDownloads = do
 
 
 
-getDownloadInfo :: ( MonadLogger m
+getDownloadInfo :: (MonadLogger m, MonadCatch m, MonadIO m)
-                   , MonadCatch m
-                   , MonadIO m
-                   , MonadReader Settings m
-                   )
                 => GHCupDownloads
                 -> Tool
                 -> Version

lib/GHCup/Types.hs

@@ -104,21 +104,19 @@ data URLSource = GHCupURL
 
 
 data Settings = Settings
-  { cache     :: Bool
+  { cache    :: Bool
-  , urlSource :: URLSource
+  , noVerify :: Bool
-  , noVerify  :: Bool
   }
   deriving Show
 
 
 data DebugInfo = DebugInfo
-  { diBaseDir   :: Path Abs
+  { diBaseDir  :: Path Abs
-  , diBinDir    :: Path Abs
+  , diBinDir   :: Path Abs
-  , diGHCDir    :: Path Abs
+  , diGHCDir   :: Path Abs
-  , diCacheDir  :: Path Abs
+  , diCacheDir :: Path Abs
-  , diURLSource :: URLSource
+  , diArch     :: Architecture
-  , diArch      :: Architecture
+  , diPlatform :: PlatformResult
-  , diPlatform  :: PlatformResult
   }
   deriving Show
 
@@ -141,4 +139,3 @@ data PlatformRequest = PlatformRequest
   , _rVersion  :: Maybe Versioning
   }
   deriving (Eq, Show)
-

lib/GHCup/Utils.hs

@@ -277,9 +277,6 @@ getRecommended av tool = headOf folded $ getTagged av tool Recommended
     -----------------------
 
 
-getUrlSource :: MonadReader Settings m => m URLSource
-getUrlSource = ask <&> urlSource
-
 getCache :: MonadReader Settings m => m Bool
 getCache = ask <&> cache