Merge pull request #864 from dcousens/no-xp-io

X.P: Add escape hatch for preventing X.P IO
This commit is contained in:
Tony Zorman 2024-03-31 09:58:37 +02:00 committed by GitHub
commit 6e43da8598
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
4 changed files with 28 additions and 14 deletions

View File

@ -13,6 +13,13 @@
order to lift any existing `IO StatusBarConfig` values into order to lift any existing `IO StatusBarConfig` values into
`X StatusBarConfig` values. `X StatusBarConfig` values.
* `XMonad.Prompt`
- Added an additional `XPConfig` argument to `historyCompletion` and
`historyCompletionP`. Calls along the lines of `historyCompletionP
myFunc` should be changed to `historyCompletionP myConf myFunc`.
If not `myConf` is lying around, `def` can be used instead.
### New Modules ### New Modules
* `XMonad.Actions.Profiles`. * `XMonad.Actions.Profiles`.
@ -37,6 +44,11 @@
- Added `HH:MM-HH:MM` and `HH:MM+HH` syntax to specify time spans. - Added `HH:MM-HH:MM` and `HH:MM+HH` syntax to specify time spans.
* `XMonad.Prompt`
- The history file is not extraneously read and written anymore if
the `historySize` is set to 0.
### Other changes ### Other changes
## 0.18.0 (February 3, 2024) ## 0.18.0 (February 3, 2024)

View File

@ -437,14 +437,14 @@ namedEngine name (SearchEngine _ site) = searchEngineF name site
browser. -} browser. -}
promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X () promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
promptSearchBrowser config browser (SearchEngine name site) = do promptSearchBrowser config browser (SearchEngine name site) = do
hc <- historyCompletionP ("Search [" `isPrefixOf`) hc <- historyCompletionP config ("Search [" `isPrefixOf`)
mkXPrompt (Search name) config hc $ search browser site mkXPrompt (Search name) config hc $ search browser site
{- | Like 'promptSearchBrowser', but only suggest previous searches for the {- | Like 'promptSearchBrowser', but only suggest previous searches for the
given 'SearchEngine' in the prompt. -} given 'SearchEngine' in the prompt. -}
promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X () promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X ()
promptSearchBrowser' config browser (SearchEngine name site) = do promptSearchBrowser' config browser (SearchEngine name site) = do
hc <- historyCompletionP (searchName `isPrefixOf`) hc <- historyCompletionP config (searchName `isPrefixOf`)
mkXPrompt (Search name) config hc $ search browser site mkXPrompt (Search name) config hc $ search browser site
where where
searchName = showXPrompt (Search name) searchName = showXPrompt (Search name)

View File

@ -138,7 +138,7 @@ setCurrentWorkspaceName name = do
-- | Prompt for a new name for the current workspace and set it. -- | Prompt for a new name for the current workspace and set it.
renameWorkspace :: XPConfig -> X () renameWorkspace :: XPConfig -> X ()
renameWorkspace conf = do renameWorkspace conf = do
completion <- historyCompletionP (prompt ==) completion <- historyCompletionP conf (prompt ==)
mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName
where where
prompt = "Workspace name: " prompt = "Workspace name: "

View File

@ -562,7 +562,7 @@ mkXPromptImplementation historyKey conf om = do
s <- gets $ screenRect . W.screenDetail . W.current . windowset s <- gets $ screenRect . W.screenDetail . W.current . windowset
cleanMask <- cleanKeyMask cleanMask <- cleanKeyMask
cachedir <- asks (cacheDir . directories) cachedir <- asks (cacheDir . directories)
hist <- io $ readHistory cachedir hist <- io $ readHistory conf cachedir
fs <- initXMF (font conf) fs <- initXMF (font conf)
let width = getWinWidth s (position conf) let width = getWinWidth s (position conf)
st' <- io $ st' <- io $
@ -582,7 +582,7 @@ mkXPromptImplementation historyKey conf om = do
releaseXMF fs releaseXMF fs
when (successful st') $ do when (successful st') $ do
let prune = take (historySize conf) let prune = take (historySize conf)
io $ writeHistory cachedir $ io $ writeHistory conf cachedir $
M.insertWith M.insertWith
(\xs ys -> prune . historyFilter conf $ xs ++ ys) (\xs ys -> prune . historyFilter conf $ xs ++ ys)
historyKey historyKey
@ -1690,16 +1690,18 @@ emptyHistory = M.empty
getHistoryFile :: FilePath -> FilePath getHistoryFile :: FilePath -> FilePath
getHistoryFile cachedir = cachedir ++ "/prompt-history" getHistoryFile cachedir = cachedir ++ "/prompt-history"
readHistory :: FilePath -> IO History readHistory :: XPConfig -> FilePath -> IO History
readHistory cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory readHistory (XPC { historySize = 0 }) _ = return emptyHistory
readHistory _ cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory
where where
readHist = do readHist = do
let path = getHistoryFile cachedir let path = getHistoryFile cachedir
xs <- withFile path ReadMode hGetLine xs <- withFile path ReadMode hGetLine
readIO xs readIO xs
writeHistory :: FilePath -> History -> IO () writeHistory :: XPConfig -> FilePath -> History -> IO ()
writeHistory cachedir hist = do writeHistory (XPC { historySize = 0 }) _ _ = return ()
writeHistory _ cachedir hist = do
let path = getHistoryFile cachedir let path = getHistoryFile cachedir
filtered = M.filter (not . null) hist filtered = M.filter (not . null) hist
writeFile path (show filtered) `E.catch` \(SomeException e) -> writeFile path (show filtered) `E.catch` \(SomeException e) ->
@ -1793,17 +1795,17 @@ breakAtSpace s
-- | 'historyCompletion' provides a canned completion function much like -- | 'historyCompletion' provides a canned completion function much like
-- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work -- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
-- from the query history stored in the XMonad cache directory. -- from the query history stored in the XMonad cache directory.
historyCompletion :: X ComplFunction historyCompletion :: XPConfig -> X ComplFunction
historyCompletion = historyCompletionP (const True) historyCompletion conf = historyCompletionP conf (const True)
-- | Like 'historyCompletion' but only uses history data from Prompts whose -- | Like 'historyCompletion' but only uses history data from Prompts whose
-- name satisfies the given predicate. -- name satisfies the given predicate.
historyCompletionP :: (String -> Bool) -> X ComplFunction historyCompletionP :: XPConfig -> (String -> Bool) -> X ComplFunction
historyCompletionP p = do historyCompletionP conf p = do
cd <- asks (cacheDir . directories) cd <- asks (cacheDir . directories)
pure $ \x -> pure $ \x ->
let toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) [] let toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []
in toComplList . M.filterWithKey (const . p) <$> readHistory cd in toComplList . M.filterWithKey (const . p) <$> readHistory conf cd
-- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
-- laziness and stability for efficiency. -- laziness and stability for efficiency.