From 9ce28b7c28444b881bd7c195b4c2ace05950685e Mon Sep 17 00:00:00 2001 From: gwern0 Date: Sat, 20 Dec 2008 16:33:02 +0100 Subject: hlintify XUtils, XSelection, Search, WindowGo Ignore-this: 7e877484e3cd8954b74232ea83180fa9 darcs-hash:20081220153302-f7719-750549ea12a24a7364f4be71894720700f98f6a7.gz --- XMonad/Actions/Search.hs | 10 +++++----- XMonad/Actions/WindowGo.hs | 6 +++--- XMonad/Util/XSelection.hs | 2 +- XMonad/Util/XUtils.hs | 2 +- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/XMonad/Actions/Search.hs b/XMonad/Actions/Search.hs index 71d1945..456d3f7 100644 --- a/XMonad/Actions/Search.hs +++ b/XMonad/Actions/Search.hs @@ -188,14 +188,14 @@ escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c) (Char -> Bool) -- a predicate which returns 'False' if should escape -> String -- the string to process -> String -- the resulting URI string - escapeURIString p s = concatMap (escapeURIChar p) s + escapeURIString = concatMap . escapeURIChar escapeURIChar :: (Char->Bool) -> Char -> String escapeURIChar p c | p c = [c] | otherwise = '%' : myShowHex (ord c) "" where myShowHex :: Int -> ShowS - myShowHex n r = case showIntAtBase 16 (toChrHex) n r of + myShowHex n r = case showIntAtBase 16 toChrHex n r of [] -> "00" [ch] -> ['0',ch] cs -> cs @@ -212,7 +212,7 @@ data SearchEngine = SearchEngine Name Site -- | Given a browser, a search engine, and a search term, perform the -- requested search in the browser. search :: Browser -> Site -> Query -> X () -search browser site query = safeSpawn browser (site ++ (escape query)) +search browser site query = safeSpawn browser $ site ++ escape query {- | Given a base URL, create the 'SearchEngine' that escapes the query and appends it to the base. You can easily define a new engine locally using @@ -227,7 +227,7 @@ search browser site query = safeSpawn browser (site ++ (escape query)) Generally, examining the resultant URL of a search will allow you to reverse-engineer it if you can't find the necessary URL already described in other projects such as Surfraw. -} searchEngine :: Name -> Site -> SearchEngine -searchEngine name site = SearchEngine name site +searchEngine = SearchEngine -- The engines. amazon, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, @@ -260,7 +260,7 @@ wayback = searchEngine "wayback" "http://web.archive.org/" Prompt's result, passes it to a given searchEngine and opens it in a given browser. -} promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X () -promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config (historyCompletion) $ search browser site +promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config historyCompletion $ search browser site {- | Like 'search', but in this case, the string is not specified but grabbed from the user's response to a prompt. Example: diff --git a/XMonad/Actions/WindowGo.hs b/XMonad/Actions/WindowGo.hs index 81967a5..e33f25a 100644 --- a/XMonad/Actions/WindowGo.hs +++ b/XMonad/Actions/WindowGo.hs @@ -62,7 +62,7 @@ For detailed instructions on editing your key bindings, see -- | 'action' is an executable to be run via 'spawn' (of "XMonad.Core") if the Window cannot be found. -- Presumably this executable is the same one that you were looking for. runOrRaise :: String -> Query Bool -> X () -runOrRaise action = raiseMaybe $ spawn action +runOrRaise = raiseMaybe . spawn -- | See 'raiseMaybe'. If the Window can't be found, quietly give up and do nothing. raise :: Query Bool -> X () @@ -103,7 +103,7 @@ raiseMaybe f thatUserQuery = withWindowSet $ \s -> do -- | See 'runOrRaise' and 'raiseNextMaybe'. Version that allows cycling through matches. runOrRaiseNext :: String -> Query Bool -> X () -runOrRaiseNext action = raiseNextMaybe $ spawn action +runOrRaiseNext = raiseNextMaybe . spawn -- | See 'raise' and 'raiseNextMaybe'. Version that allows cycling through matches. raiseNext :: Query Bool -> X () @@ -154,7 +154,7 @@ raiseAndDo raisef thatUserQuery afterRaise = withWindowSet $ \s -> do {- | if the window is found the window is focused and the third argument is called otherwise, raisef is called -} runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X () -runOrRaiseAndDo run query afterRaise = raiseAndDo (spawn run) query afterRaise +runOrRaiseAndDo = raiseAndDo . spawn {- | if the window is found the window is focused and set to master otherwise, the first argument is called diff --git a/XMonad/Util/XSelection.hs b/XMonad/Util/XSelection.hs index fdea2cf..aa6624e 100644 --- a/XMonad/Util/XSelection.hs +++ b/XMonad/Util/XSelection.hs @@ -170,5 +170,5 @@ shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more details on the advantages and disadvantages of using safeSpawn. -} promptSelection, safePromptSelection, unsafePromptSelection :: String -> X () promptSelection = unsafePromptSelection -safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection) +safePromptSelection app = join $ io $ liftM (safeSpawn app) getSelection unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection diff --git a/XMonad/Util/XUtils.hs b/XMonad/Util/XUtils.hs index c72bd79..b37d438 100644 --- a/XMonad/Util/XUtils.hs +++ b/XMonad/Util/XUtils.hs @@ -137,7 +137,7 @@ paintWindow' win (Rectangle x y wh ht) bw color b_color str = do io $ fillRectangle d p gc 0 0 wh ht -- and now again io $ setForeground d gc color' - io $ fillRectangle d p gc (fi bw) (fi bw) ((wh - (bw * 2))) (ht - (bw * 2)) + io $ fillRectangle d p gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) when (isJust str) $ do let (xmf,fc,bc,s) = fromJust str printStringXMF d p xmf gc fc bc x y s -- cgit v1.2.3