yeganesh 2.2.1 → 2.3
raw patch · 3 files changed
+67/−17 lines, 3 filesdep +unix
Dependencies added: unix
Files
- Version.hs +1/−1
- yeganesh.cabal +2/−1
- yeganesh.hs +64/−15
Version.hs view
@@ -7,7 +7,7 @@ version :: String parseCurrentFormat :: String -> IO CurrentFormat -version = "yeganesh version 2.2.1"+version = "yeganesh version 2.3" parseCurrentFormat = parseFormatV2 -- }}} -- v2 {{{
yeganesh.cabal view
@@ -1,5 +1,5 @@ name: yeganesh-version: 2.2.1+version: 2.3 cabal-version: >=1.2 build-type: Simple license: BSD3@@ -23,5 +23,6 @@ process >= 1.0, strict >= 0.3, time >= 1.1,+ unix >= 2.5, xdg-basedir >= 0.2 ghc-options: -Wall
yeganesh.hs view
@@ -1,8 +1,10 @@+{-# LANGUAGE CPP #-} -- boilerplate {{{ module Main where import Control.Arrow ((&&&), second)-import Control.Monad (liftM, filterM, when)+import Control.Concurrent (newEmptyMVar, takeMVar, putMVar, forkIO)+import Control.Monad (liftM, filterM, forM, when) import Data.Char (toLower) import Data.List (partition, sortBy) import Data.Map (Map, insert, findWithDefault, fromList, intersection, toList, union)@@ -15,25 +17,36 @@ import System.Exit (ExitCode(ExitSuccess, ExitFailure), exitWith) import System.FilePath ((</>)) import System.IO (hClose, hGetContents, hPutStr, stderr, stdout)+import System.Posix.Files (fileAccess, getFileStatus, isDirectory) import System.Process (runInteractiveProcess, waitForProcess) import Version (CurrentFormat, parseCurrentFormat, version) import qualified System.IO.Strict as Strict (getContents, readFile)++#if MIN_VERSION_base(4,0,0)+import qualified Control.Exception+import Prelude hiding (catch)++catch :: IO a -> (Control.Exception.IOException -> IO a) -> IO a+catch = Control.Exception.catch+#endif -- }}} -- getopt {{{ options :: [OptDescr Flag]-options = [Option "p" ["profile"] (ReqArg Profile "PROFILE") "which popularity profile to use"- ,Option "f" ["filter" ] (NoArg Prune) "prune a profile to contain exactly the lines of stdin"- ,Option "v" ["version"] (NoArg Version) "print the version number"- ,Option "h" ["help" ] (NoArg Help) "show usage information"+options = [Option "p" ["profile"] (ReqArg Profile "PROFILE") "which popularity profile to use"+ ,Option "f" ["filter" ] (NoArg Prune) "prune a profile to contain exactly the lines of stdin"+ ,Option "x" ["executables"] (NoArg Executables) "search $PATH for executables for the next run"+ ,Option "v" ["version"] (NoArg Version) "print the version number"+ ,Option "h" ["help" ] (NoArg Help) "show usage information" ] -data Options = Options { dmenuOpts :: [String], profile :: String, prune :: Bool }-data Flag = Profile String | Prune | Version | Help deriving Eq+data Options = Options { dmenuOpts :: [String], profile :: String, prune :: Bool, executables :: Bool }+data Flag = Profile String | Prune | Executables | Version | Help deriving Eq -compactFlags :: [Flag] -> (Flag, Bool)-compactFlags fs = (flag, not $ null prunes) where+compactFlags :: [Flag] -> (Flag, Bool, Bool)+compactFlags fs = (flag, not $ null prunes, not $ null execs) where (prunes, nonPrunes) = partition (==Prune) fs- flag = foldr1 compactFlags' . (Profile "default" :) $ nonPrunes+ (execs, nonExecs) = partition (==Executables) nonPrunes+ flag = foldr1 compactFlags' . (Profile "default" :) $ nonExecs compactFlags' Help _ = Help compactFlags' _ Help = Help compactFlags' Version _ = Version@@ -45,15 +58,15 @@ version, "Usage: yeganesh [OPTIONS] -- [DMENU_OPTIONS]", "OPTIONS are described below, and DMENU_OPTIONS are passed on verbatim to dmenu.",- "Profiles are stored in the $HOME/.yeganesh directory."]+ "Profiles are stored in the XDG data home for yeganesh."] parseOptions :: [String] -> Either String Options parseOptions ss = p where (opts, dOpts) = fmap (drop 1) . break (== "--") $ ss p = case onFirst compactFlags $ getOpt RequireOrder options opts of- ((Profile f, b), [], []) -> Right (Options dOpts f b)- ((Version , _), [], []) -> Left version- ((Help , _), [], []) -> Left $ usageInfo introText options+ ((Profile s, f, x), [], []) -> Right (Options dOpts s f x)+ ((Version , _, _), [], []) -> Left version+ ((Help , _, _), [], []) -> Left $ usageInfo introText options (_ , ns, []) -> Left $ "Unknown options: " ++ unwords ns (_ , _ , es) -> Left . concat $ es -- }}}@@ -134,6 +147,21 @@ parseInput :: String -> Commands parseInput = fromList . flip zip (repeat 0) . filter (not . null) . lines++-- an (almost certainly buggy) internal implementation of the shell's IFS+-- mechanism+xCons :: a -> [[a]] -> [[a]]+xCons x (p:ps) = ((x:p):ps)+xCons x [] = [[x]]++parsePath :: String -> [String]+parsePath ('\\':x:xs) = xCons x (parsePath xs)+parsePath (':':xs) = [] : parsePath xs+parsePath (x:xs) = xCons x (parsePath xs)+parsePath [] = []++addEntries :: [String] -> CurrentFormat -> CurrentFormat+addEntries es (t, m) = (t, union m (fromList [(e, 0) | e <- es])) -- }}} -- shell stuff {{{ dmenu :: [String] -> CurrentFormat -> IO (ExitCode, CurrentFormat)@@ -155,14 +183,35 @@ now <- getCurrentTime return (now, updatePriority cmd t now cmds) +lsx :: Bool -> IO (IO [String])+lsx False = return (return [])+lsx True = do+ mvar <- newEmptyMVar+ _ <- forkIO $ do+ path <- getEnv "PATH"+ execs <- forM (parsePath path) $ \s ->+ catch (getDirectoryContents s) (const . return $ []) >>=+ filterM (\file -> do+ status <- getFileStatus (s </> file)+ case isDirectory status of+ True -> return False+ False -> fileAccess (s </> file) True False True)+ -- TODO: do people prefer to see files which are executable by+ -- *someone*, even if not by the current user? ask brisbin on+ -- Freenode, who is to date the only person to request this feature+ putMVar mvar (concat execs)+ return (takeMVar mvar)+ runWithOptions :: Options -> IO () runWithOptions opts = do+ future <- lsx (executables opts) inFile <- inFileName (profile opts) outFile <- outFileName (profile opts) cached <- readPossiblyNonExistent inFile new <- fmap parseInput Strict.getContents (code, updated) <- dmenu (dmenuOpts opts) (second (`combine` new) cached)- writeFile outFile (show updated)+ execs <- future+ writeFile outFile (show (addEntries execs updated)) deprecate inFile (profile opts) exitWith code where