From 8a1bd45ffe23f4781c12df600b5328b8edd5fe6f Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 17 Mar 2020 18:39:01 +0100 Subject: [PATCH] Remove URLSource from Settings --- app/ghcup-gen/Validate.hs | 2 +- app/ghcup/Main.hs | 12 ++++++------ lib/GHCup.hs | 15 +++++++-------- lib/GHCup/Download.hs | 37 ++++++++++++++++--------------------- lib/GHCup/Types.hs | 19 ++++++++----------- lib/GHCup/Utils.hs | 3 --- 6 files changed, 38 insertions(+), 50 deletions(-) diff --git a/app/ghcup-gen/Validate.hs b/app/ghcup-gen/Validate.hs index 2f43571..8de86b1 100644 --- a/app/ghcup-gen/Validate.hs +++ b/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 ()) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 6f0e16c..7b9bbb0 100644 --- a/app/ghcup/Main.hs +++ b/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 - 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 diff --git a/lib/GHCup.hs b/lib/GHCup.hs index a25a89f..ec73d73 100644 --- a/lib/GHCup.hs +++ b/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 - 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 { .. } diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 92acc5d..9f44fee 100644 --- a/lib/GHCup/Download.hs +++ b/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 -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 diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index b0b638e..e9ced3f 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -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) - diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 99c60d0..e7b89b0 100644 --- a/lib/GHCup/Utils.hs +++ b/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