yeganesh 2.1 → 2.2
raw patch · 4 files changed
+76/−81 lines, 4 filesdep +xdg-basedirdep ~base
Dependencies added: xdg-basedir
Dependency ranges changed: base
Files
- LICENSE +10/−10
- Version.hs +0/−41
- yeganesh.cabal +4/−3
- yeganesh.hs +62/−27
LICENSE view
@@ -13,13 +13,13 @@ 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, loss of data, loss of 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.+! 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, loss of data, loss of 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.
− Version.hs
@@ -1,41 +0,0 @@--- boilerplate {{{-module Version (CurrentFormat, parseCurrentFormat, version) where-import Data.Map (Map, elems, empty)-import Data.Time (UTCTime, getCurrentTime)--type CurrentFormat = FormatV2-version :: String-parseCurrentFormat :: String -> IO CurrentFormat--version = "yeganesh version 2.1"-parseCurrentFormat = parseFormatV2--- }}}--- v2 {{{-type FormatV2 = (UTCTime, FormatV1)--parseFormatV2 :: String -> IO FormatV2-parseFormatV2 = parse parseFormatV1 upgradeFormatV1--- }}}--- v1 {{{-type FormatV1 = Map String Double--upgradeFormatV1 :: FormatV1 -> IO FormatV2-upgradeFormatV1 v1 = fmap (flip (,) popularities) getCurrentTime where- maximal = case (elems v1, maximum (elems v1)) of- ([], _) -> 1- (_ , 0) -> 1- (_ , m) -> m- popularities = fmap (/maximal) v1--parseFormatV1 :: String -> IO FormatV1-parseFormatV1 = parse (const (return empty)) return--- }}}--- utilities {{{-parse :: Read new => (String -> IO old) -> (old -> IO new) -> (String -> IO new)-parse old upgrade s = maybe (old s >>= upgrade) return (readMaybe s)--readMaybe :: Read a => String -> Maybe a-readMaybe s = case reads s of- [(x, "")] -> Just x- _ -> Nothing--- }}}
yeganesh.cabal view
@@ -1,5 +1,5 @@ name: yeganesh-version: 2.1+version: 2.2 cabal-version: >=1.2 build-type: Simple license: BSD3@@ -15,11 +15,12 @@ Executable yeganesh main-is: yeganesh.hs- build-depends: base >= 3.0,+ build-depends: base >= 3 && <= 4, containers >= 0.1, directory >= 1.0, filepath >= 1.1, process >= 1.0, strict >= 0.3,- time >= 1.1+ time >= 1.1,+ xdg-basedir >= 0.2 ghc-options: -Wall
yeganesh.hs view
@@ -2,15 +2,17 @@ module Main where import Control.Arrow ((&&&), second)-import Control.Monad (liftM)+import Control.Monad (liftM, filterM, when) import Data.Char (toLower)-import Data.List (sortBy)-import Data.Map (Map, insert, findWithDefault, fromList, toList, union)+import Data.List (partition, sortBy)+import Data.Map (Map, insert, findWithDefault, fromList, intersection, toList, union) import Data.Ord (comparing) import Data.Time (UTCTime, diffUTCTime, getCurrentTime) import System.Console.GetOpt (ArgDescr(NoArg, ReqArg), ArgOrder(RequireOrder), OptDescr(Option), getOpt, usageInfo)-import System.Directory (createDirectoryIfMissing)+import System.Directory (createDirectoryIfMissing, doesFileExist, getDirectoryContents, removeDirectory, removeFile) import System.Environment (getArgs, getEnv)+import System.Environment.XDG.BaseDir (getAllDataFiles, getUserDataDir, getUserDataFile)+import System.Exit (ExitCode(ExitSuccess, ExitFailure), exitWith) import System.FilePath ((</>)) import System.IO (hClose, hGetContents, hPutStr, stderr, stdout) import System.Process (runInteractiveProcess, waitForProcess)@@ -20,15 +22,18 @@ -- 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" ] -data Options = Options { dmenuOpts :: [String], profile :: String }-data Flag = Profile String | Version | Help+data Options = Options { dmenuOpts :: [String], profile :: String, prune :: Bool }+data Flag = Profile String | Prune | Version | Help deriving Eq -compactFlags :: [Flag] -> Flag-compactFlags = foldr1 compactFlags' . (Profile "default" :) where+compactFlags :: [Flag] -> (Flag, Bool)+compactFlags fs = (flag, not $ null prunes) where+ (prunes, nonPrunes) = partition (==Prune) fs+ flag = foldr1 compactFlags' . (Profile "default" :) $ nonPrunes compactFlags' Help _ = Help compactFlags' _ Help = Help compactFlags' Version _ = Version@@ -43,24 +48,45 @@ "Profiles are stored in the $HOME/.yeganesh directory."] parseOptions :: [String] -> Either String Options-parseOptions ss = fmap (Options dOpts) p where+parseOptions ss = p where (opts, dOpts) = fmap (drop 1) . break (== "--") $ ss p = case onFirst compactFlags $ getOpt RequireOrder options opts of- (Profile f, [], []) -> Right f- (Version , [], []) -> Left version- (Help , [], []) -> Left $ usageInfo introText options+ ((Profile f, b), [], []) -> Right (Options dOpts f b)+ ((Version , _), [], []) -> Left version+ ((Help , _), [], []) -> Left $ usageInfo introText options (_ , ns, []) -> Left $ "Unknown options: " ++ unwords ns (_ , _ , es) -> Left . concat $ es -- }}} -- filesystem stuff {{{ type Commands = Map String Double -fileName :: String -> IO FilePath-fileName arg = do- home <- flip liftM (getEnv "HOME") (</> ".yeganesh")- createDirectoryIfMissing True home- return $ home </> arg+deprecatedDir :: IO FilePath+deprecatedDir = liftM (</> ".yeganesh") (getEnv "HOME") +inFileName :: String -> IO FilePath+inFileName arg = do+ depDir <- deprecatedDir+ dataFiles <- getAllDataFiles "yeganesh" arg+ validFiles <- filterM doesFileExist ((depDir </> arg) : dataFiles)+ case validFiles of+ [] -> getUserDataFile "yeganesh" arg+ (f:_) -> return f++outFileName :: String -> IO FilePath+outFileName arg = do+ dir <- getUserDataDir "yeganesh"+ createDirectoryIfMissing True dir+ return (dir </> arg)++deprecate :: String -> String -> IO ()+deprecate inFile arg = do+ depDir <- deprecatedDir+ when (inFile == depDir </> arg) $ do+ removeFile inFile+ filesLeft <- getDirectoryContents depDir+ when (null . filter (`notElem` [".", ".."]) $ filesLeft)+ (removeDirectory depDir)+ readPossiblyNonExistent :: FilePath -> IO CurrentFormat readPossiblyNonExistent file = catch (Strict.readFile file) (const . return $ "") >>= parseCurrentFormat -- }}}@@ -110,30 +136,39 @@ parseInput = fromList . flip zip (repeat 0) . filter (not . null) . lines -- }}} -- shell stuff {{{-dmenu :: [String] -> CurrentFormat -> IO CurrentFormat+dmenu :: [String] -> CurrentFormat -> IO (ExitCode, CurrentFormat) dmenu opts cv@(_, cmds) = do (hIn, hOut, hErr, p) <- runInteractiveProcess "dmenu" opts Nothing Nothing hPutStr hIn (showPriority cmds) hClose hIn o <- hGetContents hOut e <- hGetContents hErr- waitForProcess p+ c <- waitForProcess p hPutStr stdout o hPutStr stderr e- updateState o cv+ cv' <- updateState c o cv+ return (c, cv') -updateState :: String -> CurrentFormat -> IO CurrentFormat-updateState cmd cv@(t, cmds) = if null cmd then return cv else do+updateState :: ExitCode -> String -> CurrentFormat -> IO CurrentFormat+updateState (ExitFailure {}) _ (t, cmds) = return (t, cmds)+updateState ExitSuccess cmd (t, cmds) = do now <- getCurrentTime return (now, updatePriority cmd t now cmds) runWithOptions :: Options -> IO () runWithOptions opts = do- file <- fileName (profile opts)- cached <- readPossiblyNonExistent file- new <- fmap parseInput Strict.getContents- updated <- dmenu (dmenuOpts opts) (second (`union` new) cached)- writeFile file (show updated)+ 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)+ deprecate inFile (profile opts)+ exitWith code+ where+ combine = if prune opts+ then \old -> union old >>= intersection+ else union -- }}} main :: IO () main = getArgs >>= either putStrLn runWithOptions . parseOptions