Refactor app Main

2021-10-17 19:15:24 +02:00
22 changed files with 81 additions and 127 deletions
--- a/.gitlab/script/hlint.sh
+++ b/.gitlab/script/hlint.sh
@@ -15,5 +15,5 @@ git describe
 ecabal update
 ecabal install -w ghc-${GHC_VERSION} --installdir="$CI_PROJECT_DIR"/.local/bin hlint

-hlint -r lib/ test/ 
+hlint -r app/ lib/ test/ 

--- a/app/ghcup-gen/Main.hs
+++ b/app/ghcup-gen/Main.hs
@@ -1,10 +1,7 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeApplications  #-}


--- a/app/ghcup-gen/Validate.hs
+++ b/app/ghcup-gen/Validate.hs
@@ -91,23 +91,23 @@ validate dls _ = do
  checkHasRequiredPlatforms t v tags arch pspecs = do
    let v' = prettyVer v
        arch' = prettyShow arch
-    when (notElem (Linux UnknownLinux) pspecs) $ do
+    when (Linux UnknownLinux `notElem` pspecs) $ do
      lift $ logError $
        "Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
      addError
-    when ((notElem Darwin pspecs) && arch == A_64) $ do
+    when ((Darwin `notElem` pspecs) && arch == A_64) $ do
      lift $ logError $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
      addError
-    when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ logWarn $
+    when ((FreeBSD `notElem` pspecs) && arch == A_64) $ lift $ logWarn $
      "FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
-    when (notElem Windows pspecs && arch == A_64) $ do
+    when (Windows `notElem` pspecs && arch == A_64) $ do
      lift $ logError $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
      addError

    -- alpine needs to be set explicitly, because
    -- we cannot assume that "Linux UnknownLinux" runs on Alpine
    -- (although it could be static)
-    when (notElem (Linux Alpine) pspecs) $
+    when (Linux Alpine `notElem` pspecs) $
      case t of
        GHCup | arch `elem` [A_64, A_32] -> lift (logError $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
        Cabal | v > [vver|2.4.1.0|]
@@ -117,7 +117,7 @@ validate dls _ = do
        _ -> lift $ logWarn $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)

  checkUniqueTags tool = do
-    let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
+    let allTags = _viTags =<< M.elems (availableToolVersions dls tool)
    let nonUnique =
          fmap fst
            .   filter (\(_, b) -> not b)
@@ -155,8 +155,8 @@ validate dls _ = do

  -- a tool must have at least one of each mandatory tags
  checkMandatoryTags tool = do
-    let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
-    forM_ [Latest, Recommended] $ \t -> case elem t allTags of
+    let allTags = _viTags =<< M.elems (availableToolVersions dls tool)
+    forM_ [Latest, Recommended] $ \t -> case t `elem` allTags of
      False -> do
        lift $ logError $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
        addError
@@ -202,7 +202,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
  let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
  let gdlis = nubOrd $ gt ^.. each
  let allDls = either (const gdlis) (const dlis) etool
-  when (null allDls) $ logError "no tarballs selected by filter" *> (flip runReaderT ref addError)
+  when (null allDls) $ logError "no tarballs selected by filter" *> runReaderT addError ref
  forM_ allDls (downloadAll ref)

  -- exit
@@ -260,7 +260,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
            when (basePath /= prel) $ do
              logError $
                "Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
-              (flip runReaderT ref addError)
+              runReaderT addError ref
          Just (RegexDir regexString) -> do
            logInfo $
              "verifying subdir (regex): " <> T.pack regexString
@@ -268,13 +268,13 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
                  compIgnoreCase
                  execBlank
                  regexString
-            when (not (match regex basePath)) $ do
+            unless (match regex basePath) $ do
              logError $
                "Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
-              (flip runReaderT ref addError)
+              runReaderT addError ref
          Nothing -> pure ()
      VRight Nothing -> pure ()
      VLeft  e -> do
        logError $
          "Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
-        (flip runReaderT ref addError)
+        runReaderT addError ref
--- a/app/ghcup/BrickMain.hs
+++ b/app/ghcup/BrickMain.hs
@@ -2,10 +2,7 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE ViewPatterns      #-}
 {-# LANGUAGE RankNTypes        #-}

 module BrickMain where
@@ -368,10 +365,7 @@ listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix


 selectLatest :: Vector ListResult -> Int
-selectLatest v =
-  case V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag) v of
-    Just ix -> ix
-    Nothing -> 0
+selectLatest = fromMaybe 0 . V.findIndex (\ListResult {..} -> lTool == GHC && Latest `elem` lTag)


 -- | Replace the @appState@ or construct it based on a filter function
@@ -398,14 +392,14 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
 filterVisible v t e | lInstalled e = True
                    | v
                    , not t
-                    , not (elem (lTool e) hiddenTools) = True
+                    , lTool e `notElem` hiddenTools = True
                    | not v
                    , t
-                    , not (elem Old (lTag e)) = True
+                    , Old `notElem` lTag e = True
                    | v
                    , t = True
-                    | otherwise = not (elem Old (lTag e)) &&
-                                  not (elem (lTool e) hiddenTools)
+                    | otherwise = (Old `notElem` lTag e) &&
+                                  (lTool e `notElem` hiddenTools)


 install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m)
@@ -507,7 +501,7 @@ del' _ (_, ListResult {..}) = do
    )
    >>= \case
          VRight vi -> do
-            forM_ (join $ fmap _viPostRemove vi) $ \msg ->
+            forM_ (_viPostRemove =<< vi) $ \msg ->
              logInfo msg
            pure $ Right ()
          VLeft  e -> pure $ Left (prettyShow e)
@@ -594,8 +588,7 @@ getGHCupInfo = do
  r <-
    flip runReaderT settings
    . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
-    $ liftE
-    $ getDownloadsF
+    $ liftE getDownloadsF

  case r of
    VRight a -> pure $ Right a
--- a/app/ghcup/GHCup/OptParse.hs
+++ b/app/ghcup/GHCup/OptParse.hs
@@ -1,11 +1,7 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}


@@ -109,7 +105,7 @@ opts =
  Options
    <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
    <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
-    <*> (optional
+    <*> optional
          (option
            (eitherReader parseUri)
            (  short 's'
@@ -119,7 +115,6 @@ opts =
            <> internal
            )
          )
-        )
    <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
    <*> optional (option
          (eitherReader keepOnParser)
@@ -164,11 +159,10 @@ com =
      (  command
          "tui"
          (   (\_ -> Interactive)
-          <$> (info
+          <$> info
                helper
                (  progDesc "Start the interactive GHCup UI"
                )
-              )
          )
      <>  command
 #else
--- a/app/ghcup/GHCup/OptParse/ChangeLog.hs
+++ b/app/ghcup/GHCup/OptParse/ChangeLog.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
--- a/app/ghcup/GHCup/OptParse/Common.hs
+++ b/app/ghcup/GHCup/OptParse/Common.hs
@@ -1,11 +1,7 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}

 module GHCup.OptParse.Common where
@@ -160,7 +156,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
  archP = MP.try (MP.chunk "x86_64" $> A_64) <|> (MP.chunk "i386" $> A_32)
  platformP :: MP.Parsec Void Text PlatformRequest
  platformP = choice'
-    [ (\a mv -> PlatformRequest a FreeBSD mv)
+    [ (`PlatformRequest` FreeBSD)
    <$> (archP <* MP.chunk "-")
    <*> (  MP.chunk "portbld"
        *> (   MP.try (Just <$> verP (MP.chunk "-freebsd" <* MP.eof))
@@ -168,7 +164,7 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
           )
        <* MP.chunk "-freebsd"
        )
-    , (\a mv -> PlatformRequest a Darwin mv)
+    , (`PlatformRequest` Darwin)
    <$> (archP <* MP.chunk "-")
    <*> (  MP.chunk "apple"
        *> (   MP.try (Just <$> verP (MP.chunk "-darwin" <* MP.eof))
@@ -311,11 +307,8 @@ tagCompleter tool add = listIOCompleter $ do
  mGhcUpInfo <- flip runReaderT appState . runE $ getDownloadsF
  case mGhcUpInfo of
    VRight ghcupInfo -> do
-      let allTags = filter (\t -> t /= Old)
-            $ join
-            $ fmap _viTags
-            $ M.elems
-            $ availableToolVersions (_ghcupDownloads ghcupInfo) tool
+      let allTags = filter (/= Old)
+            $ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
      pure $ nub $ (add ++) $ fmap tagToString allTags
    VLeft _ -> pure  (nub $ ["recommended", "latest"] ++ add)

@@ -396,7 +389,7 @@ fromVersion' :: ( HasLog env
                   ] m (GHCTargetVersion, Maybe VersionInfo)
 fromVersion' SetRecommended tool = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-  (\(x, y) -> (mkTVer x, Just y)) <$> getRecommended dls tool
+  bimap mkTVer Just <$> getRecommended dls tool
    ?? TagNotFound Recommended tool
 fromVersion' (SetToolVersion v) tool = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -407,18 +400,18 @@ fromVersion' (SetToolVersion v) tool = do
      lift (getLatestToolFor tool pvpIn dls) >>= \case
        Just (pvp_, vi') -> do
          v' <- lift $ pvpToVersion pvp_
-          when (v' /= (_tvVersion v)) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
+          when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
          pure (GHCTargetVersion (_tvTarget v) v', Just vi')
        Nothing -> pure (v, vi)
 fromVersion' (SetToolTag Latest) tool = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-  (\(x, y) -> (mkTVer x, Just y)) <$> getLatest dls tool ?? TagNotFound Latest tool
+  bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
 fromVersion' (SetToolTag Recommended) tool = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-  (\(x, y) -> (mkTVer x, Just y)) <$> getRecommended dls tool ?? TagNotFound Recommended tool
+  bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
 fromVersion' (SetToolTag (Base pvp'')) GHC = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-  (\(x, y) -> (mkTVer x, Just y)) <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
+  bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
 fromVersion' SetNext tool = do
  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
  next <- case tool of
@@ -430,7 +423,7 @@ fromVersion' SetNext tool = do
        . dropWhile (\GHCTargetVersion {..} -> _tvVersion /= set)
        . cycle
        . sortBy (\x y -> compare (_tvVersion x) (_tvVersion y))
-        . filter (\GHCTargetVersion {..} -> _tvTarget == Nothing)
+        . filter (\GHCTargetVersion {..} -> isNothing _tvTarget)
        $ ghcs) ?? NoToolVersionSet tool
    Cabal -> do
      set <- cabalSet !? NoToolVersionSet tool
--- a/app/ghcup/GHCup/OptParse/Compile.hs
+++ b/app/ghcup/GHCup/OptParse/Compile.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -508,7 +507,7 @@ compile compileCommand settings runAppState runLogger = do
              VLeft err@(V (BuildFailed tmpdir _)) -> do
                case keepDirs settings of
                  Never -> runLogger $ logError $ T.pack $ prettyShow err
-                  _ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
+                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
                        "Check the logs at " <> T.pack logsDir <> " and the build directory "
                        <> T.pack tmpdir <> " for more clues." <> "\n" <>
                        "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
--- a/app/ghcup/GHCup/OptParse/Config.hs
+++ b/app/ghcup/GHCup/OptParse/Config.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
--- a/app/ghcup/GHCup/OptParse/DInfo.hs
+++ b/app/ghcup/GHCup/OptParse/DInfo.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -84,7 +83,7 @@ prettyDebugInfo DebugInfo {..} = "Debug Info" <> "\n" <>
 type DInfoEffects = '[ NoCompatiblePlatform , NoCompatibleArch , DistroNotFound ]

 runDebugInfo :: (ReaderT env m (VEither DInfoEffects a) -> m (VEither DInfoEffects a))
-             -> (Excepts DInfoEffects (ReaderT env m) a)
+             -> Excepts DInfoEffects (ReaderT env m) a
             -> m (VEither DInfoEffects a)
 runDebugInfo runAppState =
        runAppState
--- a/app/ghcup/GHCup/OptParse/GC.hs
+++ b/app/ghcup/GHCup/OptParse/GC.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -104,7 +103,7 @@ type GCEffects = '[ NotInstalled ]

 runGC :: MonadUnliftIO m
      => (ReaderT AppState m (VEither GCEffects a) -> m (VEither GCEffects a))
-      -> (Excepts GCEffects (ResourceT (ReaderT AppState m)) a)
+      -> Excepts GCEffects (ResourceT (ReaderT AppState m)) a
      -> m (VEither GCEffects a)
 runGC runAppState =
  runAppState
--- a/app/ghcup/GHCup/OptParse/Install.hs
+++ b/app/ghcup/GHCup/OptParse/Install.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -275,7 +274,7 @@ runInstTool appstate' mInstPlatform =
    -------------------


-install :: (Either InstallCommand InstallOptions) -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
+install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
 install installCommand settings getAppState' runLogger = case installCommand of
  (Right iopts) -> do
    runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
@@ -324,8 +323,8 @@ install installCommand settings getAppState' runLogger = case installCommand of
                pure $ ExitFailure 3
              VLeft err@(V (BuildFailed tmpdir _)) -> do
                case keepDirs settings of
-                  Never -> runLogger $ (logError $ T.pack $ prettyShow err)
-                  _ -> runLogger $ (logError $ T.pack (prettyShow err) <> "\n" <>
+                  Never -> runLogger (logError $ T.pack $ prettyShow err)
+                  _ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
                    "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
                    "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                pure $ ExitFailure 3
--- a/app/ghcup/GHCup/OptParse/List.hs
+++ b/app/ghcup/GHCup/OptParse/List.hs
@@ -1,11 +1,7 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -99,7 +95,7 @@ printListResult :: Bool -> Bool -> [ListResult] -> IO ()
 printListResult no_color raw lr = do

  let
-    color | raw || no_color = flip const
+    color | raw || no_color = (\_ x -> x)
          | otherwise       = Pretty.color

  let
@@ -134,7 +130,7 @@ printListResult no_color raw lr = do
                     , case lCross of
                       Nothing -> T.unpack . prettyVer $ lVer
                       Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
-                     , intercalate "," $ (filter (/= "") . fmap printTag $ sort lTag)
+                     , intercalate "," (filter (/= "") . fmap printTag $ sort lTag)
                     , intercalate ","
                     $  (if hlsPowered
                          then [color Green "hls-powered"]
@@ -151,10 +147,10 @@ printListResult no_color raw lr = do
        $ lr
  let cols =
        foldr (\xs ys -> zipWith (:) xs ys) (replicate (length rows) []) rows
-      lengths = fmap maximum . (fmap . fmap) strWidth $ cols
+      lengths = fmap (maximum . fmap strWidth) cols
      padded  = fmap (\xs -> zipWith padTo xs lengths) rows

-  forM_ padded $ \row -> putStrLn $ intercalate " " row
+  forM_ padded $ \row -> putStrLn $ unwords row
 where

  padTo str' x =
--- a/app/ghcup/GHCup/OptParse/Nuke.hs
+++ b/app/ghcup/GHCup/OptParse/Nuke.hs
@@ -3,9 +3,6 @@
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -49,7 +46,7 @@ type NukeEffects = '[ NotInstalled ]


 runNuke :: AppState
-        -> (Excepts NukeEffects (ReaderT AppState m) a)
+        -> Excepts NukeEffects (ReaderT AppState m) a
        -> m (VEither NukeEffects a)
 runNuke s' =
  flip runReaderT s' . runE @NukeEffects
--- a/app/ghcup/GHCup/OptParse/Prefetch.hs
+++ b/app/ghcup/GHCup/OptParse/Prefetch.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -85,7 +84,7 @@ prefetchP = subparser
          <$> (PrefetchGHCOptions
                <$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
                <*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)")))
-          <*> ( optional (toolVersionArgument Nothing (Just GHC)) ))
+          <*>  optional (toolVersionArgument Nothing (Just GHC)) )
        ( progDesc "Download GHC assets for installation")
      )
      <>
@@ -118,7 +117,7 @@ prefetchP = subparser
      <>
     command
      "metadata"
-      (const PrefetchMetadata <$> info
+      (PrefetchMetadata <$ info
        helper
        ( progDesc "Download ghcup's metadata, needed for various operations")
      )
@@ -162,7 +161,7 @@ type PrefetchEffects = '[ TagNotFound

 runPrefetch :: MonadUnliftIO m
            => (ReaderT AppState m (VEither PrefetchEffects a) -> m (VEither PrefetchEffects a))
-            -> (Excepts PrefetchEffects (ResourceT (ReaderT AppState m)) a)
+            -> Excepts PrefetchEffects (ResourceT (ReaderT AppState m)) a
            -> m (VEither PrefetchEffects a)
 runPrefetch runAppState =
  runAppState
@@ -197,20 +196,20 @@ prefetch prefetchCommand runAppState runLogger =
          if pfGHCSrc
          then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
          else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
-      PrefetchCabal (PrefetchOptions {pfCacheDir}) mt   -> do
+      PrefetchCabal PrefetchOptions {pfCacheDir} mt   -> do
        forM_ pfCacheDir (liftIO . createDirRecursive')
        (v, _) <- liftE $ fromVersion mt Cabal
        liftE $ fetchToolBindist (_tvVersion v) Cabal pfCacheDir
-      PrefetchHLS (PrefetchOptions {pfCacheDir}) mt   -> do
+      PrefetchHLS PrefetchOptions {pfCacheDir} mt   -> do
        forM_ pfCacheDir (liftIO . createDirRecursive')
        (v, _) <- liftE $ fromVersion mt HLS
        liftE $ fetchToolBindist (_tvVersion v) HLS pfCacheDir
-      PrefetchStack (PrefetchOptions {pfCacheDir}) mt   -> do
+      PrefetchStack PrefetchOptions {pfCacheDir} mt   -> do
        forM_ pfCacheDir (liftIO . createDirRecursive')
        (v, _) <- liftE $ fromVersion mt Stack
        liftE $ fetchToolBindist (_tvVersion v) Stack pfCacheDir
      PrefetchMetadata -> do
-        _ <- liftE $ getDownloadsF
+        _ <- liftE getDownloadsF
        pure ""
       ) >>= \case
                VRight _ -> do
--- a/app/ghcup/GHCup/OptParse/Rm.hs
+++ b/app/ghcup/GHCup/OptParse/Rm.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -132,7 +131,7 @@ type RmEffects = '[ NotInstalled ]


 runRm :: (ReaderT env m (VEither RmEffects a) -> m (VEither RmEffects a))
-            -> (Excepts RmEffects (ReaderT env m) a)
+            -> Excepts RmEffects (ReaderT env m) a
            -> m (VEither RmEffects a)
 runRm runAppState =
    runAppState
@@ -152,7 +151,7 @@ rm :: ( Monad m
      , MonadUnliftIO m
      , MonadFail m
      )
-   => (Either RmCommand RmOptions)
+   => Either RmCommand RmOptions
   -> (ReaderT AppState m (VEither RmEffects (Maybe VersionInfo))
       -> m (VEither RmEffects (Maybe VersionInfo)))
   -> (ReaderT LeanAppState m () -> m ())
--- a/app/ghcup/GHCup/OptParse/Set.hs
+++ b/app/ghcup/GHCup/OptParse/Set.hs
@@ -2,8 +2,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -42,6 +40,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import qualified Data.Text                     as T
 import Data.Bifunctor (second)
 import Control.Exception.Safe (MonadMask)
+import GHCup.Types.Optics



@@ -187,7 +186,7 @@ type SetGHCEffects = '[ FileDoesNotExistError
                   , NoToolVersionSet]

 runSetGHC :: (ReaderT env m (VEither SetGHCEffects a) -> m (VEither SetGHCEffects a))
-          -> (Excepts SetGHCEffects (ReaderT env m) a)
+          -> Excepts SetGHCEffects (ReaderT env m) a
          -> m (VEither SetGHCEffects a)
 runSetGHC runAppState =
    runAppState
@@ -201,7 +200,7 @@ type SetCabalEffects = '[ NotInstalled
                        , NoToolVersionSet]

 runSetCabal :: (ReaderT env m (VEither SetCabalEffects a) -> m (VEither SetCabalEffects a))
-            -> (Excepts SetCabalEffects (ReaderT env m) a)
+            -> Excepts SetCabalEffects (ReaderT env m) a
            -> m (VEither SetCabalEffects a)
 runSetCabal runAppState =
    runAppState
@@ -215,7 +214,7 @@ type SetHLSEffects = '[ NotInstalled
                      , NoToolVersionSet]

 runSetHLS :: (ReaderT env m (VEither SetHLSEffects a) -> m (VEither SetHLSEffects a))
-          -> (Excepts SetHLSEffects (ReaderT env m) a)
+          -> Excepts SetHLSEffects (ReaderT env m) a
          -> m (VEither SetHLSEffects a)
 runSetHLS runAppState =
    runAppState
@@ -229,7 +228,7 @@ type SetStackEffects = '[ NotInstalled
                        , NoToolVersionSet]

 runSetStack :: (ReaderT env m (VEither SetStackEffects a) -> m (VEither SetStackEffects a))
-            -> (Excepts SetStackEffects (ReaderT env m) a)
+            -> Excepts SetStackEffects (ReaderT env m) a
            -> m (VEither SetStackEffects a)
 runSetStack runAppState =
    runAppState
@@ -243,15 +242,18 @@ runSetStack runAppState =
    -------------------


-set :: forall m . ( Monad m
+set :: forall m env.
+       ( Monad m
       , MonadMask m
       , MonadUnliftIO m
       , MonadFail m
+       , HasDirs env
+       , HasLog env
       )
    => Either SetCommand SetOptions
    -> (forall eff . ReaderT AppState m (VEither eff GHCTargetVersion)
        -> m (VEither eff GHCTargetVersion))
-    -> (forall eff . ReaderT LeanAppState m (VEither eff GHCTargetVersion)
+    -> (forall eff. ReaderT env m (VEither eff GHCTargetVersion)
        -> m (VEither eff GHCTargetVersion))
    -> (ReaderT LeanAppState m () -> m ())
    -> m ExitCode
--- a/app/ghcup/GHCup/OptParse/ToolRequirements.hs
+++ b/app/ghcup/GHCup/OptParse/ToolRequirements.hs
@@ -2,10 +2,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -49,7 +45,7 @@ type ToolRequirementsEffects = '[ NoCompatiblePlatform , DistroNotFound , NoTool


 runToolRequirements :: (ReaderT env m (VEither ToolRequirementsEffects a) -> m (VEither ToolRequirementsEffects a))
-                    -> (Excepts ToolRequirementsEffects (ReaderT env m) a)
+                    -> Excepts ToolRequirementsEffects (ReaderT env m) a
                    -> m (VEither ToolRequirementsEffects a)
 runToolRequirements runAppState =
    runAppState
--- a/app/ghcup/GHCup/OptParse/UnSet.hs
+++ b/app/ghcup/GHCup/OptParse/UnSet.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -36,6 +35,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )

 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
+import GHCup.Types.Optics



@@ -72,7 +72,7 @@ data UnsetOptions = UnsetOptions
          
 unsetParser :: Parser UnsetCommand
 unsetParser =
-  (subparser
+  subparser
      (  command
          "ghc"
          (   UnsetGHC
@@ -110,7 +110,6 @@ unsetParser =
                 )
           )
      )
-    )
 where
  unsetGHCFooter :: String
  unsetGHCFooter = [s|Discussion:
@@ -156,7 +155,7 @@ type UnsetEffects = '[ NotInstalled ]


 runUnsetGHC :: (ReaderT env m (VEither UnsetEffects a) -> m (VEither UnsetEffects a))
-            -> (Excepts UnsetEffects (ReaderT env m) a)
+            -> Excepts UnsetEffects (ReaderT env m) a
            -> m (VEither UnsetEffects a)
 runUnsetGHC runLeanAppState =
    runLeanAppState
@@ -175,9 +174,11 @@ unset :: ( Monad m
         , MonadMask m
         , MonadUnliftIO m
         , MonadFail m
+         , HasDirs env
+         , HasLog env
         )
      => UnsetCommand
-      -> (ReaderT LeanAppState m (VEither UnsetEffects ())
+      -> (ReaderT env m (VEither UnsetEffects ())
          -> m (VEither UnsetEffects ()))
      -> (ReaderT LeanAppState m () -> m ())
      -> m ExitCode
--- a/app/ghcup/GHCup/OptParse/Upgrade.hs
+++ b/app/ghcup/GHCup/OptParse/Upgrade.hs
@@ -3,9 +3,6 @@
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

--- a/app/ghcup/GHCup/OptParse/Whereis.hs
+++ b/app/ghcup/GHCup/OptParse/Whereis.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}

@@ -113,7 +112,7 @@ whereisP = subparser
      <>
     command
      "ghcup"
-      (WhereisTool GHCup <$> info ( (pure Nothing) <**> helper ) ( progDesc "Get ghcup location" ))
+      (WhereisTool GHCup <$> info ( pure Nothing <**> helper ) ( progDesc "Get ghcup location" ))
    ) <|> subparser ( commandGroup "Directory locations:"
      <>
     command
@@ -266,7 +265,7 @@ whereis :: ( Monad m
      -> (ReaderT LeanAppState m () -> m ())
      -> m ExitCode
 whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
-  VRight Dirs{ .. }  <- runAppState (VRight <$> getDirs)
+  Dirs{ .. }  <- runReaderT getDirs leanAppstate
  case (whereisCommand, whereisOptions) of
    (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
      runLeanWhereIs leanAppstate (do
@@ -283,7 +282,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
                runLogger $ logError $ T.pack $ prettyShow e
                pure $ ExitFailure 30

-    (WhereisTool tool whereVer, WhereisOptions{..}) ->
+    (WhereisTool tool whereVer, WhereisOptions{..}) -> do
      runWhereIs runAppState (do
        (v, _) <- liftE $ fromVersion whereVer tool
        loc <- liftE $ whereIsTool tool v
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}


@@ -112,7 +111,7 @@ plan_json = $( do
                             c <- B.readFile fp
                             (Just res) <- pure $ decodeStrict' @Value c
                             pure (fp, T.unpack $ decUTF8Safe' $ encodePretty res))
-                when (not . null $ fp ) $ qAddDependentFile fp
+                unless (null fp) $ qAddDependentFile fp
                pure . LitE . StringL $ c)


@@ -124,8 +123,7 @@ main = do
  void enableAnsiSupport

  let versionHelp = infoOption
-        ( ("The GHCup Haskell installer, version " <>)
-          (head . lines $ describe_result)
+        ( "The GHCup Haskell installer, version " <> (head . lines $ describe_result)
        )
        (long "version" <> help "Show version" <> hidden)
  let planJson = infoOption
@@ -170,7 +168,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
          (settings, keybindings) <- toSettings opt

          -- logger interpreter
-          logfile <- flip runReaderT dirs initGHCupFileLogging
+          logfile <- runReaderT initGHCupFileLogging dirs
          no_color <- isJust <$> lookupEnv "NO_COLOR"
          let loggerConfig = LoggerConfig
                { lcPrintDebug = verbose settings
@@ -204,8 +202,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                ghcupInfo <-
                  ( flip runReaderT leanAppstate
                    . runE @'[DigestError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
-                    $ liftE
-                    $ getDownloadsF
+                    $ liftE getDownloadsF
                    )
                    >>= \case
                          VRight r -> pure r
@@ -215,7 +212,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                            exitWith (ExitFailure 2)
                let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig

-                race_ (liftIO $ flip runReaderT s' cleanupTrash)
+                race_ (liftIO $ runReaderT cleanupTrash s')
                      (threadDelay 5000000 >> runLogger (logWarn $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))

                case optCommand of
@@ -229,11 +226,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                  Interactive -> pure ()
 #endif
                  _ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
-                         Nothing -> flip runReaderT s' checkForUpdates
+                         Nothing -> runReaderT checkForUpdates s'
                         Just _ -> pure ()

                -- TODO: always run for windows
-                (siletRunLogger $ flip runReaderT s' $ runE ensureGlobalTools) >>= \case
+                siletRunLogger (flip runReaderT s' $ runE ensureGlobalTools) >>= \case
                  VRight _ -> pure ()
                  VLeft e -> do
                    runLogger
@@ -251,7 +248,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 #endif
              runAppState action' = do
                s' <- liftIO appState
-                flip runReaderT s' action'
+                runReaderT action' s'
                  

          -----------------