Remove URLSource from Settings

This commit is contained in:
Julian Ospald 2020-03-17 18:39:01 +01:00
parent f5a2db6719
commit 8a1bd45ffe
6 changed files with 38 additions and 50 deletions

View File

@ -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 ())

View File

@ -454,9 +454,8 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
toSettings :: Options -> Settings
toSettings Options {..} =
let cache = optCache
urlSource = maybe GHCupURL OwnSource optUrlSource
noVerify = optNoVerify
let cache = optCache
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

View File

@ -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
diBinDir <- liftIO $ ghcupBinDir
diGHCDir <- liftIO $ ghcupGHCBaseDir
diCacheDir <- liftIO $ ghcupCacheDir
diURLSource <- lift $ getUrlSource
diArch <- lE getArchitecture
diPlatform <- liftE $ getPlatform
diBaseDir <- liftIO $ ghcupBaseDir
diBinDir <- liftIO $ ghcupBinDir
diGHCDir <- liftIO $ ghcupGHCBaseDir
diCacheDir <- liftIO $ ghcupCacheDir
diArch <- lE getArchitecture
diPlatform <- liftE $ getPlatform
pure $ DebugInfo { .. }

View File

@ -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
getDownloads = do
urlSource <- lift getUrlSource
=> URLSource
-> Excepts '[JSONError , DownloadFailed] m GHCupDownloads
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)
=> URI
-> Excepts
'[ FileDoesNotExistError
, HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
]
m1
L.ByteString
. (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
=> URI
-> Excepts
'[ FileDoesNotExistError
, HTTPStatusError
, URIParseError
, UnsupportedScheme
, NoLocationHeader
, TooManyRedirs
]
m1
L.ByteString
smartDl uri' = do
let path = view pathL' uri'
json_file <- (liftIO $ ghcupCacheDir)
@ -204,11 +203,7 @@ getDownloads = do
getDownloadInfo :: ( MonadLogger m
, MonadCatch m
, MonadIO m
, MonadReader Settings m
)
getDownloadInfo :: (MonadLogger m, MonadCatch m, MonadIO m)
=> GHCupDownloads
-> Tool
-> Version

View File

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

View File

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