yeganesh 2.3 → 2.4
raw patch · 7 files changed
+338/−231 lines, 7 filesnew-component:exe:yeganesh-strip
Files
- Catch.hs +10/−0
- Version.hs +10/−5
- Yeganesh.hs +171/−0
- main.hs +97/−0
- strip.hs +25/−0
- yeganesh.cabal +25/−3
- yeganesh.hs +0/−223
+ Catch.hs view
@@ -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
Version.hs view
@@ -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 -- }}}
+ Yeganesh.hs view
@@ -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]))+-- }}}
+ main.hs view
@@ -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
+ strip.hs view
@@ -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
yeganesh.cabal view
@@ -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,
− yeganesh.hs
@@ -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