From 7b480944c6180e8427800c9a7f917925cfc3e7ad Mon Sep 17 00:00:00 2001 From: hololeap Date: Thu, 28 Mar 2024 12:30:56 -0600 Subject: [PATCH] Portage.Host: Use `warn` for config warning Use the `warn` function from the `Util` module for the hackport config warning. Have hackportConfig return the full path to the `repositories` config file. Use MaybeT in places to improve code simplicity. Signed-off-by: hololeap --- src/Hackport/Util.hs | 2 +- src/Overlays.hs | 6 ++- src/Portage/Host.hs | 91 +++++++++++++++++++++----------------------- 3 files changed, 49 insertions(+), 50 deletions(-) diff --git a/src/Hackport/Util.hs b/src/Hackport/Util.hs index b170d6f2..0855f23a 100644 --- a/src/Hackport/Util.hs +++ b/src/Hackport/Util.hs @@ -31,7 +31,7 @@ getPortageDir :: Env env FilePath getPortageDir = do (GlobalEnv verbosity _ portagePathM, _) <- ask portagePath <- case portagePathM of - Nothing -> liftIO $ Host.portage_dir <$> Host.getInfo + Nothing -> Host.portage_dir <$> Host.getInfo Just path -> return path exists <- liftIO $ doesDirectoryExist $ portagePath "dev-haskell" unless exists $ liftIO $ diff --git a/src/Overlays.hs b/src/Overlays.hs index 9356d156..f4849b2a 100644 --- a/src/Overlays.hs +++ b/src/Overlays.hs @@ -5,6 +5,7 @@ module Overlays ) where import Control.Monad +import Control.Monad.State.Strict (MonadState) import Data.List (nub, inits) import Data.Maybe (maybeToList, listToMaybe, isJust, fromJust) import qualified System.Directory as SD @@ -48,10 +49,11 @@ getOverlayPath = askGlobalEnv >>= \(GlobalEnv _ override_overlay _) -> do info "Override my decision with hackport --overlay /my/overlay" return overlay -getOverlays :: MonadIO m => m [String] +getOverlays :: (HasGlobalEnv m, MonadIO m, MonadState WarningBuffer m) + => m [String] getOverlays = do local <- getLocalOverlay - overlays <- liftIO $ overlay_list `fmap` getInfo + overlays <- overlay_list <$> getInfo return $ nub $ map clean $ maybeToList local ++ overlays diff --git a/src/Portage/Host.hs b/src/Portage/Host.hs index 8a1f538b..ca7d5a27 100644 --- a/src/Portage/Host.hs +++ b/src/Portage/Host.hs @@ -5,13 +5,19 @@ module Portage.Host import Util (run_cmd) import qualified Data.List.Split as DLS -import Data.Maybe (fromJust, isJust, mapMaybe) +import Data.Maybe (fromJust, isJust, mapMaybe, fromMaybe) import qualified System.Directory as D import System.FilePath (()) import Hackport.Dirs (hackportDir) -import System.IO +import Control.Applicative ((<|>)) +import Control.Monad (guard) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.State.Strict (MonadState) +import Control.Monad.Trans.Maybe (MaybeT(..)) +import Hackport.Env (HasGlobalEnv, WarningBuffer) +import Util (warn) data LocalInfo = LocalInfo { distfiles_dir :: String @@ -26,49 +32,41 @@ defaultInfo = LocalInfo { distfiles_dir = "/var/cache/distfiles" } -- query paludis and then emerge -getInfo :: IO LocalInfo -getInfo = fromJust `fmap` - performMaybes [ readConfig - , performMaybes [ getPaludisInfo - , askPortageq - , return (Just defaultInfo) - ] >>= showAnnoyingWarning - ] - where performMaybes [] = return Nothing - performMaybes (act:acts) = - do r <- act - if isJust r - then return r - else performMaybes acts +getInfo :: (HasGlobalEnv m, MonadIO m, MonadState WarningBuffer m) + => m LocalInfo +getInfo = fromMaybe defaultInfo <$> runMaybeT (readConfig <|> getInfoWithWarning) + where + getInfoWithWarning = MaybeT $ do + configPath <- hackportConfig + info <- runMaybeT $ getPaludisInfo <|> askPortageq + warn $ configWarning configPath info + pure info -showAnnoyingWarning :: Maybe LocalInfo -> IO (Maybe LocalInfo) -showAnnoyingWarning info = do - hPutStr stderr $ unlines [ "-- Consider creating ~/" ++ hackport_config ++ " file with contents:" - , show info - , "-- It will speed hackport startup time a bit." - ] - return info + configWarning configPath info = unlines + [ "-- Consider creating " ++ configPath ++ " file with contents:" + , show info + , "-- It will speed hackport startup time a bit." + ] --- relative to hackport config dir -hackport_config :: FilePath -hackport_config = "repositories" +-- | Where @repositories@ config file is located +hackportConfig :: MonadIO m => m FilePath +hackportConfig = ( "repositories") <$> hackportDir -------------------------- -- fastest: config reading -------------------------- -readConfig :: IO (Maybe LocalInfo) -readConfig = - do hackportConfigDir <- hackportDir - let config_path = hackportConfigDir hackport_config - exists <- D.doesFileExist config_path - if exists then read <$> readFile config_path else return Nothing +readConfig :: MonadIO m => MaybeT m LocalInfo +readConfig = do + configPath <- hackportConfig + liftIO (D.doesFileExist configPath) >>= guard + MaybeT $ liftIO $ read <$> readFile configPath ---------- -- Paludis ---------- -getPaludisInfo :: IO (Maybe LocalInfo) -getPaludisInfo = fmap parsePaludisInfo <$> run_cmd "cave info" +getPaludisInfo :: MonadIO m => MaybeT m LocalInfo +getPaludisInfo = MaybeT $ fmap parsePaludisInfo <$> run_cmd "cave info" parsePaludisInfo :: String -> LocalInfo parsePaludisInfo text = @@ -101,22 +99,21 @@ parsePaludisInfo text = -- Emerge --------- -askPortageq :: IO (Maybe LocalInfo) +askPortageq :: MonadIO m => MaybeT m LocalInfo askPortageq = do distdir <- run_cmd "portageq distdir" portdir <- run_cmd "portageq get_repo_path / gentoo" hsRepo <- run_cmd "portageq get_repo_path / haskell" --There really ought to be both distdir and portdir, --but maybe no hsRepo defined yet. - let info = if Nothing `elem` [distdir,portdir] - then Nothing - else Just LocalInfo - { distfiles_dir = grab distdir - , portage_dir = grab portdir - , overlay_list = iffy hsRepo - } - --init: kill newline char - where grab = init . fromJust - iffy Nothing = [] - iffy (Just repo) = [init repo] - return info + guard $ all isJust [distdir,portdir] + pure LocalInfo + { distfiles_dir = grab distdir + , portage_dir = grab portdir + , overlay_list = iffy hsRepo + } + where + --init: kill newline char + grab = init . fromJust + iffy Nothing = [] + iffy (Just repo) = [init repo]