From c11a6e9d11b994cc23aa096ff85c31c7a881283b Mon Sep 17 00:00:00 2001 From: "sean.escriva" Date: Mon, 28 Sep 2009 22:44:43 +0200 Subject: minor hlint cleanup of Prompt and XMonad.Prompt.* sub-modules Ignore-this: 25e71f59bdcc5bf94c2d6f476833216b darcs-hash:20090928204443-29414-d1844586f2955c8b76d971b20d6e2b6c1ea91d4d.gz --- XMonad/Prompt.hs | 25 ++++++++++++------------- XMonad/Prompt/AppendFile.hs | 4 +--- XMonad/Prompt/Directory.hs | 2 +- XMonad/Prompt/RunOrRaise.hs | 12 ++++++------ XMonad/Prompt/Shell.hs | 2 +- XMonad/Prompt/Ssh.hs | 4 ++-- XMonad/Prompt/Window.hs | 8 ++++---- 7 files changed, 27 insertions(+), 30 deletions(-) diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 387517a..5edfcad 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -171,12 +171,12 @@ class XPrompt t where -- string presently in the command line and the list of -- completion. nextCompletion :: t -> String -> [String] -> String - nextCompletion t c l = getNextOfLastWord t c l + nextCompletion = getNextOfLastWord -- | This method is used to generate the string to be passed to -- the completion function. commandToComplete :: t -> String -> String - commandToComplete _ c = getLastWord c + commandToComplete _ = getLastWord -- | This method is used to process each completion in order to -- generate the string that will be compared with the command @@ -259,7 +259,7 @@ mkXPromptWithReturn t conf compl action = do let d = display c rw = theRoot c s <- gets $ screenRect . W.screenDetail . W.current . windowset - hist <- liftIO $ readHistory + hist <- liftIO readHistory w <- liftIO $ createWin d rw conf s liftIO $ selectInput d w $ exposureMask .|. keyPressMask gc <- liftIO $ createGC d w @@ -489,8 +489,7 @@ startOfLine = -- | Flush the command string and reset the offset flushString :: XP () -flushString = do - modify $ \s -> setCommand "" $ s { offset = 0} +flushString = modify $ \s -> setCommand "" $ s { offset = 0} -- | Insert a character at the cursor position insertString :: String -> XP () @@ -503,7 +502,7 @@ insertString str = -- | Insert the current X selection string at the cursor position. pasteString :: XP () -pasteString = join $ io $ liftM insertString $ getSelection +pasteString = join $ io $ liftM insertString getSelection -- | Copy the currently entered string into the X selection. copyString :: XP () @@ -538,8 +537,8 @@ moveWord d = do ' ':x -> 1 + lenToS x x -> lenToS x newoff = case d of - Prev -> o - (ln reverse f ) - Next -> o + (ln id ss) + Prev -> o - ln reverse f + Next -> o + ln id ss modify $ \s -> s { offset = newoff } moveHistory :: (W.Stack String -> W.Stack String) -> XP () @@ -626,7 +625,7 @@ printPrompt drw = do getCompletions :: XP [String] getCompletions = do s <- get - io $ (completionFunction s) (commandToComplete (xptype s) (command s)) + io $ completionFunction s (commandToComplete (xptype s) (command s)) `catch` \_ -> return [] setComplWin :: Window -> ComplWindowDim -> XP () @@ -666,9 +665,9 @@ getComplWinDim compl = do tws <- mapM (textWidthXMF (dpy st) fs) compl let max_compl_len = fromIntegral ((fi ht `div` 2) + maximum tws) - columns = max 1 $ wh `div` (fi max_compl_len) + columns = max 1 $ wh `div` fi max_compl_len rem_height = rect_height scr - ht - (rows,r) = (length compl) `divMod` fi columns + (rows,r) = length compl `divMod` fi columns needed_rows = max 1 (rows + if r == 0 then 0 else 1) actual_max_number_of_rows = rem_height `div` ht actual_rows = min actual_max_number_of_rows (fi needed_rows) @@ -700,7 +699,7 @@ drawComplWin w compl = do p <- io $ createPixmap d w wh ht (defaultDepthOfScreen scr) io $ fillDrawable d p gc border bgcolor (fi bw) wh ht - let ac = splitInSubListsAt (length yy) (take ((length xx) * (length yy)) compl) + let ac = splitInSubListsAt (length yy) (take (length xx * length yy) compl) printComplList d p gc (fgColor c) (bgColor c) xx yy ac io $ copyArea d p w gc 0 0 wh ht 0 0 io $ freePixmap d p @@ -712,7 +711,7 @@ redrawComplWin compl = do let recreate = do destroyComplWin w <- createComplWin nwi drawComplWin w compl - if (compl /= [] && showComplWin st) + if compl /= [] && showComplWin st then case complWin st of Just w -> case complWinDim st of Just wi -> if nwi == wi -- complWinDim did not change diff --git a/XMonad/Prompt/AppendFile.hs b/XMonad/Prompt/AppendFile.hs index e5ffb5d..0760741 100644 --- a/XMonad/Prompt/AppendFile.hs +++ b/XMonad/Prompt/AppendFile.hs @@ -61,6 +61,4 @@ appendFilePrompt c fn = mkXPrompt (AppendFile fn) -- | Append a string to a file. doAppend :: FilePath -> String -> X () -doAppend fn s = io $ bracket (openFile fn AppendMode) - hClose - (flip hPutStrLn s) +doAppend fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn diff --git a/XMonad/Prompt/Directory.hs b/XMonad/Prompt/Directory.hs index 92426cd..dfd3817 100644 --- a/XMonad/Prompt/Directory.hs +++ b/XMonad/Prompt/Directory.hs @@ -31,7 +31,7 @@ instance XPrompt Dir where showXPrompt (Dir x) = x directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X () -directoryPrompt c prom job = mkXPrompt (Dir prom) c getDirCompl job +directoryPrompt c prom = mkXPrompt (Dir prom) c getDirCompl getDirCompl :: String -> IO [String] getDirCompl s = (filter notboring . lines) `fmap` diff --git a/XMonad/Prompt/RunOrRaise.hs b/XMonad/Prompt/RunOrRaise.hs index 3fffe74..bfe68b8 100644 --- a/XMonad/Prompt/RunOrRaise.hs +++ b/XMonad/Prompt/RunOrRaise.hs @@ -25,7 +25,7 @@ import XMonad.Prompt.Shell import XMonad.Actions.WindowGo (runOrRaise) import XMonad.Util.Run (runProcessWithInput) -import Control.Monad (liftM2) +import Control.Monad (liftM, liftM2) import Data.Maybe import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions) @@ -47,15 +47,15 @@ instance XPrompt RunOrRaisePrompt where showXPrompt RRP = "Run or Raise: " runOrRaisePrompt :: XPConfig -> X () -runOrRaisePrompt c = do cmds <- io $ getCommands +runOrRaisePrompt c = do cmds <- io getCommands mkXPrompt RRP c (getShellCompl cmds) open open :: String -> X () -open path = (io $ isNormalFile path) >>= \b -> +open path = io (isNormalFile path) >>= \b -> if b then spawn $ "xdg-open \"" ++ path ++ "\"" else uncurry runOrRaise . getTarget $ path where - isNormalFile f = exists f >>= \e -> if e then (notExecutable f) else return False + isNormalFile f = exists f >>= \e -> if e then notExecutable f else return False exists f = fmap or $ sequence [doesFileExist f,doesDirectoryExist f] notExecutable = fmap (not . executable) . getPermissions getTarget x = (x,isApp x) @@ -66,12 +66,12 @@ isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderb isApp x = liftM2 (==) pid $ pidof x pidof :: String -> Query Int -pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` (\_ -> return $ 0) +pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` (\_ -> return 0) pid :: Query Int pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w) where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $ - getWindowProperty32 d a w >>= return . getPID' + liftM getPID' (getWindowProperty32 d a w) getPID' (Just (x:_)) = fromIntegral x getPID' (Just []) = -1 getPID' (Nothing) = -1 diff --git a/XMonad/Prompt/Shell.hs b/XMonad/Prompt/Shell.hs index 782cb56..67e8337 100644 --- a/XMonad/Prompt/Shell.hs +++ b/XMonad/Prompt/Shell.hs @@ -57,7 +57,7 @@ instance XPrompt Shell where shellPrompt :: XPConfig -> X () shellPrompt c = do - cmds <- io $ getCommands + cmds <- io getCommands mkXPrompt Shell c (getShellCompl cmds) (spawn . encodeOutput) -- | See safe and unsafeSpawn. prompt is an alias for safePrompt; diff --git a/XMonad/Prompt/Ssh.hs b/XMonad/Prompt/Ssh.hs index 00217be..e8b15a8 100644 --- a/XMonad/Prompt/Ssh.hs +++ b/XMonad/Prompt/Ssh.hs @@ -54,11 +54,11 @@ instance XPrompt Ssh where sshPrompt :: XPConfig -> X () sshPrompt c = do - sc <- io $ sshComplList + sc <- io sshComplList mkXPrompt Ssh c (mkComplFunFromList sc) ssh ssh :: String -> X () -ssh s = runInTerm "" ("ssh " ++ s) +ssh = runInTerm "" . ("ssh " ++ ) sshComplList :: IO [String] sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal diff --git a/XMonad/Prompt/Window.hs b/XMonad/Prompt/Window.hs index 8130eaf..8fe9b7b 100644 --- a/XMonad/Prompt/Window.hs +++ b/XMonad/Prompt/Window.hs @@ -68,9 +68,9 @@ instance XPrompt WindowPrompt where nextCompletion _ = getNextCompletion windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X () -windowPromptGoto c = doPrompt Goto c -windowPromptBring c = doPrompt Bring c -windowPromptBringCopy c = doPrompt BringCopy c +windowPromptGoto = doPrompt Goto +windowPromptBring = doPrompt Bring +windowPromptBringCopy = doPrompt BringCopy -- | Pops open a prompt with window titles. Choose one, and you will be -- taken to the corresponding workspace. @@ -94,4 +94,4 @@ doPrompt t c = do -- | Brings a copy of the specified window into the current workspace. bringCopyWindow :: Window -> WindowSet -> WindowSet -bringCopyWindow w ws = copyWindow w (W.currentTag $ ws) ws +bringCopyWindow w ws = copyWindow w (W.currentTag ws) ws -- cgit v1.2.3