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/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 ++++---- 6 files changed, 15 insertions(+), 17 deletions(-) (limited to 'XMonad/Prompt') 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