diff --git a/Catch.hs b/Catch.hs new file mode 100644 --- /dev/null +++ b/Catch.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE CPP #-} +module Catch (catch) where + +#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 diff --git a/Version.hs b/Version.hs --- a/Version.hs +++ b/Version.hs @@ -1,13 +1,18 @@ -- boilerplate {{{ -module Version (CurrentFormat, parseCurrentFormat, version) where +module Version (CurrentFormat, parseCurrentFormat, versionNumber, versionYeganesh, versionStrip) where +import Data.Char (isSpace) import Data.Map (Map, elems, empty) import Data.Time (UTCTime, getCurrentTime) type CurrentFormat = FormatV2 -version :: String +versionNumber :: String +versionYeganesh :: String +versionStrip :: String parseCurrentFormat :: String -> IO CurrentFormat -version = "yeganesh version 2.3" +versionNumber = "2.4" +versionYeganesh = "yeganesh version " ++ versionNumber +versionStrip = "yeganesh-strip version " ++ versionNumber parseCurrentFormat = parseFormatV2 -- }}} -- v2 {{{ @@ -36,6 +41,6 @@ readMaybe :: Read a => String -> Maybe a readMaybe s = case reads s of - [(x, "")] -> Just x - _ -> Nothing + [(x, unparsed)] | all isSpace unparsed -> Just x + _ -> Nothing -- }}} diff --git a/Yeganesh.hs b/Yeganesh.hs new file mode 100644 --- /dev/null +++ b/Yeganesh.hs @@ -0,0 +1,171 @@ +-- boilerplate {{{ +module Yeganesh where + +import Catch (catch) +import Control.Arrow ((&&&)) +import Control.Monad (liftM, filterM, when) +import Data.Char (toLower) +import Data.Function (on) +import Data.List (partition, sortBy) +import Data.Map (Map, insert, findWithDefault, fromList, toList, union) +import Data.Ord (comparing) +import Data.Time (UTCTime, diffUTCTime) +import Prelude hiding (catch) +import System.Console.GetOpt (ArgDescr(NoArg, ReqArg), ArgOrder(RequireOrder), OptDescr(Option), getOpt, usageInfo) +import System.Directory (createDirectoryIfMissing, doesFileExist, getDirectoryContents, removeDirectory, removeFile) +import System.Environment (getEnv) +import System.Environment.XDG.BaseDir (getAllDataFiles, getUserDataDir, getUserDataFile) +import System.FilePath (()) +import Version (CurrentFormat, parseCurrentFormat) +import qualified System.IO.Strict as Strict (readFile) +-- }}} +-- 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 "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, executables :: Bool } +data Flag = Profile String | Prune | Executables | Version | Help deriving Eq + +compactFlags :: [Flag] -> (Flag, Bool, Bool) +compactFlags fs = (flag, not $ null prunes, not $ null execs) where + (prunes, nonPrunes) = partition (==Prune) fs + (execs, nonExecs) = partition (==Executables) nonPrunes + flag = foldr1 compactFlags' . (Profile "default" :) $ nonExecs + compactFlags' Help _ = Help + compactFlags' _ Help = Help + compactFlags' Version _ = Version + compactFlags' _ Version = Version + compactFlags' _ p = p + +parseOptions :: String -> String -> [String] -> Either String Options +parseOptions introText version ss = p where + (opts, dOpts) = fmap (drop 1) . break (== "--") $ ss + p = case onFirst compactFlags $ getOpt RequireOrder options opts of + ((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 +-- }}} +-- filesystem stuff {{{ +type Commands = Map String Double + +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 +-- }}} +-- pure {{{ +onFirst :: (a -> a') -> (a, b, c) -> (a', b, c) +onFirst f (a, b, c) = (f a, b, c) + +sortOn :: Ord b => (a -> b) -> [a] -> [a] +sortOn f = map snd . sortBy (comparing fst) . map (f &&& id) + +descSnd :: Num b => (String, b) -> (b, String) +descSnd = (negate . snd) &&& (map toLower . fst) + +showPriority :: Commands -> String +showPriority = unlines . map fst . sortOn descSnd . toList + +-- decay exponentially, with a one-month half-life +-- The key for decay is that it be monotonic, so that commands will appear in +-- the same order before and after a decay operation; this means we can delay +-- the decay until *after* the user has selected an option. +decay :: UTCTime -> UTCTime -> Commands -> Commands +decay old new = fmap (/factor) where + seconds = fromRational . toRational $ diffUTCTime new old + factor = exp (seconds * log 2 / 2592000) + +-- clip a number to [0, 1] +clip :: (Num a, Ord a) => a -> a +clip = min 1 . max 0 + +-- give a boost, with things close to 0 getting a big boost, and things close +-- to 1 getting a small boost +-- Current method: +-- 1. clip ]-infty, infty[ to [0, 1] +-- 2. scale [0, 1] to [0.5, 1] +-- 3. take sqrt; this is the boost part +-- 4. scale [sqrt 0.5, 1] to [0.01, 1] +boost :: (Floating a, Ord a) => a -> a +boost = postscale . sqrt . prescale . clip where + prescale = (0.5 +) . (/ 2) + postscale = ((0.01 - s2) / ms2 +) . ((0.99 / ms2) *) + s2 = sqrt 0.5 + ms2 = 1 - s2 + +geometricMean :: (Floating a, Ord a) => a -> a -> a +geometricMean a b = sqrt (clip a * clip b) + +-- merge two ratings in a totally ad-hoc heuristic way +-- Current method: +-- 1. clip ]-infty, infty[ to [0, 1] +-- 2. scale [0, 1] to [0.5, 1] +-- 3. take the geometric mean +-- 4. scale [0.5, 1] to [0, 1] +merge :: (Floating a, Ord a) => a -> a -> a +merge a b = postscale (on geometricMean (prescale . clip) a b) where + prescale = (0.5 +) . (/ 2) + postscale = (* 2) . subtract 0.5 + +updatePriority :: String -> UTCTime -> UTCTime -> Commands -> Commands +updatePriority cmd old new cmds = insert cmd pri cmds' where + cmds' = decay old new cmds + pri = boost $ findWithDefault 0 cmd cmds' + +parseInput :: String -> Commands +parseInput = fromList . flip zip (repeat 0) . filter (not . null) . lines + +-- dmenu <=4.3.1 did not print a newline after the selection; dmenu >= 4.4 +-- does. So we need to normalize the string to match between the two versions. +stripNewline :: String -> String +stripNewline "" = "" +stripNewline "\n" = "" +stripNewline (x:xs) = x : stripNewline xs + +-- 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])) +-- }}} diff --git a/main.hs b/main.hs new file mode 100644 --- /dev/null +++ b/main.hs @@ -0,0 +1,97 @@ +-- boilerplate {{{ +module Main where + +import Catch (catch) +import Control.Arrow (second) +import Control.Concurrent (newEmptyMVar, takeMVar, putMVar, forkIO) +import Control.Monad (filterM, forM) +import Data.Map (empty, intersection, union) +import Data.Time (getCurrentTime) +import Prelude hiding (catch) +import System.Directory (getDirectoryContents) +import System.Environment (getArgs, getEnv) +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, versionYeganesh) +import Yeganesh (Commands, Options, addEntries, deprecate, dmenuOpts, + executables, inFileName, outFileName, parseInput, parseOptions, parsePath, + profile, prune, readPossiblyNonExistent, showPriority, stripNewline, + updatePriority) +import qualified System.IO.Strict as Strict (getContents) +-- }}} +-- IO stuff {{{ +catchList :: IO [a] -> IO [a] +catchList = flip catch (const . return $ []) +-- }}} +-- shell stuff {{{ +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 + c <- waitForProcess p + hPutStr stdout o + hPutStr stderr e + cv' <- updateState c o cv + return (c, cv') + +updateState :: ExitCode -> String -> CurrentFormat -> IO CurrentFormat +updateState (ExitFailure {}) _ (t, cmds) = return (t, cmds) +updateState ExitSuccess cmd (t, cmds) = do + now <- getCurrentTime + return (now, updatePriority (stripNewline cmd) t now cmds) + +lsx :: Bool -> IO (IO [String]) +lsx False = return (return []) +lsx True = do + mvar <- newEmptyMVar + _ <- forkIO $ do + path <- catchList $ getEnv "PATH" + execs <- catchList . forM (parsePath path) $ \s -> + catchList (getDirectoryContents s) >>= + 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) + +parseStdin :: Bool -> IO Commands +parseStdin False = fmap parseInput Strict.getContents +parseStdin True = return empty + +runWithOptions :: Options -> IO () +runWithOptions opts = do + future <- lsx (executables opts) + inFile <- inFileName (profile opts) + outFile <- outFileName (profile opts) + cached <- readPossiblyNonExistent inFile + new <- parseStdin (executables opts) + (code, updated) <- dmenu (dmenuOpts opts) (second (`combine` new) cached) + execs <- future + writeFile outFile (show (addEntries execs updated)) + deprecate inFile (profile opts) + exitWith code + where + combine = if prune opts + then \old -> union old >>= intersection + else union +-- }}} +introText :: String +introText = unlines $ [ + versionYeganesh, + "Usage: yeganesh [OPTIONS] [-- DMENU_OPTIONS]", + "OPTIONS are described below, and DMENU_OPTIONS are passed on verbatim to dmenu.", + "Profiles are stored in the XDG data home for yeganesh."] + +main :: IO () +main = getArgs >>= either putStrLn runWithOptions . parseOptions introText versionYeganesh diff --git a/strip.hs b/strip.hs new file mode 100644 --- /dev/null +++ b/strip.hs @@ -0,0 +1,25 @@ +module Main where + +import Data.Map (mapKeysWith) +import System.Environment (getArgs) +import Version (versionStrip) +import Yeganesh (Options, deprecate, inFileName, merge, profile, outFileName, + parseOptions, readPossiblyNonExistent, stripNewline) + +runWithOptions :: Options -> IO () +runWithOptions opts = do + inFile <- inFileName (profile opts) + outFile <- outFileName (profile opts) + (t, cmd) <- readPossiblyNonExistent inFile + writeFile outFile (show (t, mapKeysWith merge stripNewline cmd)) + deprecate inFile (profile opts) + +introText :: String +introText = unlines $ [ + versionStrip, + "Usage: yeganesh-strip [-p profile]", + "The other options described below are accepted, but ignored.", + "Profiles are stored in the XDG data home for yeganesh."] + +main :: IO () +main = getArgs >>= either putStrLn runWithOptions . parseOptions introText versionStrip diff --git a/yeganesh.cabal b/yeganesh.cabal --- a/yeganesh.cabal +++ b/yeganesh.cabal @@ -1,5 +1,5 @@ name: yeganesh -version: 2.3 +version: 2.4 cabal-version: >=1.2 build-type: Simple license: BSD3 @@ -12,10 +12,32 @@ programs I use every day aren't at the beginning of the list. Let's make it so, and automatically! category: Text -extra-source-files: Version.hs +extra-source-files: Catch.hs, Version.hs, Yeganesh.hs +cabal-version: >= 1.6 +source-repository head + type: darcs + location: http://dmwit.com/yeganesh +source-repository this + type: darcs + location: http://dmwit.com/yeganesh + tag: 2.4 Executable yeganesh - main-is: yeganesh.hs + main-is: main.hs + build-depends: base >= 3 && < 5, + containers >= 0.1, + directory >= 1.0, + filepath >= 1.1, + process >= 1.0, + strict >= 0.3, + time >= 1.1, + unix >= 2.5, + xdg-basedir >= 0.2 + ghc-options: -Wall + extensions: CPP + +Executable yeganesh-strip + main-is: strip.hs build-depends: base >= 3 && < 5, containers >= 0.1, directory >= 1.0, diff --git a/yeganesh.hs b/yeganesh.hs deleted file mode 100644 --- a/yeganesh.hs +++ /dev/null @@ -1,223 +0,0 @@ -{-# LANGUAGE CPP #-} --- boilerplate {{{ -module Main where - -import Control.Arrow ((&&&), second) -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) -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, 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.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 "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, executables :: Bool } -data Flag = Profile String | Prune | Executables | Version | Help deriving Eq - -compactFlags :: [Flag] -> (Flag, Bool, Bool) -compactFlags fs = (flag, not $ null prunes, not $ null execs) where - (prunes, nonPrunes) = partition (==Prune) fs - (execs, nonExecs) = partition (==Executables) nonPrunes - flag = foldr1 compactFlags' . (Profile "default" :) $ nonExecs - compactFlags' Help _ = Help - compactFlags' _ Help = Help - compactFlags' Version _ = Version - compactFlags' _ Version = Version - compactFlags' _ p = p - -introText :: String -introText = unlines $ [ - version, - "Usage: yeganesh [OPTIONS] -- [DMENU_OPTIONS]", - "OPTIONS are described below, and DMENU_OPTIONS are passed on verbatim to dmenu.", - "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 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 --- }}} --- filesystem stuff {{{ -type Commands = Map String Double - -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 --- }}} --- pure {{{ -onFirst :: (a -> a') -> (a, b, c) -> (a', b, c) -onFirst f (a, b, c) = (f a, b, c) - -sortOn :: Ord b => (a -> b) -> [a] -> [a] -sortOn f = map snd . sortBy (comparing fst) . map (f &&& id) - -descSnd :: Num b => (String, b) -> (b, String) -descSnd = (negate . snd) &&& (map toLower . fst) - -showPriority :: Commands -> String -showPriority = unlines . map fst . sortOn descSnd . toList - --- decay exponentially, with a one-month half-life --- The key for decay is that it be monotonic, so that commands will appear in --- the same order before and after a decay operation; this means we can delay --- the decay until *after* the user has selected an option. -decay :: UTCTime -> UTCTime -> Commands -> Commands -decay old new = fmap (/factor) where - seconds = fromRational . toRational $ diffUTCTime new old - factor = exp (seconds * log 2 / 2592000) - --- give a boost, with things close to 0 getting a big boost, and things close --- to 1 getting a small boost --- Current method: --- 1. clip ]-infty, infty[ to [0, 1] --- 2. scale [0, 1] to [0.5, 1] --- 3. take sqrt; this is the boost part --- 4. scale [sqrt 0.5, 1] to [0.01, 1] -boost :: (Floating a, Ord a) => a -> a -boost = postscale . sqrt . prescale . clip where - clip = min 1 . max 0 - prescale = (0.5 +) . (/ 2) - postscale = ((0.01 - s2) / ms2 +) . ((0.99 / ms2) *) - s2 = sqrt 0.5 - ms2 = 1 - s2 - -updatePriority :: String -> UTCTime -> UTCTime -> Commands -> Commands -updatePriority cmd old new cmds = insert cmd pri cmds' where - cmds' = decay old new cmds - pri = boost $ findWithDefault 0 cmd cmds' - -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) -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 - c <- waitForProcess p - hPutStr stdout o - hPutStr stderr e - cv' <- updateState c o cv - return (c, cv') - -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) - -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) - execs <- future - writeFile outFile (show (addEntries execs 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