diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/dmenu-pkill.cabal b/dmenu-pkill.cabal new file mode 100644 --- /dev/null +++ b/dmenu-pkill.cabal @@ -0,0 +1,57 @@ +name: + dmenu-pkill +version: + 0.1.0.0 +synopsis: + dmenu script for killing applications. Sortable by process id or CPU/MEM usage. +description: + See README.md file. +homepage: + https://github.com/m0rphism/haskell-dmenu-pkill +bug-reports: + https://github.com/m0rphism/haskell-dmenu-pkill/issues +license: + BSD3 +license-file: + LICENSE +author: + Hannes Saffrich +maintainer: + Hannes Saffrich +copyright: + 2016 Hannes Saffrich +category: + System +build-type: + Custom +cabal-version: + >=1.10 +extra-doc-files: + doc/*.png +stability: + Beta +tested-with: + GHC == 8.0.1 + +executable dmenu-pkill + hs-source-dirs: + src + default-language: + Haskell2010 + main-is: + Main.hs + build-depends: + base >= 4.8 && < 5, + containers >= 0.5.7 && < 0.6, + lens >= 4.10 && < 4.16, + mtl >= 2.2 && < 2.3, + transformers >= 0.5 && < 0.6, + process >= 1.4 && < 1.5, + directory >= 1.2.6 && < 1.3, + dmenu >= 0.3.1 && < 0.4 + ghc-options: + -Wall -threaded -O2 -fno-warn-partial-type-signatures + +source-repository head + type: git + location: https://github.com/m0rphism/haskell-dmenu-pkill.git diff --git a/doc/dmenu-pkill.png b/doc/dmenu-pkill.png new file mode 100644 Binary files /dev/null and b/doc/dmenu-pkill.png differ diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE UnicodeSyntax, LambdaCase, FlexibleContexts #-} + +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.State.Strict +import Control.Lens +import Data.List (isPrefixOf) +import System.Environment +import System.Exit +import System.Process +import Data.List (intersperse) +import Text.Read (readMaybe) +import GHC.Exts (sortWith) + +import qualified DMenu + +runProc :: MonadIO m => String → [String] → String → m (Either String String) +runProc prog args sIn = liftIO $ do + (exitCode, sOut, sErr) ← + readCreateProcessWithExitCode (proc prog args) sIn + pure $ case exitCode of + ExitSuccess → Right sOut + ExitFailure _ → Left sErr + +runProcOr :: MonadIO m => String → [String] → String → String → m String +runProcOr prog args sIn sDef = either (const sDef) id <$> runProc prog args sIn + +data ProcInfo = ProcInfo + { piUser :: String + , piPid :: Integer + , piCpuUsage :: Double + , piMemoryUsage :: Double + , piVSZ :: Integer + , piRSS :: Integer + , piTTY :: Maybe String + , piStat :: String + , piStart :: String + , piTime :: String + , piCommand :: String + } + +readProcInfo :: String → Maybe ProcInfo +readProcInfo s = case words s of + user:pid:cpu:mem:vsz:rss:tty:stat:start:time:cmdWords + | Just pid' ← readMaybe pid + , Just cpu' ← readMaybe cpu + , Just mem' ← readMaybe mem + , Just vsz' ← readMaybe vsz + , Just rss' ← readMaybe rss + → let tty' | tty == "?" = Nothing + | otherwise = Just tty + in Just $ ProcInfo user pid' cpu' mem' vsz' rss' tty' + stat start time (take 100 $ unwords cmdWords) + -- FIXME: unwords . words loses whitespaces of command + _ → Nothing + +showProcInfos :: [ProcInfo] → [String] +showProcInfos pis = map f pairs + where + users = fillWithSP $ map piUser pis + pids = fillWithSPR $ map (show . piPid) pis + cpus = fillWithSPR $ map (show . piCpuUsage) pis + mems = fillWithSPR $ map (show . piMemoryUsage) pis + cmds = fillWithSP $ map piCommand pis + pairs = zip users $ zip pids $ zip cpus $ zip mems cmds + f (user,(pid,(cpu,(mem,cmd)))) = + concat $ intersperse " " [ pid, user, cpu ++ "% CPU", mem ++ "% MEM", cmd ] + +getProcs :: MonadIO m => m [ProcInfo] +getProcs = do + sOut ← runProcOr "ps" ["aux"] "" "" + fmap concat $ forM (drop 1 $ lines sOut) $ \l → do + case readProcInfo l of + Nothing → pure [] + Just pi' → pure [pi'] + +fillWithSP :: [String] → [String] +fillWithSP ss = map f ss where + f s = s ++ replicate (maxLength - length s) ' ' + maxLength = maximum (map length ss) + +fillWithSPR :: [String] → [String] +fillWithSPR ss = map f ss where + f s = replicate (maxLength - length s) ' ' ++ s + maxLength = maximum (map length ss) + +data ProcessOrder = CPU | MEM | PID + +-- | Parse the command line arguments +readArgs + :: [String] -- ^ Arguments from 'getArgs' + -> IO ProcessOrder +readArgs args = + execStateT (go $ words $ unwords args) PID + where + go [] = pure () + go (a:as) + | a == "--" = pure () -- All arguments after "--" are passed to dmenu later. + | a == "-cpu" = do put CPU; go as + | a == "-mem" = do put MEM; go as + | a == "-pid" = do put PID; go as + | a `elem` ["-h", "--help"] = liftIO $ do putStrLn usage; exitFailure + | a == "" = go as + go _ = liftIO $ do putStrLn usage; exitFailure + +main :: IO () +main = do + order ← readArgs =<< getArgs + sortProcs ← case order of + CPU → pure $ reverse . sortWith piCpuUsage + MEM → pure $ reverse . sortWith piMemoryUsage + PID → pure id + procs ← sortProcs <$> getProcs + let procItems = zip (map piPid procs) (showProcInfos procs) + let cfg = do + DMenu.prompt .= "kill -9" + DMenu.forwardExtraArgs + DMenu.selectWith cfg snd procItems >>= \case + Right (pid,_) → callCommand $ "kill -9 " ++ show pid + _ → pure () + +usage :: String +usage = unlines + [ "USAGE" + , " dmenu-pkill [OPTIONS] [-- DMENUOPTIONS]" + , "" + , " Get current processes with `ps aux`, optionally sort them by CPU or RAM" + , " usage, and ask via dmenu to kill one of the processes via `kill -9 `." + , "" + , " All arguments, after the first `--` argument, are directly passed to dmenu." + , "" + , "OPTIONS" + , " -cpu" + , " Sort process list by CPU usage." + , " -mem" + , " Sort process list by memory usage." + , " -pid" + , " Sort process list by pid. (default)" + , " -h, --help" + , " Display this message." + ]