hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

abstracts out getting ghcup conf file path

Browse Source
This commit is contained in:
Arjun Kathuria 2021-06-23 10:08:06 +05:30
parent 07fb04bb74
commit 2e3dceecf8
1 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lib/GHCup/Utils/Dirs.hs
View File

@ -26,6 +26,7 @@ module GHCup.Utils.Dirs
, parseGHCupGHCDir , parseGHCupGHCDir
, relativeSymlink , relativeSymlink
, withGHCupTmpDir , withGHCupTmpDir
, getConfigFilePath
) )
where where
@ -201,13 +202,16 @@ getDirs = do
--[ GHCup files ]-- --[ GHCup files ]--
------------------- -------------------
getConfigFilePath :: (MonadIO m) => m FilePath
getConfigFilePath = do
confDir <- liftIO ghcupConfigDir
pure $ confDir </> "config.yaml"
ghcupConfigFile :: (MonadIO m) ghcupConfigFile :: (MonadIO m)
=> Excepts '[JSONError] m UserSettings => Excepts '[JSONError] m UserSettings
ghcupConfigFile = do ghcupConfigFile = do
confDir <- liftIO ghcupConfigDir filepath <- getConfigFilePath
let file = confDir </> "config.yaml" contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile file
case contents of case contents of
Nothing -> pure defaultUserSettings Nothing -> pure defaultUserSettings
Just contents' -> lE' JSONDecodeError . first show . Y.decodeEither' $ contents' Just contents' -> lE' JSONDecodeError . first show . Y.decodeEither' $ contents'