diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/Version.hs b/Version.hs deleted file mode 100644 --- a/Version.hs +++ /dev/null @@ -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 --- }}} diff --git a/yeganesh.cabal b/yeganesh.cabal --- a/yeganesh.cabal +++ b/yeganesh.cabal @@ -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 diff --git a/yeganesh.hs b/yeganesh.hs --- a/yeganesh.hs +++ b/yeganesh.hs @@ -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