Allow to configure ghcup with a yaml config file

Fixes #41

CHANGELOG.md

@@ -7,6 +7,7 @@
   - reverse list order so latest is on top
   - expand the blues selected bar
   - show new latest versions in bright white
+* allow configuration file and settings TUI hotkeys wrt #41
 
 ## 0.1.11 -- 2020-09-23
 

README.md

@@ -13,6 +13,7 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
      * [Manual install](#manual-install)
      * [Vim integration](#vim-integration)
    * [Usage](#usage)
+     * [Configuration](#configuration)
      * [Manpages](#manpages)
      * [Shell-completion](#shell-completion)
      * [Cross support](#cross-support)
@@ -80,6 +81,47 @@ ghcup upgrade
 Generally this is meant to be used with [`cabal-install`](https://hackage.haskell.org/package/cabal-install), which
 handles your haskell packages and can demand that [a specific version](https://cabal.readthedocs.io/en/latest/nix-local-build.html#cfg-flag---with-compiler)  of `ghc` is available, which `ghcup` can do.
 
+### Configuration
+
+A configuration file can be put in `~/.ghcup/config.yaml`. Here is the complete default
+configuration:
+
+```yaml
+# Cache downloads in ~/.ghcup/cache
+cache: False
+# Skip tarball checksum verification
+no-verify: False
+# enable verbosity
+verbose: False
+# When to keep build directories
+keep-dirs: Errors  # Always | Never | Errors
+# Which downloader to use
+downloader: Curl   # Curl | Wget | Internal
+
+# TUI key bindings,
+# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key
+# for possible values.
+key-bindings:
+  up:
+    KUp: []
+  down:
+    KDown: []
+  quit:
+    KChar: 'q'
+  install:
+    KChar: 'i'
+  uninstall:
+    KChar: 'u'
+  set:
+    KChar: 's'
+  changelog:
+    KChar: 'c'
+  show-all:
+    KChar: 'a'
+```
+
+Partial configuration is fine. Command line options always overwrite the config file settings.
+
 ### Manpages
 
 For man pages to work you need [man-db](http://man-db.nongnu.org/) as your `man` provider, then issue `man ghc`. Manpages only work for the currently set ghc.

app/ghcup-gen/Validate.hs

@@ -193,7 +193,7 @@ validateTarballs dls = do
  where
   downloadAll dli = do
     dirs <- liftIO getDirs
-    let settings = AppState (Settings True False Never Curl False) dirs
+    let settings = AppState (Settings True False Never Curl False) dirs defaultKeyBindings
     let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True
                                            , colorOutter  = B.hPut stderr
                                            , rawOutter    = (\_ -> pure ())

app/ghcup/BrickMain.hs

@@ -36,7 +36,6 @@ import           Data.Bool
 import           Data.Functor
 import           Data.List
 import           Data.Maybe
-import           Data.Char
 import           Data.IORef
 import           Data.String.Interpolate
 import           Data.Vector                    ( Vector
@@ -77,33 +76,44 @@ data BrickState = BrickState
   { appData     :: BrickData
   , appSettings :: BrickSettings
   , appState    :: BrickInternalState
+  , appKeys     :: KeyBindings
   }
   deriving Show
 
 
-keyHandlers :: [ ( Char
+keyHandlers :: KeyBindings
+            -> [ ( Vty.Key
                  , BrickSettings -> String
                  , BrickState -> EventM n (Next BrickState)
                  )
                ]
-keyHandlers =
+keyHandlers KeyBindings {..} =
-  [ ('q', const "Quit"     , halt)
+  [ (bQuit, const "Quit"     , halt)
-  , ('i', const "Install"  , withIOAction install')
+  , (bInstall, const "Install"  , withIOAction install')
-  , ('u', const "Uninstall", withIOAction del')
+  , (bUninstall, const "Uninstall", withIOAction del')
-  , ('s', const "Set"      , withIOAction set')
+  , (bSet, const "Set"      , withIOAction set')
-  , ('c', const "ChangeLog", withIOAction changelog')
+  , (bChangelog, const "ChangeLog", withIOAction changelog')
-  , ( 'a'
+  , ( bShowAll
     , (\BrickSettings {..} ->
         if showAll then "Hide old versions" else "Show all versions"
       )
     , hideShowHandler
     )
+  , (bUp, const "Up", \BrickState {..} -> continue (BrickState { appState = (moveCursor 1 appState Up), .. }))
+  , (bDown, const "Down", \BrickState {..} -> continue (BrickState { appState = (moveCursor 1 appState Down), .. }))
   ]
  where
   hideShowHandler (BrickState {..}) =
     let newAppSettings   = appSettings { showAll = not . showAll $ appSettings }
         newInternalState = constructList appData newAppSettings (Just appState)
-    in  continue (BrickState appData newAppSettings newInternalState)
+    in  continue (BrickState appData newAppSettings newInternalState appKeys)
+
+
+showKey :: Vty.Key -> String
+showKey (Vty.KChar c) = [c]
+showKey (Vty.KUp) = "↑"
+showKey (Vty.KDown) = "↓"
+showKey key = tail (show key)
 
 
 ui :: BrickState -> Widget String
@@ -122,8 +132,7 @@ ui BrickState { appSettings = as@(BrickSettings {}), ..}
       . txtWrap
       . T.pack
       . foldr1 (\x y -> x <> "  " <> y)
-      . (++ ["↑↓:Navigation"])
+      $ (fmap (\(key, s, _) -> (showKey key <> ":" <> s as)) $ keyHandlers appKeys)
-      $ (fmap (\(c, s, _) -> (c : ':' : s as)) keyHandlers)
   header =
     (minHSize 2 $ emptyWidget)
       <+> (padLeft (Pad 2) $ minHSize 6 $ str "Tool")
@@ -261,24 +270,30 @@ dimAttributes = attrMap
   , ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
   ]
 
+
 eventHandler :: BrickState -> BrickEvent n e -> EventM n (Next BrickState)
-eventHandler st (VtyEvent (Vty.EvResize _               _)) = continue st
+eventHandler st@(BrickState {..}) ev = do
-eventHandler st (VtyEvent (Vty.EvKey    (Vty.KChar 'q') _)) = halt st
+  AppState { keyBindings = kb } <- liftIO $ readIORef settings'
-eventHandler st (VtyEvent (Vty.EvKey    Vty.KEsc        _)) = halt st
+  case ev of
-eventHandler BrickState {..} (VtyEvent (Vty.EvKey (Vty.KUp) _)) =
+    (MouseDown _ Vty.BScrollUp _ _) ->
-  continue (BrickState { appState = (moveCursor appState Up), .. })
+      continue (BrickState { appState = moveCursor 1 appState Up, .. })
-eventHandler BrickState {..} (VtyEvent (Vty.EvKey (Vty.KDown) _)) =
+    (MouseDown _ Vty.BScrollDown _ _) ->
-  continue (BrickState { appState = (moveCursor appState Down), .. })
+      continue (BrickState { appState = moveCursor 1 appState Down, .. })
-eventHandler as (VtyEvent (Vty.EvKey (Vty.KChar c) _)) =
+    (VtyEvent (Vty.EvResize _ _)) -> continue st
-  case find (\(c', _, _) -> c' == c) keyHandlers of
+    (VtyEvent (Vty.EvKey Vty.KUp _)) ->
-    Nothing              -> continue as
+      continue (BrickState { appState = (moveCursor 1 appState Up), .. })
-    Just (_, _, handler) -> handler as
+    (VtyEvent (Vty.EvKey Vty.KDown _)) ->
-eventHandler st _ = continue st
+      continue (BrickState { appState = (moveCursor 1 appState Down), .. })
+    (VtyEvent (Vty.EvKey key _)) ->
+      case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
+        Nothing -> continue st
+        Just (_, _, handler) -> handler st
+    _ -> continue st
 
 
-moveCursor :: BrickInternalState -> Direction -> BrickInternalState
+moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
-moveCursor ais@(BrickInternalState {..}) direction =
+moveCursor steps ais@(BrickInternalState {..}) direction =
-  let newIx = if direction == Down then ix + 1 else ix - 1
+  let newIx = if direction == Down then ix + steps else ix - steps
   in  case clr !? newIx of
         Just _  -> BrickInternalState { ix = newIx, .. }
         Nothing -> ais
@@ -310,9 +325,10 @@ updateList :: BrickData -> BrickState -> BrickState
 updateList appD (BrickState {..}) =
   let newInternalState = constructList appD appSettings (Just appState)
   in  BrickState { appState    = newInternalState
-               , appData     = appD
+                 , appData     = appD
-               , appSettings = appSettings
+                 , appSettings = appSettings
-               }
+                 , appKeys     = appKeys
+                 }
 
 
 constructList :: BrickData
@@ -481,6 +497,7 @@ settings' = unsafePerformIO $ do
                                 , ..
                                 })
                       dirs
+                      defaultKeyBindings
 
 
 
@@ -515,6 +532,8 @@ brickMain s muri l av pfreq' = do
           (BrickState ad
                     defaultAppSettings
                     (constructList ad defaultAppSettings Nothing)
+                    (keyBindings s)
+
           )
         $> ()
     Left e -> do

app/ghcup/Main.hs

@@ -81,12 +81,12 @@ import qualified Text.Megaparsec.Char          as MPC
 data Options = Options
   {
   -- global options
-    optVerbose   :: Bool
+    optVerbose   :: Maybe Bool
-  , optCache     :: Bool
+  , optCache     :: Maybe Bool
   , optUrlSource :: Maybe URI
-  , optNoVerify  :: Bool
+  , optNoVerify  :: Maybe Bool
-  , optKeepDirs  :: KeepDirs
+  , optKeepDirs  :: Maybe KeepDirs
-  , optsDownloader :: Downloader
+  , optsDownloader :: Maybe Downloader
   -- commands
   , optCommand   :: Command
   }
@@ -180,13 +180,48 @@ data ChangeLogOptions = ChangeLogOptions
   }
 
 
+-- https://github.com/pcapriotti/optparse-applicative/issues/148
+
+-- | A switch that can be enabled using --foo and disabled using --no-foo.
+--
+-- The option modifier is applied to only the option that is *not* enabled
+-- by default. For example:
+--
+-- > invertableSwitch "recursive" True (help "do not recurse into directories")
+-- 
+-- This example makes --recursive enabled by default, so 
+-- the help is shown only for --no-recursive.
+invertableSwitch 
+    :: String              -- ^ long option
+    -> Char                -- ^ short option for the non-default option
+    -> Bool                -- ^ is switch enabled by default?
+    -> Mod FlagFields Bool -- ^ option modifier
+    -> Parser (Maybe Bool)
+invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shortopt defv
+    (if defv then mempty else optmod)
+    (if defv then optmod else mempty)
+
+-- | Allows providing option modifiers for both --foo and --no-foo.
+invertableSwitch'
+    :: String              -- ^ long option (eg "foo")
+    -> Char                -- ^ short option for the non-default option
+    -> Bool                -- ^ is switch enabled by default?
+    -> Mod FlagFields Bool -- ^ option modifier for --foo
+    -> Mod FlagFields Bool -- ^ option modifier for --no-foo
+    -> Parser (Maybe Bool)
+invertableSwitch' longopt shortopt defv enmod dismod = optional
+    ( flag' True (enmod <> long longopt <> if defv then mempty else short shortopt)
+    <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
+    )
+  where
+    nolongopt = "no-" ++ longopt
+
+
 opts :: Parser Options
 opts =
   Options
-    <$> switch (short 'v' <> long "verbose" <> help "Enable verbosity")
+    <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
-    <*> switch
+    <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
-          (short 'c' <> long "cache" <> help "Cache downloads in ~/.ghcup/cache"
-          )
     <*> (optional
           (option
             (eitherReader parseUri)
@@ -198,35 +233,29 @@ opts =
             )
           )
         )
-    <*> switch
+    <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
-          (short 'n' <> long "no-verify" <> help
+    <*> optional (option
-            "Skip tarball checksum verification"
-          )
-    <*> option
           (eitherReader keepOnParser)
           (  long "keep"
           <> metavar "<always|errors|never>"
           <> help
                "Keep build directories? (default: errors)"
-          <> value Errors
           <> hidden
-          )
+          ))
-    <*> option
+    <*> optional (option
           (eitherReader downloaderParser)
           (  long "downloader"
 #if defined(INTERNAL_DOWNLOADER)
           <> metavar "<internal|curl|wget>"
           <> help
           "Downloader to use (default: internal)"
-          <> value Internal
 #else
           <> metavar "<curl|wget>"
           <> help
           "Downloader to use (default: curl)"
-          <> value Curl
 #endif
           <> hidden
-          )
+          ))
     <*> com
  where
   parseUri s' =
@@ -857,14 +886,44 @@ bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
 
 
 toSettings :: Options -> IO AppState
-toSettings Options {..} = do
+toSettings options = do
-  let cache      = optCache
-      noVerify   = optNoVerify
-      keepDirs   = optKeepDirs
-      downloader = optsDownloader
-      verbose    = optVerbose
   dirs <- getDirs
-  pure $ AppState (Settings { .. }) dirs
+  userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
+    VRight r -> pure r
+    VLeft (V (JSONDecodeError e)) -> do
+      B.hPut stderr ("Error decoding config file: " <> (E.encodeUtf8 . T.pack . show $ e))
+      pure defaultUserSettings
+    _ -> do
+      die "Unexpected error!"
+  pure $ mergeConf options dirs userConf
+ where
+   mergeConf :: Options -> Dirs -> UserSettings -> AppState
+   mergeConf (Options {..}) dirs (UserSettings {..}) =
+     let cache      = fromMaybe (fromMaybe False uCache) optCache
+         noVerify   = fromMaybe (fromMaybe False uNoVerify) optNoVerify
+         verbose    = fromMaybe (fromMaybe False uVerbose) optVerbose
+         keepDirs   = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs
+         downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
+         keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
+     in AppState (Settings {..}) dirs keyBindings
+#if defined(INTERNAL_DOWNLOADER)
+   defaultDownloader = Internal
+#else
+   defaultDownloader = Curl
+#endif
+   mergeKeys :: UserKeyBindings -> KeyBindings
+   mergeKeys UserKeyBindings {..} =
+     let KeyBindings {..} = defaultKeyBindings
+     in KeyBindings {
+           bUp = fromMaybe bUp kUp
+         , bDown = fromMaybe bDown kDown
+         , bQuit = fromMaybe bQuit kQuit
+         , bInstall = fromMaybe bInstall kInstall
+         , bUninstall = fromMaybe bUninstall kUninstall
+         , bSet = fromMaybe bSet kSet
+         , bChangelog = fromMaybe bChangelog kChangelog
+         , bShowAll = fromMaybe bShowAll kShowAll
+         }
 
 
 upgradeOptsP :: Parser UpgradeOpts
@@ -948,7 +1007,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           -- logger interpreter
           logfile <- flip runReaderT appstate $ initGHCupFileLogging [rel|ghcup.log|]
           let loggerConfig = LoggerConfig
-                { lcPrintDebug = optVerbose
+                { lcPrintDebug = verbose settings
                 , colorOutter  = B.hPut stderr
                 , rawOutter    = appendFile logfile
                 }

ghcup.cabal

@@ -72,6 +72,9 @@ common bz2
 common case-insensitive
   build-depends: case-insensitive >=1.2.1.0
 
+common casing
+  build-depends: casing >=0.1.4.1
+
 common concurrent-output
   build-depends: concurrent-output >=1.10.11
 
@@ -266,6 +269,7 @@ library
     , bytestring
     , bz2
     , case-insensitive
+    , casing
     , concurrent-output
     , containers
     , cryptohash-sha256
@@ -307,6 +311,7 @@ library
     , utf8-string
     , vector
     , versions
+    , vty
     , word8
     , yaml
     , zlib

lib/GHCup/Types.hs

@@ -21,6 +21,7 @@ import           URI.ByteString
 
 import qualified Data.Text                     as T
 import qualified GHC.Generics                  as GHC
+import qualified Graphics.Vty                  as Vty
 
 
 
@@ -193,9 +194,59 @@ data URLSource = GHCupURL
                deriving (GHC.Generic, Show)
 
 
+data UserSettings = UserSettings
+  { uCache       :: Maybe Bool
+  , uNoVerify    :: Maybe Bool
+  , uVerbose     :: Maybe Bool
+  , uKeepDirs    :: Maybe KeepDirs
+  , uDownloader  :: Maybe Downloader
+  , uKeyBindings :: Maybe UserKeyBindings
+  }
+  deriving (Show, GHC.Generic)
+
+defaultUserSettings :: UserSettings
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing
+
+data UserKeyBindings = UserKeyBindings
+  { kUp        :: Maybe Vty.Key
+  , kDown      :: Maybe Vty.Key
+  , kQuit      :: Maybe Vty.Key
+  , kInstall   :: Maybe Vty.Key
+  , kUninstall :: Maybe Vty.Key
+  , kSet       :: Maybe Vty.Key
+  , kChangelog :: Maybe Vty.Key
+  , kShowAll   :: Maybe Vty.Key
+  }
+  deriving (Show, GHC.Generic)
+
+data KeyBindings = KeyBindings
+  { bUp        :: Vty.Key
+  , bDown      :: Vty.Key
+  , bQuit      :: Vty.Key
+  , bInstall   :: Vty.Key
+  , bUninstall :: Vty.Key
+  , bSet       :: Vty.Key
+  , bChangelog :: Vty.Key
+  , bShowAll   :: Vty.Key
+  }
+  deriving (Show, GHC.Generic)
+
+defaultKeyBindings :: KeyBindings
+defaultKeyBindings = KeyBindings
+  { bUp = Vty.KUp
+  , bDown = Vty.KDown
+  , bQuit = Vty.KChar 'q'
+  , bInstall = Vty.KChar 'i'
+  , bUninstall = Vty.KChar 'u'
+  , bSet = Vty.KChar 's'
+  , bChangelog = Vty.KChar 'c'
+  , bShowAll = Vty.KChar 'a'
+  }
+
 data AppState = AppState
   { settings :: Settings
   , dirs :: Dirs
+  , keyBindings :: KeyBindings
   } deriving (Show)
 
 data Settings = Settings
@@ -205,13 +256,14 @@ data Settings = Settings
   , downloader :: Downloader
   , verbose    :: Bool
   }
-  deriving Show
+  deriving (Show, GHC.Generic)
 
 data Dirs = Dirs
   { baseDir  :: Path Abs
   , binDir   :: Path Abs
   , cacheDir :: Path Abs
   , logsDir  :: Path Abs
+  , confDir  :: Path Abs
   }
   deriving Show
 

lib/GHCup/Types/JSON.hs

@@ -33,9 +33,11 @@ import           Data.Versions
 import           Data.Word8
 import           HPath
 import           URI.ByteString
+import           Text.Casing
 
 import qualified Data.ByteString               as BS
 import qualified Data.Text                     as T
+import qualified Graphics.Vty                  as Vty
 
 
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } { fieldLabelModifier = removeLensFieldLabel } ''Architecture
@@ -51,6 +53,11 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Versio
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
+deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
+deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
+deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Vty.Key
 
 instance ToJSON Tag where
   toJSON Latest             = String "Latest"

lib/GHCup/Utils/Dirs.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE QuasiQuotes           #-}
@@ -14,16 +15,18 @@ Portability : POSIX
 -}
 module GHCup.Utils.Dirs
   ( getDirs
+  , ghcupConfigFile
   , ghcupGHCBaseDir
   , ghcupGHCDir
-  , parseGHCupGHCDir
   , mkGhcupTmpDir
-  , withGHCupTmpDir
+  , parseGHCupGHCDir
   , relativeSymlink
+  , withGHCupTmpDir
   )
 where
 
 
+import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.MegaParsec
@@ -34,8 +37,11 @@ import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
+import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
 import           Data.Maybe
+import           GHC.IO.Exception               ( IOErrorType(NoSuchThing) )
+import           Haskus.Utils.Variant.Excepts
 import           HPath
 import           HPath.IO
 import           Optics
@@ -49,8 +55,10 @@ import           System.Posix.Env.ByteString    ( getEnv
 import           System.Posix.FilePath   hiding ( (</>) )
 import           System.Posix.Temp.ByteString   ( mkdtemp )
 
+import qualified Data.ByteString.Lazy          as L
 import qualified Data.ByteString.UTF8          as UTF8
 import qualified Data.Text.Encoding            as E
+import qualified Data.Yaml                     as Y
 import qualified System.Posix.FilePath         as FP
 import qualified System.Posix.User             as PU
 import qualified Text.Megaparsec               as MP
@@ -84,6 +92,28 @@ ghcupBaseDir = do
       pure (bdir </> [rel|.ghcup|])
 
 
+-- | ~/.ghcup by default
+--
+-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
+-- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec.
+ghcupConfigDir :: IO (Path Abs)
+ghcupConfigDir = do
+  xdg <- useXDG
+  if xdg
+    then do
+      bdir <- getEnv "XDG_CONFIG_HOME" >>= \case
+        Just r  -> parseAbs r
+        Nothing -> do
+          home <- liftIO getHomeDirectory
+          pure (home </> [rel|.config|])
+      pure (bdir </> [rel|ghcup|])
+    else do
+      bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
+        Just r  -> parseAbs r
+        Nothing -> liftIO getHomeDirectory
+      pure (bdir </> [rel|.ghcup|])
+
+
 -- | If 'GHCUP_USE_XDG_DIRS' is set (to anything),
 -- then uses 'XDG_BIN_HOME' env var or defaults to '~/.local/bin'
 -- (which, sadly is not strictly xdg spec).
@@ -142,10 +172,27 @@ getDirs = do
   binDir   <- ghcupBinDir
   cacheDir <- ghcupCacheDir
   logsDir  <- ghcupLogsDir
+  confDir  <- ghcupConfigDir
   pure Dirs { .. }
 
 
 
+    -------------------
+    --[ GHCup files ]--
+    -------------------
+
+
+ghcupConfigFile :: (MonadIO m)
+                => Excepts '[JSONError] m UserSettings
+ghcupConfigFile = do
+  confDir <- liftIO $ ghcupConfigDir
+  let file = confDir </> [rel|config.yaml|]
+  bs <- liftIO $ handleIO' NoSuchThing (\_ -> pure $ Nothing) $ fmap Just $ readFile file 
+  case bs of
+      Nothing -> pure defaultUserSettings
+      Just bs' -> lE' JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict $ bs'
+
+
     -------------------------
     --[ GHCup directories ]--
     -------------------------