Use LabelOptic and add LeanAppState

Wrt #186
2021-07-18 14:39:49 +02:00
parent 327b80cf56
commit 2c7176d998
8 changed files with 644 additions and 325 deletions
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@@ -106,7 +106,10 @@ import Control.Concurrent (threadDelay)
 installGHCBindist :: ( MonadFail m
                     , MonadMask m
                     , MonadCatch m
-                     , MonadReader AppState m
+                     , MonadReader env m
+                     , HasDirs env
+                     , HasSettings env
+                     , HasPlatformReq env
                     , MonadLogger m
                     , MonadResource m
                     , MonadIO m
@@ -130,7 +133,8 @@ installGHCBindist :: ( MonadFail m
                       m
                       ()
 installGHCBindist dlinfo ver = do
-  AppState { dirs , settings } <- lift ask
+  dirs <- lift getDirs
+  settings <- lift getSettings

  let tver = mkTVer ver
  lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
@@ -163,7 +167,10 @@ installGHCBindist dlinfo ver = do
 -- build system and nothing else.
 installPackedGHC :: ( MonadMask m
                    , MonadCatch m
-                    , MonadReader AppState m
+                    , MonadReader env m
+                    , HasDirs env
+                    , HasPlatformReq env
+                    , HasSettings env
                    , MonadThrow m
                    , MonadLogger m
                    , MonadIO m
@@ -182,7 +189,7 @@ installPackedGHC :: ( MonadMask m
 #endif
                       ] m ()
 installPackedGHC dl msubdir inst ver = do
-  AppState { pfreq = PlatformRequest {..} } <- lift ask
+  PlatformRequest {..} <- lift getPlatformReq

  -- unpack
  tmpUnpack <- lift mkGhcupTmpDir
@@ -201,7 +208,10 @@ installPackedGHC dl msubdir inst ver = do

 -- | Install an unpacked GHC distribution. This only deals with the GHC
 -- build system and nothing else.
-installUnpackedGHC :: ( MonadReader AppState m
+installUnpackedGHC :: ( MonadReader env m
+                      , HasPlatformReq env
+                      , HasDirs env
+                      , HasSettings env
                      , MonadThrow m
                      , MonadLogger m
                      , MonadIO m
@@ -218,7 +228,7 @@ installUnpackedGHC path inst _ = do
  liftIO $ copyDirectoryRecursive path inst
 #else
 installUnpackedGHC path inst ver = do
-  AppState { pfreq = PlatformRequest {..} } <- lift ask
+  PlatformRequest {..} <- lift getPlatformReq

  let alpineArgs
       | ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
@@ -250,7 +260,11 @@ installUnpackedGHC path inst ver = do
 installGHCBin :: ( MonadFail m
                 , MonadMask m
                 , MonadCatch m
-                 , MonadReader AppState m
+                 , MonadReader env m
+                 , HasPlatformReq env
+                 , HasGHCupInfo env
+                 , HasDirs env
+                 , HasSettings env
                 , MonadLogger m
                 , MonadResource m
                 , MonadIO m
@@ -273,8 +287,8 @@ installGHCBin :: ( MonadFail m
                   m
                   ()
 installGHCBin ver = do
-  AppState { pfreq
-           , ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
+  pfreq <- lift getPlatformReq
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
  dlinfo <- lE $ getDownloadInfo GHC ver pfreq dls
  installGHCBindist dlinfo ver

@@ -283,7 +297,10 @@ installGHCBin ver = do
 -- argument instead of looking it up from 'GHCupDownloads'.
 installCabalBindist :: ( MonadMask m
                       , MonadCatch m
-                       , MonadReader AppState m
+                       , MonadReader env m
+                       , HasPlatformReq env
+                       , HasDirs env
+                       , HasSettings env
                       , MonadLogger m
                       , MonadResource m
                       , MonadIO m
@@ -310,9 +327,9 @@ installCabalBindist :: ( MonadMask m
 installCabalBindist dlinfo ver = do
  lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]

-  AppState { dirs = dirs@Dirs {..}
-           , pfreq = PlatformRequest {..}
-           , settings } <- lift ask
+  PlatformRequest {..} <- lift getPlatformReq
+  dirs@Dirs {..} <- lift getDirs
+  settings <- lift getSettings

  whenM
      (lift (cabalInstalled ver) >>= \a -> liftIO $
@@ -364,7 +381,11 @@ installCabalBindist dlinfo ver = do
 -- the latest installed version.
 installCabalBin :: ( MonadMask m
                   , MonadCatch m
-                   , MonadReader AppState m
+                   , MonadReader env m
+                   , HasPlatformReq env
+                   , HasGHCupInfo env
+                   , HasDirs env
+                   , HasSettings env
                   , MonadLogger m
                   , MonadResource m
                   , MonadIO m
@@ -388,8 +409,9 @@ installCabalBin :: ( MonadMask m
                     m
                     ()
 installCabalBin ver = do
-  AppState { pfreq
-           , ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
+  pfreq <- lift getPlatformReq
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+
  dlinfo <- lE $ getDownloadInfo Cabal ver pfreq dls
  installCabalBindist dlinfo ver

@@ -398,7 +420,10 @@ installCabalBin ver = do
 -- argument instead of looking it up from 'GHCupDownloads'.
 installHLSBindist :: ( MonadMask m
                     , MonadCatch m
-                     , MonadReader AppState m
+                     , MonadReader env m
+                     , HasPlatformReq env
+                     , HasDirs env
+                     , HasSettings env
                     , MonadLogger m
                     , MonadResource m
                     , MonadIO m
@@ -425,9 +450,9 @@ installHLSBindist :: ( MonadMask m
 installHLSBindist dlinfo ver = do
  lift $ $(logDebug) [i|Requested to install hls version #{ver}|]

-  AppState { dirs = dirs@Dirs {..}
-           , pfreq = PlatformRequest {..}
-           , settings } <- lift ask
+  PlatformRequest {..} <- lift getPlatformReq
+  dirs@Dirs {..} <- lift getDirs
+  settings <- lift getSettings

  whenM (lift (hlsInstalled ver))
    (throwE $ AlreadyInstalled HLS ver)
@@ -488,7 +513,11 @@ installHLSBindist dlinfo ver = do
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
 installHLSBin :: ( MonadMask m
                 , MonadCatch m
-                 , MonadReader AppState m
+                 , MonadReader env m
+                 , HasPlatformReq env
+                 , HasGHCupInfo env
+                 , HasDirs env
+                 , HasSettings env
                 , MonadLogger m
                 , MonadResource m
                 , MonadIO m
@@ -512,8 +541,9 @@ installHLSBin :: ( MonadMask m
                   m
                   ()
 installHLSBin ver = do
-  AppState { pfreq
-           , ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
+  pfreq <- lift getPlatformReq
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+
  dlinfo <- lE $ getDownloadInfo HLS ver pfreq dls
  installHLSBindist dlinfo ver

@@ -523,7 +553,11 @@ installHLSBin ver = do
 -- the latest installed version.
 installStackBin :: ( MonadMask m
                   , MonadCatch m
-                   , MonadReader AppState m
+                   , MonadReader env m
+                   , HasDirs env
+                   , HasSettings env
+                   , HasPlatformReq env
+                   , HasGHCupInfo env
                   , MonadLogger m
                   , MonadResource m
                   , MonadIO m
@@ -547,7 +581,9 @@ installStackBin :: ( MonadMask m
                     m
                     ()
 installStackBin ver = do
-  AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- lift ask
+  pfreq <- lift getPlatformReq
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+
  dlinfo <- lE $ getDownloadInfo Stack ver pfreq dls
  installStackBindist dlinfo ver

@@ -556,7 +592,10 @@ installStackBin ver = do
 -- argument instead of looking it up from 'GHCupDownloads'.
 installStackBindist :: ( MonadMask m
                       , MonadCatch m
-                       , MonadReader AppState m
+                       , MonadReader env m
+                       , HasPlatformReq env
+                       , HasDirs env
+                       , HasSettings env
                       , MonadLogger m
                       , MonadResource m
                       , MonadIO m
@@ -583,10 +622,9 @@ installStackBindist :: ( MonadMask m
 installStackBindist dlinfo ver = do
  lift $ $(logDebug) [i|Requested to install stack version #{ver}|]

-  AppState { dirs = dirs@Dirs {..}
-           , pfreq = PlatformRequest {..}
-           , settings
-           } <- lift ask
+  PlatformRequest {..} <- lift getPlatformReq
+  dirs@Dirs {..} <- lift getDirs
+  settings <- lift getSettings

  whenM (lift (stackInstalled ver))
    (throwE $ AlreadyInstalled Stack ver)
@@ -644,7 +682,8 @@ installStackBindist dlinfo ver = do
 --
 -- Additionally creates a @~\/.ghcup\/share -> ~\/.ghcup\/ghc\/\<ver\>\/share symlink@
 -- for 'SetGHCOnly' constructor.
-setGHC :: ( MonadReader AppState m
+setGHC :: ( MonadReader env m
+          , HasDirs env
          , MonadLogger m
          , MonadThrow m
          , MonadFail m
@@ -663,7 +702,7 @@ setGHC ver sghc = do
  whenM (lift $ not <$> ghcInstalled ver) (throwE (NotInstalled GHC ver))

  -- symlink destination
-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..} <- lift getDirs

  -- first delete the old symlinks (this fixes compatibility issues
  -- with old ghcup)
@@ -701,12 +740,15 @@ setGHC ver sghc = do

 where

-  symlinkShareDir :: (MonadReader AppState m, MonadIO m, MonadLogger m)
+  symlinkShareDir :: ( MonadReader env m
+                     , HasDirs env
+                     , MonadIO m
+                     , MonadLogger m)
                  => FilePath
                  -> String
                  -> m ()
  symlinkShareDir ghcdir ver' = do
-    AppState { dirs = Dirs {..} } <- ask
+    Dirs {..} <- getDirs
    let destdir = baseDir
    case sghc of
      SetGHCOnly -> do
@@ -733,7 +775,8 @@ setGHC ver sghc = do

 -- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
 setCabal :: ( MonadMask m
-            , MonadReader AppState m
+            , MonadReader env m
+            , HasDirs env
            , MonadLogger m
            , MonadThrow m
            , MonadFail m
@@ -745,7 +788,7 @@ setCabal ver = do
  let targetFile = "cabal-" <> T.unpack (prettyVer ver) <> exeExt

  -- symlink destination
-  AppState {dirs = Dirs {..}} <- lift ask
+  Dirs {..} <- lift getDirs

  whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
    $ throwE
@@ -764,7 +807,8 @@ setCabal ver = do

 -- | Set the haskell-language-server symlinks.
 setHLS :: ( MonadCatch m
-          , MonadReader AppState m
+          , MonadReader env m
+          , HasDirs env
          , MonadLogger m
          , MonadThrow m
          , MonadFail m
@@ -775,7 +819,7 @@ setHLS :: ( MonadCatch m
       => Version
       -> Excepts '[NotInstalled] m ()
 setHLS ver = do
-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..} <- lift getDirs

  -- Delete old symlinks, since these might have different ghc versions than the
  -- selected version, so we could end up with stray or incorrect symlinks.
@@ -804,7 +848,8 @@ setHLS ver = do

 -- | Set the @~\/.ghcup\/bin\/stack@ symlink.
 setStack :: ( MonadMask m
-            , MonadReader AppState m
+            , MonadReader env m
+            , HasDirs env
            , MonadLogger m
            , MonadThrow m
            , MonadFail m
@@ -817,7 +862,7 @@ setStack ver = do
  let targetFile = "stack-" <> T.unpack (prettyVer ver) <> exeExt

  -- symlink destination
-  AppState {dirs = Dirs {..}} <- lift ask
+  Dirs {..} <- lift getDirs

  whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
    $ throwE
@@ -872,7 +917,10 @@ listVersions :: ( MonadCatch m
                , MonadThrow m
                , MonadLogger m
                , MonadIO m
-                , MonadReader AppState m
+                , MonadReader env m
+                , HasDirs env
+                , HasPlatformReq env
+                , HasGHCupInfo env
                )
             => Maybe Tool
             -> Maybe ListCriteria
@@ -891,7 +939,7 @@ listVersions lt' criteria = do
  go lt cSet cabals hlsSet' hlses sSet stacks = do
    case lt of
      Just t -> do
-        AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
+        GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
        -- get versions from GHCupDownloads
        let avTools = availableToolVersions dls t
        lr <- filter' <$> forM (Map.toList avTools) (toListResult t cSet cabals hlsSet' hlses sSet stacks)
@@ -917,7 +965,13 @@ listVersions lt' criteria = do
        ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses sSet stacks
        stackvers <- go (Just Stack) cSet cabals hlsSet' hlses sSet stacks
        pure (ghcvers <> cabalvers <> hlsvers <> stackvers <> ghcupvers)
-  strayGHCs :: (MonadCatch m, MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m)
+  strayGHCs :: ( MonadCatch m
+               , MonadReader env m
+               , HasDirs env
+               , MonadThrow m
+               , MonadLogger m
+               , MonadIO m
+               )
            => Map.Map Version [Tag]
            -> m [ListResult]
  strayGHCs avTools = do
@@ -959,7 +1013,13 @@ listVersions lt' criteria = do
          [i|Could not parse version of stray directory #{e}|]
        pure Nothing

-  strayCabals :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
+  strayCabals :: ( MonadReader env m
+                 , HasDirs env
+                 , MonadCatch m
+                 , MonadThrow m
+                 , MonadLogger m
+                 , MonadIO m
+                 )
            => Map.Map Version [Tag]
            -> Maybe Version
            -> [Either FilePath Version]
@@ -988,7 +1048,12 @@ listVersions lt' criteria = do
          [i|Could not parse version of stray directory #{e}|]
        pure Nothing

-  strayHLS :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
+  strayHLS :: ( MonadReader env m
+              , HasDirs env
+              , MonadCatch m
+              , MonadThrow m
+              , MonadLogger m
+              , MonadIO m)
           => Map.Map Version [Tag]
           -> m [ListResult]
  strayHLS avTools = do
@@ -1016,7 +1081,13 @@ listVersions lt' criteria = do
          [i|Could not parse version of stray directory #{e}|]
        pure Nothing

-  strayStacks :: (MonadReader AppState m, MonadCatch m, MonadThrow m, MonadLogger m, MonadIO m)
+  strayStacks :: ( MonadReader env m
+                 , HasDirs env
+                 , MonadCatch m
+                 , MonadThrow m
+                 , MonadLogger m
+                 , MonadIO m
+                 )
              => Map.Map Version [Tag]
              -> m [ListResult]
  strayStacks avTools = do
@@ -1045,7 +1116,14 @@ listVersions lt' criteria = do
        pure Nothing

  -- NOTE: this are not cross ones, because no bindists
-  toListResult :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
+  toListResult :: ( MonadLogger m
+                  , MonadReader env m
+                  , HasDirs env
+                  , HasGHCupInfo env
+                  , HasPlatformReq env
+                  , MonadIO m
+                  , MonadCatch m
+                  )
               => Tool
               -> Maybe Version
               -> [Either FilePath Version]
@@ -1056,8 +1134,8 @@ listVersions lt' criteria = do
               -> (Version, [Tag])
               -> m ListResult
  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, tags) = do
-    AppState { pfreq
-             , ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
+    pfreq <- getPlatformReq
+    GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo

    case t of
      GHC -> do
@@ -1140,7 +1218,8 @@ listVersions lt' criteria = do
 -- This may leave GHCup without a "set" version.
 -- Will try to fix the ghc-x.y symlink after removal (e.g. to an
 -- older version).
-rmGHCVer :: ( MonadReader AppState m
+rmGHCVer :: ( MonadReader env m
+            , HasDirs env
            , MonadThrow m
            , MonadLogger m
            , MonadIO m
@@ -1181,7 +1260,7 @@ rmGHCVer ver = do
  forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
    >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)

-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..} <- lift getDirs

  liftIO
    $ hideError doesNotExistErrorType
@@ -1191,7 +1270,8 @@ rmGHCVer ver = do
 -- | Delete a cabal version. Will try to fix the @cabal@ symlink
 -- after removal (e.g. setting it to an older version).
 rmCabalVer :: ( MonadMask m
-              , MonadReader AppState m
+              , MonadReader env m
+              , HasDirs env
              , MonadThrow m
              , MonadLogger m
              , MonadIO m
@@ -1206,7 +1286,7 @@ rmCabalVer ver = do

  cSet      <- lift cabalSet

-  AppState {dirs = Dirs {..}} <- lift ask
+  Dirs {..} <- lift getDirs

  let cabalFile = "cabal-" <> T.unpack (prettyVer ver) <> exeExt
  liftIO $ hideError doesNotExistErrorType $ rmFile (binDir </> cabalFile)
@@ -1221,7 +1301,8 @@ rmCabalVer ver = do
 -- | Delete a hls version. Will try to fix the hls symlinks
 -- after removal (e.g. setting it to an older version).
 rmHLSVer :: ( MonadMask m
-            , MonadReader AppState m
+            , MonadReader env m
+            , HasDirs env
            , MonadThrow m
            , MonadLogger m
            , MonadIO m
@@ -1236,7 +1317,7 @@ rmHLSVer ver = do

  isHlsSet      <- lift hlsSet

-  AppState {dirs = Dirs {..}} <- lift ask
+  Dirs {..} <- lift getDirs

  bins <- lift $ hlsAllBinaries ver
  forM_ bins $ \f -> liftIO $ rmFile (binDir </> f)
@@ -1258,7 +1339,8 @@ rmHLSVer ver = do
 -- | Delete a stack version. Will try to fix the @stack@ symlink
 -- after removal (e.g. setting it to an older version).
 rmStackVer :: ( MonadMask m
-              , MonadReader AppState m
+              , MonadReader env m
+              , HasDirs env
              , MonadThrow m
              , MonadLogger m
              , MonadIO m
@@ -1273,7 +1355,7 @@ rmStackVer ver = do

  sSet      <- lift stackSet

-  AppState {dirs = Dirs {..}} <- lift ask
+  Dirs {..} <- lift getDirs

  let stackFile = "stack-" <> T.unpack (prettyVer ver) <> exeExt
  liftIO $ hideError doesNotExistErrorType $ rmFile (binDir </> stackFile)
@@ -1286,15 +1368,15 @@ rmStackVer ver = do


 -- assuming the current scheme of having just 1 ghcup bin, no version info is required.
-rmGhcup :: ( MonadReader AppState m
+rmGhcup :: ( MonadReader env m
+           , HasDirs env
           , MonadIO m
           , MonadCatch m
           , MonadLogger m
           )
        => m ()
-
 rmGhcup = do
-  AppState {dirs = Dirs {binDir}} <- ask
+  Dirs {binDir} <- getDirs
  let ghcupFilename = "ghcup" <> exeExt
  let ghcupFilepath = binDir </> ghcupFilename

@@ -1338,14 +1420,14 @@ rmGhcup = do
      <> path <>
      "\n you may have to uninstall it manually."

-rmTool :: ( MonadReader AppState m
-           , MonadLogger m
-           , MonadFail m
-           , MonadMask m
-           , MonadUnliftIO m)
-           => ListResult
-           -> Excepts '[NotInstalled ] m ()
-
+rmTool :: ( MonadReader env m
+          , HasDirs env
+          , MonadLogger m
+          , MonadFail m
+          , MonadMask m
+          , MonadUnliftIO m)
+          => ListResult
+          -> Excepts '[NotInstalled ] m ()
 rmTool ListResult {lVer, lTool, lCross} = do
  case lTool of
    GHC ->
@@ -1357,7 +1439,8 @@ rmTool ListResult {lVer, lTool, lCross} = do
    GHCup -> lift rmGhcup


-rmGhcupDirs :: ( MonadReader AppState m
+rmGhcupDirs :: ( MonadReader env m
+               , HasDirs env
               , MonadIO m
               , MonadLogger m
               , MonadCatch m
@@ -1369,7 +1452,7 @@ rmGhcupDirs = do
    , binDir
    , logsDir
    , cacheDir
-    } <- asks dirs
+    } <- getDirs

  let envFilePath = baseDir </> "env"

@@ -1477,13 +1560,20 @@ rmGhcupDirs = do
    ------------------


-getDebugInfo :: (Alternative m, MonadFail m, MonadReader AppState m, MonadLogger m, MonadCatch m, MonadIO m)
+getDebugInfo :: ( Alternative m
+                , MonadFail m
+                , MonadReader env m
+                , HasDirs env
+                , MonadLogger m
+                , MonadCatch m
+                , MonadIO m
+                )
             => Excepts
                  '[NoCompatiblePlatform , NoCompatibleArch , DistroNotFound]
                  m
                  DebugInfo
 getDebugInfo = do
-  AppState {dirs = Dirs {..}} <- lift ask
+  Dirs {..} <- lift getDirs
  let diBaseDir  = baseDir
  let diBinDir   = binDir
  diGHCDir       <- lift ghcupGHCBaseDir
@@ -1503,7 +1593,11 @@ getDebugInfo = do
 -- | Compile a GHC from source. This behaves wrt symlinks and installation
 -- the same as 'installGHCBin'.
 compileGHC :: ( MonadMask m
-              , MonadReader AppState m
+              , MonadReader env m
+              , HasDirs env
+              , HasPlatformReq env
+              , HasGHCupInfo env
+              , HasSettings env
              , MonadThrow m
              , MonadResource m
              , MonadLogger m
@@ -1538,10 +1632,11 @@ compileGHC :: ( MonadMask m
                GHCTargetVersion
 compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs
  = do
-    AppState { pfreq = PlatformRequest {..}
-             , ghcupInfo = GHCupInfo { _ghcupDownloads = dls }
-             , settings
-             , dirs } <- lift ask
+    PlatformRequest { .. } <- lift getPlatformReq
+    GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+    settings <- lift getSettings
+    dirs <- lift getDirs
+
    (workdir, tmpUnpack, tver) <- case targetGhc of
      -- unpack from version tarball
      Left tver -> do
@@ -1662,7 +1757,10 @@ BUILD_SPHINX_HTML = NO
 BUILD_SPHINX_PDF = NO
 HADDOCK_DOCS = YES|]

-  compileBindist :: ( MonadReader AppState m
+  compileBindist :: ( MonadReader env m
+                    , HasDirs env
+                    , HasSettings env
+                    , HasPlatformReq env
                    , MonadThrow m
                    , MonadCatch m
                    , MonadLogger m
@@ -1680,8 +1778,9 @@ HADDOCK_DOCS = YES|]
  compileBindist bghc tver workdir ghcdir = do
    lift $ $(logInfo) [i|configuring build|]
    liftE checkBuildConfig
-
-    AppState { dirs = Dirs {..}, pfreq } <- lift ask
+    
+    Dirs {..} <- lift getDirs
+    pfreq <- lift getPlatformReq

    forM_ patchdir $ \dir -> liftE $ applyPatches dir workdir

@@ -1805,7 +1904,11 @@ HADDOCK_DOCS = YES|]
 -- | Upgrade ghcup and place it in @~\/.ghcup\/bin\/ghcup@,
 -- if no path is provided.
 upgradeGHCup :: ( MonadMask m
-                , MonadReader AppState m
+                , MonadReader env m
+                , HasDirs env
+                , HasPlatformReq env
+                , HasGHCupInfo env
+                , HasSettings env
                , MonadCatch m
                , MonadLogger m
                , MonadThrow m
@@ -1826,10 +1929,11 @@ upgradeGHCup :: ( MonadMask m
                  m
                  Version
 upgradeGHCup mtarget force' = do
-  AppState { dirs = Dirs {..}
-           , pfreq
-           , ghcupInfo = GHCupInfo { _ghcupDownloads = dls }
-           , settings } <- lift ask
+  Dirs {..} <- lift getDirs
+  pfreq <- lift getPlatformReq
+  settings <- lift getSettings
+  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+
  lift $ $(logInfo) [i|Upgrading GHCup...|]
  let latestVer = fromJust $ fst <$> getLatest dls GHCup
  when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
@@ -1878,7 +1982,8 @@ upgradeGHCup mtarget force' = do

 -- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
 -- both installing from source and bindist.
-postGHCInstall :: ( MonadReader AppState m
+postGHCInstall :: ( MonadReader env m
+                  , HasDirs env
                  , MonadLogger m
                  , MonadThrow m
                  , MonadFail m
@@ -1909,7 +2014,8 @@ postGHCInstall ver@GHCTargetVersion {..} = do
 --   * for hls, this reports @~\/.ghcup\/bin\/haskell-language-server-wrapper-\<ver\>@
 --   * for stack, this reports @~\/.ghcup\/bin\/stack-\<ver\>@
 --   * for ghcup, this reports the location of the currently running executable
-whereIsTool :: ( MonadReader AppState m
+whereIsTool :: ( MonadReader env m
+               , HasDirs env
               , MonadLogger m
               , MonadThrow m
               , MonadFail m
@@ -1922,7 +2028,7 @@ whereIsTool :: ( MonadReader AppState m
            -> GHCTargetVersion
            -> Excepts '[NotInstalled] m FilePath
 whereIsTool tool ver@GHCTargetVersion {..} = do
-  AppState { dirs } <- lift ask
+  dirs <- lift getDirs

  case tool of
    GHC -> do
@@ -1946,3 +2052,6 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
    GHCup -> do
      currentRunningExecPath <- liftIO getExecutablePath
      liftIO $ canonicalizePath currentRunningExecPath
+
+
+
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@@ -1,9 +1,12 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DuplicateRecordFields #-}

 {-|
 Module      : GHCup.Types
@@ -346,8 +349,14 @@ data AppState = AppState
  { settings :: Settings
  , dirs :: Dirs
  , keyBindings :: KeyBindings
-  , ghcupInfo :: ~GHCupInfo
-  , pfreq :: ~PlatformRequest
+  , ghcupInfo :: GHCupInfo
+  , pfreq :: PlatformRequest
+  } deriving (Show, GHC.Generic)
+
+data LeanAppState = LeanAppState
+  { settings :: Settings
+  , dirs :: Dirs
+  , keyBindings :: KeyBindings
  } deriving (Show, GHC.Generic)

 instance NFData AppState
@@ -507,4 +516,3 @@ instance (Monad m, Alternative m) => Alternative (LoggingT m) where
 instance MonadLogger m => MonadLogger (Excepts e m) where
  monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d

-
--- a/lib/GHCup/Types/Optics.hs
+++ b/lib/GHCup/Types/Optics.hs
@@ -1,4 +1,9 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE AllowAmbiguousTypes   #-}

 {-|
 Module      : GHCup.Types.Optics
@@ -13,6 +18,7 @@ module GHCup.Types.Optics where

 import           GHCup.Types

+import           Control.Monad.Reader
 import           Data.ByteString                ( ByteString )
 import           Optics
 import           URI.ByteString
@@ -58,3 +64,82 @@ pathL' = lensVL pathL

 queryL' :: Lens' (URIRef a) Query
 queryL' = lensVL queryL
+
+
+
+    ----------------------
+    --[ Lens utilities ]--
+    ----------------------
+
+
+gets :: forall f a env m . (MonadReader env m, LabelOptic' f A_Lens env a)
+     => m a
+gets = asks (^. labelOptic @f)
+
+
+getAppState :: MonadReader AppState m => m AppState
+getAppState = ask
+
+
+getLeanAppState :: ( MonadReader env m
+                   , LabelOptic' "settings"    A_Lens env Settings
+                   , LabelOptic' "dirs"        A_Lens env Dirs
+                   , LabelOptic' "keyBindings" A_Lens env KeyBindings
+                   )
+                => m LeanAppState
+getLeanAppState = do
+  s <- gets @"settings"
+  d <- gets @"dirs"
+  k <- gets @"keyBindings"
+  pure (LeanAppState s d k)
+
+
+getSettings :: ( MonadReader env m
+               , LabelOptic' "settings" A_Lens env Settings
+               )
+            => m Settings
+getSettings = gets @"settings"
+
+
+getDirs :: ( MonadReader env m
+           , LabelOptic' "dirs" A_Lens env Dirs
+           )
+        => m Dirs
+getDirs = gets @"dirs"
+
+
+getKeyBindings :: ( MonadReader env m
+                  , LabelOptic' "keyBindings" A_Lens env KeyBindings
+                  )
+               => m KeyBindings
+getKeyBindings = gets @"keyBindings"
+
+
+getGHCupInfo :: ( MonadReader env m
+                , LabelOptic' "ghcupInfo" A_Lens env GHCupInfo
+                )
+             => m GHCupInfo
+getGHCupInfo = gets @"ghcupInfo"
+
+
+getPlatformReq :: ( MonadReader env m
+                  , LabelOptic' "pfreq" A_Lens env PlatformRequest
+                  )
+               => m PlatformRequest
+getPlatformReq = gets @"pfreq"
+
+
+type HasSettings env = (LabelOptic' "settings" A_Lens env Settings)
+type HasDirs env = (LabelOptic' "dirs" A_Lens env Dirs)
+type HasKeyBindings env = (LabelOptic' "keyBindings" A_Lens env KeyBindings)
+type HasGHCupInfo env = (LabelOptic' "ghcupInfo" A_Lens env GHCupInfo)
+type HasPlatformReq env = (LabelOptic' "pfreq" A_Lens env PlatformRequest)
+
+
+getCache :: (MonadReader env m, HasSettings env) => m Bool
+getCache = getSettings <&> cache
+
+
+getDownloader :: (MonadReader env m, HasSettings env) => m Downloader
+getDownloader = getSettings <&> downloader
+
--- a/lib/GHCup/Utils.hs
+++ b/lib/GHCup/Utils.hs
@@ -103,28 +103,30 @@ import qualified Text.Megaparsec               as MP


 -- | The symlink destination of a ghc tool.
-ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m)
+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
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  ghcd <- ghcupGHCDir ver
  pure (relativeSymlink binDir (ghcd </> "bin" </> tool))


 -- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
-rmMinorSymlinks :: ( MonadReader AppState m
+rmMinorSymlinks :: ( MonadReader env m
+                   , HasDirs env
                   , MonadIO m
                   , MonadLogger m
                   , MonadThrow m
                   , MonadFail m
-                   , MonadReader AppState m
                   )
                => GHCTargetVersion
                -> Excepts '[NotInstalled] m ()
 rmMinorSymlinks tv@GHCTargetVersion{..} = do
-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..}  <- lift getDirs

  files                         <- liftE $ ghcToolFiles tv
  forM_ files $ \f -> do
@@ -135,7 +137,8 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do


 -- | Removes the set ghc version for the given target, if any.
-rmPlain :: ( MonadReader AppState m
+rmPlain :: ( MonadReader env m
+           , HasDirs env
           , MonadLogger m
           , MonadThrow m
           , MonadFail m
@@ -144,7 +147,7 @@ rmPlain :: ( MonadReader AppState m
        => Maybe Text -- ^ target
        -> Excepts '[NotInstalled] m ()
 rmPlain target = do
-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..}  <- lift getDirs
  mtv                           <- lift $ ghcSet target
  forM_ mtv $ \tv -> do
    files <- liftE $ ghcToolFiles tv
@@ -159,17 +162,17 @@ rmPlain target = do


 -- | Remove the major GHC symlink, e.g. ghc-8.6.
-rmMajorSymlinks :: ( MonadReader AppState m
+rmMajorSymlinks :: ( MonadReader env m
+                   , HasDirs env
                   , MonadIO m
                   , MonadLogger m
                   , MonadThrow m
                   , MonadFail m
-                   , MonadReader AppState m
                   )
                => GHCTargetVersion
                -> Excepts '[NotInstalled] m ()
 rmMajorSymlinks tv@GHCTargetVersion{..} = do
-  AppState { dirs = Dirs {..} } <- lift ask
+  Dirs {..}  <- lift getDirs
  (mj, mi) <- getMajorMinorV _tvVersion
  let v' = intToText mj <> "." <> intToText mi

@@ -189,26 +192,26 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do


 -- | Whether the given GHC versin is installed.
-ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
+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 AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
+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 AppState m, MonadThrow m, MonadIO m)
+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
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..}  <- getDirs
  let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
  let ghcBin = binDir </> ghc <> exeExt

@@ -239,7 +242,7 @@ ghcSet mtarget = do

 -- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
 -- If a dir cannot be parsed, returns left.
-getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either FilePath GHCTargetVersion]
+getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
 getInstalledGHCs = do
  ghcdir <- ghcupGHCBaseDir
  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory ghcdir
@@ -249,10 +252,15 @@ getInstalledGHCs = do


 -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
-getInstalledCabals :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
+getInstalledCabals :: ( MonadLogger m
+                      , MonadReader env m
+                      , HasDirs env
+                      , MonadIO m
+                      , MonadCatch m
+                      )
                   => m [Either FilePath Version]
 getInstalledCabals = do
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..} <- getDirs
  bins   <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
@@ -264,16 +272,16 @@ getInstalledCabals = do


 -- | Whether the given cabal version is installed.
-cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
+cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 cabalInstalled ver = do
  vers <- fmap rights getInstalledCabals
  pure $ elem ver vers


 -- Return the currently set cabal version, if any.
-cabalSet :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+cabalSet :: (MonadLogger m, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 cabalSet = do
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..}  <- getDirs
  let cabalbin = binDir </> "cabal" <> exeExt

  handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -317,10 +325,10 @@ cabalSet = do

 -- | Get all installed hls, by matching on
 -- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
-getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m)
+getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
                 => m [Either FilePath Version]
 getInstalledHLSs = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts compExtended
@@ -337,10 +345,10 @@ getInstalledHLSs = do

 -- | Get all installed stacks, by matching on
 -- @~\/.ghcup\/bin/stack-<\stackver\>@.
-getInstalledStacks :: (MonadReader AppState m, MonadIO m, MonadCatch m)
+getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
                   => m [Either FilePath Version]
 getInstalledStacks = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts compExtended
@@ -355,9 +363,9 @@ getInstalledStacks = do

 -- Return the currently set stack version, if any.
 -- TODO: there's a lot of code duplication here :>
-stackSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
+stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => m (Maybe Version)
 stackSet = do
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..}  <- getDirs
  let stackBin = binDir </> "stack" <> exeExt

  handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -395,13 +403,13 @@ stackSet = do
    stripRelativePath = MP.many (MP.try stripPathComponet)

 -- | Whether the given Stack version is installed.
-stackInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
+stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 stackInstalled ver = do
  vers <- fmap rights getInstalledStacks
  pure $ elem ver vers

 -- | Whether the given HLS version is installed.
-hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
+hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
 hlsInstalled ver = do
  vers <- fmap rights getInstalledHLSs
  pure $ elem ver vers
@@ -409,9 +417,9 @@ hlsInstalled ver = do


 -- Return the currently set hls version, if any.
-hlsSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 hlsSet = do
-  AppState {dirs = Dirs {..}} <- ask
+  Dirs {..}  <- getDirs
  let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt

  liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
@@ -443,7 +451,8 @@ hlsSet = do


 -- | Return the GHC versions the currently selected HLS supports.
-hlsGHCVersions :: ( MonadReader AppState m
+hlsGHCVersions :: ( MonadReader env m
+                  , HasDirs env
                  , MonadIO m
                  , MonadThrow m
                  , MonadCatch m
@@ -466,11 +475,11 @@ hlsGHCVersions = do


 -- | Get all server binaries for an hls version, if any.
-hlsServerBinaries :: (MonadReader AppState m, MonadIO m)
+hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
                  => Version
                  -> m [FilePath]
 hlsServerBinaries ver = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts
@@ -482,12 +491,12 @@ hlsServerBinaries ver = do


 -- | Get the wrapper binary for an hls version, if any.
-hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m)
+hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
                 => Version
                 -> m (Maybe FilePath)
 hlsWrapperBinary ver = do
-  AppState { dirs = Dirs {..} } <- ask
-  wrapper                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
+  Dirs {..}  <- getDirs
+  wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts
      compExtended
@@ -503,7 +512,7 @@ hlsWrapperBinary ver = do


 -- | Get all binaries for an hls version, if any.
-hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [FilePath]
+hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
 hlsAllBinaries ver = do
  hls     <- hlsServerBinaries ver
  wrapper <- hlsWrapperBinary ver
@@ -511,9 +520,9 @@ hlsAllBinaries ver = do


 -- | Get the active symlinks for hls.
-hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [FilePath]
+hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
 hlsSymlinks = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  oldSyms                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
    binDir
    (makeRegexOpts compExtended
@@ -549,7 +558,7 @@ matchMajor v' major' minor' = case getMajorMinorV v' of

 -- | Get the latest installed full GHC version that satisfies X.Y.
 -- This reads `ghcupGHCBaseDir`.
-getGHCForMajor :: (MonadReader AppState m, MonadIO m, MonadThrow m)
+getGHCForMajor :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
               => Int        -- ^ major version component
               -> Int        -- ^ minor version component
               -> Maybe Text -- ^ the target triple
@@ -729,19 +738,6 @@ getLatestBaseVersion av pvpVer =



-    -----------------------
-    --[ AppState Getter ]--
-    -----------------------
-
-
-getCache :: MonadReader AppState m => m Bool
-getCache = ask <&> cache . settings
-
-
-getDownloader :: MonadReader AppState m => m Downloader
-getDownloader = ask <&> downloader . settings
-
-

    -------------
    --[ Other ]--
@@ -754,7 +750,7 @@ getDownloader = ask <&> downloader . settings
 -- Returns unversioned relative files without extension, e.g.:
 --
 --   - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
-ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m)
+ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
             => GHCTargetVersion
             -> Excepts '[NotInstalled] m [FilePath]
 ghcToolFiles ver = do
@@ -817,7 +813,12 @@ ghcUpSrcBuiltFile = ".ghcup_src_built"


 -- | Calls gmake if it exists in PATH, otherwise make.
-make :: (MonadThrow m, MonadIO m, MonadReader AppState m)
+make :: ( MonadThrow m
+        , MonadIO m
+        , MonadReader env m
+        , HasDirs env
+        , HasSettings env
+        )
     => [String]
     -> Maybe FilePath
     -> m (Either ProcessError ())
@@ -827,7 +828,7 @@ make args workdir = do
  let mymake = if has_gmake then "gmake" else "make"
  execLogged mymake args workdir "ghc-make" Nothing

-makeOut :: (MonadReader AppState m, MonadIO m)
+makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
        => [String]
        -> Maybe FilePath
        -> m CapturedProcess
@@ -840,7 +841,7 @@ makeOut args workdir = do

 -- | Try to apply patches in order. Fails with 'PatchFailed'
 -- on first failure.
-applyPatches :: (MonadReader AppState m, MonadLogger m, MonadIO m)
+applyPatches :: (MonadReader env m, HasDirs env, MonadLogger m, MonadIO m)
             => FilePath   -- ^ dir containing patches
             -> FilePath   -- ^ dir to apply patches in
             -> Excepts '[PatchFailed] m ()
@@ -858,7 +859,7 @@ applyPatches pdir ddir = do


 -- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
-darwinNotarization :: (MonadReader AppState m, MonadIO m)
+darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
                   => Platform
                   -> FilePath
                   -> m (Either ProcessError ())
@@ -881,13 +882,13 @@ getChangeLog dls tool (Right tag) =
 --
 --   1. the build directory, depending on the KeepDirs setting
 --   2. the install destination, depending on whether the build failed
-runBuildAction :: (Show (V e), MonadReader AppState m, MonadIO m, MonadMask m)
+runBuildAction :: (Show (V e), MonadReader env m, HasDirs env, HasSettings env, MonadIO m, MonadMask m)
               => FilePath          -- ^ build directory (cleaned up depending on Settings)
               -> Maybe FilePath  -- ^ dir to *always* clean up on exception
               -> Excepts e m a
               -> Excepts '[BuildFailed] m a
 runBuildAction bdir instdir action = do
-  AppState { settings = Settings {..} } <- lift ask
+  Settings {..} <- lift getSettings
  let exAction = do
        forM_ instdir $ \dir ->
          liftIO $ hideError doesNotExistErrorType $ rmPath dir
@@ -1016,7 +1017,8 @@ createLink :: ( MonadMask m
              , MonadThrow m
              , MonadLogger m
              , MonadIO m
-              , MonadReader AppState m
+              , MonadReader env m
+              , HasDirs env
              , MonadUnliftIO m
              , MonadFail m
              )
@@ -1025,7 +1027,7 @@ createLink :: ( MonadMask m
           -> m ()
 createLink link exe = do
 #if defined(IS_WINDOWS)
-  AppState { dirs } <- ask
+  dirs <- getDirs
  let shimGen = cacheDir dirs </> "gs.exe"

  let shim = dropExtension exe <.> "shim"
@@ -1054,14 +1056,19 @@ ensureGlobalTools :: ( MonadMask m
                     , MonadThrow m
                     , MonadLogger m
                     , MonadIO m
-                     , MonadReader AppState m
+                     , MonadReader env m
+                     , HasDirs env
+                     , HasSettings env
+                     , HasGHCupInfo env
                     , MonadUnliftIO m
                     , MonadFail m
                     )
                  => Excepts '[DigestError , DownloadFailed, NoDownload] m ()
 ensureGlobalTools = do
 #if defined(IS_WINDOWS)
-  AppState { ghcupInfo = GHCupInfo _ _ gTools, settings, dirs } <- lift ask
+  (GHCupInfo _ _ gTools) <- lift getGHCupInfo
+  settings <- lift getSettings
+  dirs <- lift getDirs
  shimDownload <- liftE $ lE @_ @'[NoDownload]
    $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
  let dl = downloadCached' settings dirs shimDownload (Just "gs.exe")
--- a/lib/GHCup/Utils/Dirs.hs
+++ b/lib/GHCup/Utils/Dirs.hs
@@ -16,7 +16,7 @@ Stability   : experimental
 Portability : portable
 -}
 module GHCup.Utils.Dirs
-  ( getDirs
+  ( getAllDirs
  , ghcupBaseDir
  , ghcupConfigFile
  , ghcupCacheDir
@@ -37,6 +37,7 @@ where
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.JSON               ( )
+import           GHCup.Types.Optics
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude

@@ -190,8 +191,8 @@ ghcupLogsDir = do
 #endif


-getDirs :: IO Dirs
-getDirs = do
+getAllDirs :: IO Dirs
+getAllDirs = do
  baseDir  <- ghcupBaseDir
  binDir   <- ghcupBinDir
  cacheDir <- ghcupCacheDir
@@ -226,9 +227,9 @@ ghcupConfigFile = do


 -- | ~/.ghcup/ghc by default.
-ghcupGHCBaseDir :: (MonadReader AppState m) => m FilePath
+ghcupGHCBaseDir :: (MonadReader env m, HasDirs env) => m FilePath
 ghcupGHCBaseDir = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..}  <- getDirs
  pure (baseDir </> "ghc")


@@ -236,7 +237,7 @@ ghcupGHCBaseDir = do
 -- The dir may be of the form
 --   * armv7-unknown-linux-gnueabihf-8.8.3
 --   * 8.8.4
-ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
+ghcupGHCDir :: (MonadReader env m, HasDirs env, MonadThrow m)
            => GHCTargetVersion
            -> m FilePath
 ghcupGHCDir ver = do
--- a/lib/GHCup/Utils/File/Posix.hs
+++ b/lib/GHCup/Utils/File/Posix.hs
@@ -21,6 +21,7 @@ module GHCup.Utils.File.Posix where
 import           GHCup.Utils.File.Common
 import           GHCup.Utils.Prelude
 import           GHCup.Types
+import           GHCup.Types.Optics

 import           Control.Concurrent
 import           Control.Concurrent.Async
@@ -74,7 +75,11 @@ executeOut path args chdir = liftIO $ captureOutStreams $ do
  SPP.executeFile path True args Nothing


-execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
+execLogged :: ( MonadReader env m
+              , HasSettings env
+              , HasDirs env
+              , MonadIO m
+              , MonadThrow m)
           => FilePath         -- ^ thing to execute
           -> [String]         -- ^ args for the thing
           -> Maybe FilePath   -- ^ optionally chdir into this
@@ -82,7 +87,8 @@ execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
           -> Maybe [(String, String)] -- ^ optional environment
           -> m (Either ProcessError ())
 execLogged exe args chdir lfile env = do
-  AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
+  Settings {..} <- getSettings
+  Dirs {..} <- getDirs
  let logfile = logsDir </> lfile <> ".log"
  liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
                   closeFd
--- a/lib/GHCup/Utils/File/Windows.hs
+++ b/lib/GHCup/Utils/File/Windows.hs
@@ -146,7 +146,11 @@ executeOut path args chdir = do
  pure $ CapturedProcess exit out err


-execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
+execLogged :: ( MonadReader env m
+              , HasDirs env
+              , HasSettings env
+              , MonadIO m
+              , MonadThrow m)
           => FilePath         -- ^ thing to execute
           -> [String]         -- ^ args for the thing
           -> Maybe FilePath   -- ^ optionally chdir into this
@@ -154,7 +158,7 @@ execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
           -> Maybe [(String, String)] -- ^ optional environment
           -> m (Either ProcessError ())
 execLogged exe args chdir lfile env = do
-  AppState { dirs = Dirs {..} } <- ask
+  Dirs {..} <- getDirs
  let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
      stderrLogfile = logsDir </> lfile <> ".stderr.log"
  cp <- createProcessWithMingwPath ((proc exe args)