dmenu-pkill (empty) → 0.1.0.0

raw patch · 5 files changed

+230/−0 lines, 5 filesdep +basedep +containersdep +directorybuild-type:Customsetup-changedbinary-added

Dependencies added: base, containers, directory, dmenu, lens, mtl, process, transformers

Files

LICENSE +30/−0
Setup.hs +2/−0
dmenu-pkill.cabal +57/−0
doc/dmenu-pkill.png binary
src/Main.hs +141/−0

+ LICENSE view

@@ -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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ dmenu-pkill.cabal view

@@ -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 <m0rphism@zankapfel.org>+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

+ doc/dmenu-pkill.png view

binary file changed (absent → 47340 bytes)

+ src/Main.hs view

@@ -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 <pid>`."+  , ""+  , "  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."+  ]