diff --git a/dmenu.cabal b/dmenu.cabal --- a/dmenu.cabal +++ b/dmenu.cabal @@ -1,7 +1,7 @@ name: dmenu version: - 0.3.0.0 + 0.3.1.0 synopsis: Complete bindings to the dmenu and dmenu2 command line tools. description: diff --git a/src/DMenu.hs b/src/DMenu.hs --- a/src/DMenu.hs +++ b/src/DMenu.hs @@ -34,6 +34,9 @@ printVersionAndExit, dmenu2, noDMenu2, + extraArgs, + -- ** Forwarding Command Line Arguments + forwardExtraArgs, -- * @dmenu2@-specific Command Line Options Options2(), @@ -66,6 +69,7 @@ -- * Configuration File -- $configFile + configFileUsage, ) where import Control.Lens @@ -112,7 +116,7 @@ Note for @stack@ users: When running programs using this library via @stack exec@, the program may fail to find @dmenu@ in the @PATH@. This problem can be solved by running the program directly without @stack@, or - by temporarily using an absolute path for @dmenu@ in the '_binaryPath' option. + by temporarily using an absolute path for @dmenu@ in the 'binaryPath' option. -} {- $configFile The default @Options@ used by 'run', 'select', etc. can be specified @@ -122,12 +126,18 @@ the first section: > numLines 15 - > font FiraMono:size=11 + > font "FiraMono:size=11" > caseInsensitive True > normalBGColor RGBColorF 0.02 0.02 0.02 The configuration file contains one line per option. Each line consists of an option name and a value for the option. The option names are identical to the corresponding lens names. - The values are read with @Prelude.read@ except for @Strings@ which don't need double quotes. + The values are read via their 'Read' instances. + + If reading a value fails, 'exitFailure' is called and an error message is + presented to the user, e.g. + + > `caseInsensitive` must be a boolean, i.e. `True` or `False`. + -} diff --git a/src/DMenu/Options.hs b/src/DMenu/Options.hs --- a/src/DMenu/Options.hs +++ b/src/DMenu/Options.hs @@ -4,6 +4,7 @@ module DMenu.Options where import Control.Lens +import Text.Read (readMaybe) import DMenu.Color import DMenu.Lens @@ -26,6 +27,7 @@ , _printVersionAndExit :: Bool , _dmenu2 :: Options2 , _noDMenu2 :: Bool + , _extraArgs :: [String] } -- | Contains the command line options of @dmenu2@ which are not part of @@ -105,12 +107,20 @@ -- | Extra options only available in the dmenu2 fork. dmenu2 :: Lens' Options Options2 dmenu2 = _dmenu2L --- | When set to @True@, the @dmenu2@ options in '_dmenu2' are ignored. This +-- | When set to @True@, the 'dmenu2' options are ignored. This -- ensures compatibility with the normal @dmenu@. A user may set this flag -- in the configuration file. noDMenu2 :: Lens' Options Bool noDMenu2 = _noDMenu2L +-- | List of extra command line arguments to pass to @dmenu@. +-- This can be useful, when the client wants to forward some of its own command +-- line arguments directly to the executed @dmenu@ processes. +-- +-- Default: @[]@ +extraArgs :: Lens' Options [String] +extraArgs = _extraArgsL + -- | @-q@; dmenu will not show any items if the search string is empty. displayNoItemsIfEmpty :: Lens' Options2 Bool displayNoItemsIfEmpty = _displayNoItemsIfEmptyL @@ -197,6 +207,7 @@ , _printVersionAndExit = False , _dmenu2 = defOptions2 , _noDMenu2 = False + , _extraArgs = [] } defOptions2 :: Options2 @@ -223,23 +234,26 @@ } optionsToArgs :: Options → [String] -optionsToArgs (Options{..}) = concat $ concat $ - [ [ [ "-b" ] | _displayAtBottom ] - , [ [ "-f" ] | _grabKeyboardBeforeStdin ] - , [ [ "-i" ] | _caseInsensitive ] - , [ [ "-m", show _spawnOnMonitor ] | _spawnOnMonitor /= (-1) ] - , [ [ "-l", show _numLines ] | _numLines /= (-1) ] - , [ [ "-p", _prompt ] | _prompt /= "" ] - , [ [ "-fn", _font ] | _font /= "" ] - , [ [ "-nb", showColorAsHex _normalBGColor ] | _normalBGColor /= HexColor (-1) ] - , [ [ "-nf", showColorAsHex _normalFGColor ] | _normalFGColor /= HexColor (-1) ] - , [ [ "-sb", showColorAsHex _selectedBGColor ] | _selectedBGColor /= HexColor (-1) ] - , [ [ "-sf", showColorAsHex _selectedFGColor ] | _selectedFGColor /= HexColor (-1) ] - , [ [ "-v" ] | _printVersionAndExit ] - ] ++ if _noDMenu2 then [] else options2ToArgs _dmenu2 +optionsToArgs (Options{..}) = dmenuArgs ++ dmenu2Args ++ _extraArgs where + dmenuArgs = concat $ concat + [ [ [ "-b" ] | _displayAtBottom ] + , [ [ "-f" ] | _grabKeyboardBeforeStdin ] + , [ [ "-i" ] | _caseInsensitive ] + , [ [ "-m", show _spawnOnMonitor ] | _spawnOnMonitor /= (-1) ] + , [ [ "-l", show _numLines ] | _numLines /= (-1) ] + , [ [ "-p", _prompt ] | _prompt /= "" ] + , [ [ "-fn", _font ] | _font /= "" ] + , [ [ "-nb", showColorAsHex _normalBGColor ] | _normalBGColor /= HexColor (-1) ] + , [ [ "-nf", showColorAsHex _normalFGColor ] | _normalFGColor /= HexColor (-1) ] + , [ [ "-sb", showColorAsHex _selectedBGColor ] | _selectedBGColor /= HexColor (-1) ] + , [ [ "-sf", showColorAsHex _selectedFGColor ] | _selectedFGColor /= HexColor (-1) ] + , [ [ "-v" ] | _printVersionAndExit ] + ] + dmenu2Args | _noDMenu2 = [] + | otherwise = options2ToArgs _dmenu2 -options2ToArgs :: Options2 → [[[String]]] -options2ToArgs (Options2{..}) = +options2ToArgs :: Options2 → [String] +options2ToArgs (Options2{..}) = concat $ concat [ [ [ "-q" ] | _displayNoItemsIfEmpty ] , [ [ "-r" ] | _filterMode ] , [ [ "-z" ] | _fuzzyMatching ] @@ -261,45 +275,121 @@ , [ [ "-hist", show _historyFile ] | _historyFile /= "" ] ] -parseOptions :: String → Options -parseOptions = foldl f defOptions . map splitFirstWord . lines where - f :: Options → (String, String) → Options - f opts (cmd, args) = opts & case cmd of - "binaryPath" → binaryPath .~ args - "displayAtBottom" → displayAtBottom .~ read args - "displayNoItemsIfEmpty" → dmenu2 . displayNoItemsIfEmpty .~ read args - "grabKeyboardBeforeStdin" → grabKeyboardBeforeStdin .~ read args - "filterMode" → dmenu2 . filterMode .~ read args - "caseInsensitive" → caseInsensitive .~ read args - "fuzzyMatching" → dmenu2 . fuzzyMatching .~ read args - "tokenMatching" → dmenu2 . tokenMatching .~ read args - "maskInputWithStar" → dmenu2 . maskInputWithStar .~ read args - "ignoreStdin" → dmenu2 . ignoreStdin .~ read args - "spawnOnScreen" → dmenu2 . spawnOnScreen .~ read args - "spawnOnMonitor" → spawnOnMonitor .~ read args - "windowName" → dmenu2 . windowName .~ args - "windowClass" → dmenu2 . windowClass .~ args - "windowOpacity" → dmenu2 . windowOpacity .~ read args - "windowDimOpacity" → dmenu2 . windowDimOpacity .~ read args - "windowDimColor" → dmenu2 . windowDimColor .~ read args - "numLines" → numLines .~ read args - "heightInPixels" → dmenu2 . heightInPixels .~ read args - "underlineHeightInPixels" → dmenu2 . underlineHeightInPixels .~ read args - "prompt" → prompt .~ args - "font" → font .~ args - "windowOffsetX" → dmenu2 . windowOffsetX .~ read args - "windowOffsetY" → dmenu2 . windowOffsetY .~ read args - "width" → dmenu2 . width .~ read args - "normalBGColor" → normalBGColor .~ read args - "normalFGColor" → normalFGColor .~ read args - "selectedBGColor" → selectedBGColor .~ read args - "selectedFGColor" → selectedFGColor .~ read args - "underlineColor" → dmenu2 . underlineColor .~ read args - "historyFile" → dmenu2 . historyFile .~ args - "printVersionAndExit" → printVersionAndExit .~ read args - "noDMenu2" → noDMenu2 .~ read args - "" → id - _ → error $ "Invalid command found when parsing dmenu config file: " ++ cmd +readOr :: Read a => String → String → Either String a +readOr s err = case readMaybe s of + Nothing -> Left err + Just x -> Right x + +parseOptions :: String → Either String Options +parseOptions = foldl f (Right defOptions) . map splitFirstWord . lines where + stringErr cmd = "`" ++ cmd ++ "` must be a string, e.g. `\"/foo/bar\"`" + boolErr cmd = "`" ++ cmd ++ "` must be a boolean, i.e. `True` or `False`." + natErr cmd = "`" ++ cmd ++ "` must be a natural number, i.e. `0` or `20`." + floatErr cmd = "`" ++ cmd ++ "` must be a floating point number, i.e. `0` or `20.23`." + colorErr cmd = "`" ++ cmd ++ "` must be a color, i.e. `RGBColorF 1 0 0` for red." + f :: Either String Options → (String, String) → Either String Options + f opts (cmd, args) = opts >>= case cmd of + "binaryPath" → mapM (binaryPath .~) $ readOr args (stringErr cmd) + "displayAtBottom" → mapM (displayAtBottom .~) $ readOr args (boolErr cmd) + "displayNoItemsIfEmpty" → mapM (dmenu2 . displayNoItemsIfEmpty .~) $ readOr args (boolErr cmd) + "grabKeyboardBeforeStdin" → mapM (grabKeyboardBeforeStdin .~) $ readOr args (boolErr cmd) + "filterMode" → mapM (dmenu2 . filterMode .~) $ readOr args (boolErr cmd) + "caseInsensitive" → mapM (caseInsensitive .~) $ readOr args (boolErr cmd) + "fuzzyMatching" → mapM (dmenu2 . fuzzyMatching .~) $ readOr args (boolErr cmd) + "tokenMatching" → mapM (dmenu2 . tokenMatching .~) $ readOr args (boolErr cmd) + "maskInputWithStar" → mapM (dmenu2 . maskInputWithStar .~) $ readOr args (boolErr cmd) + "ignoreStdin" → mapM (dmenu2 . ignoreStdin .~) $ readOr args (boolErr cmd) + "spawnOnScreen" → mapM (dmenu2 . spawnOnScreen .~) $ readOr args (natErr cmd) + "spawnOnMonitor" → mapM (spawnOnMonitor .~) $ readOr args (natErr cmd) + "windowName" → mapM (dmenu2 . windowName .~) $ readOr args (stringErr cmd) + "windowClass" → mapM (dmenu2 . windowClass .~) $ readOr args (stringErr cmd) + "windowOpacity" → mapM (dmenu2 . windowOpacity .~) $ readOr args (floatErr cmd) + "windowDimOpacity" → mapM (dmenu2 . windowDimOpacity .~) $ readOr args (floatErr cmd) + "windowDimColor" → mapM (dmenu2 . windowDimColor .~) $ readOr args (colorErr cmd) + "numLines" → mapM (numLines .~) $ readOr args (natErr cmd) + "heightInPixels" → mapM (dmenu2 . heightInPixels .~) $ readOr args (natErr cmd) + "underlineHeightInPixels" → mapM (dmenu2 . underlineHeightInPixels .~) $ readOr args (natErr cmd) + "prompt" → mapM (prompt .~) $ readOr args (stringErr cmd) + "font" → mapM (font .~) $ readOr args (stringErr cmd) + "windowOffsetX" → mapM (dmenu2 . windowOffsetX .~) $ readOr args (natErr cmd) + "windowOffsetY" → mapM (dmenu2 . windowOffsetY .~) $ readOr args (natErr cmd) + "width" → mapM (dmenu2 . width .~) $ readOr args (natErr cmd) + "normalBGColor" → mapM (normalBGColor .~) $ readOr args (colorErr cmd) + "normalFGColor" → mapM (normalFGColor .~) $ readOr args (colorErr cmd) + "selectedBGColor" → mapM (selectedBGColor .~) $ readOr args (colorErr cmd) + "selectedFGColor" → mapM (selectedFGColor .~) $ readOr args (colorErr cmd) + "underlineColor" → mapM (dmenu2 . underlineColor .~) $ readOr args (colorErr cmd) + "historyFile" → mapM (dmenu2 . historyFile .~) $ readOr args (stringErr cmd) + "printVersionAndExit" → mapM (printVersionAndExit .~) $ readOr args (boolErr cmd) + "noDMenu2" → mapM (noDMenu2 .~) $ readOr args (boolErr cmd) + "" → pure + _ → const $ Left $ "Invalid command: " ++ cmd + +-- | Description of the configuration file syntax of ~/.haskell-dmenu, as written +-- in the file. +-- +-- This 'String' may be useful to inform clients about the config file, e.g. in +-- the usage information. +configFileUsage :: String +configFileUsage = unlines + [ "The `dmenu` Haskell bindings support specifying default command line arguments" + , "passed to `dmenu` in the `~/.haskell-dmenu` file." + , "" + , "The following shows an example ~/.haskell-dmenu file:" + , "" + , " numLines 15" + , " font \"FiraMono:size=11\"" + , " caseInsensitive True" + , " normalBGColor RGBColorF 0.02 0.02 0.02" + , "" + , "Each line specifies the value of a dmenu option." + , "The first word of a line specifies the option, the rest of the line the value." + , "Depending on the option, the value has one of the following types and forms:" + , "" + , " Nat A natural number, e.g. 0, 1, 2, etc." + , " Float A floating point number, e.g. -12 or 13.43" + , " String A string literal, e.g. \"foo bar\"" + , " Color An RGB color. For example, the color red can be specified as" + , " HexColor 0xFF0000 (hexadecimal)" + , " RGBColor 255 0 0 (dezimal, split components)" + , " RGBColorF 1.0 0.0 0.0 (normalized, split components)" + , "" + , "All dmenu and dmenu2 options are supported:" + , "" + , " binaryPath : String" + , " displayAtBottom : Bool" + , " displayNoItemsIfEmpty : Bool" + , " grabKeyboardBeforeStdin : Bool" + , " filterMode : Bool" + , " caseInsensitive : Bool" + , " fuzzyMatching : Bool" + , " tokenMatching : Bool" + , " maskInputWithStar : Bool" + , " ignoreStdin : Bool" + , " spawnOnScreen : Nat" + , " spawnOnMonitor : Nat" + , " windowName : String" + , " windowClass : String" + , " windowOpacity : Float" + , " windowDimOpacity : Float" + , " windowDimColor : Color" + , " numLines : Nat" + , " heightInPixels : Nat" + , " underlineHeightInPixels : Nat" + , " prompt : String" + , " font : String" + , " windowOffsetX : Nat" + , " windowOffsetY : Nat" + , " width : Nat" + , " normalBGColor : Color" + , " normalFGColor : Color" + , " selectedBGColor : Color" + , " selectedFGColor : Color" + , " underlineColor : Color" + , " historyFile : String" + , " printVersionAndExit : Bool" + , " noDMenu2 : Bool" + ] -- printOptions :: Options → String -- printOptions Options{..} = unlines $ concat diff --git a/src/DMenu/Run.hs b/src/DMenu/Run.hs --- a/src/DMenu/Run.hs +++ b/src/DMenu/Run.hs @@ -12,6 +12,8 @@ import System.Exit import System.Process import System.Directory +import System.Environment +import System.IO import Prelude hiding (filter) import DMenu.Options @@ -28,7 +30,7 @@ -- and @stderr@ output. type ProcessError = (Int, String) --- | Run a @StateT Options m a@ action using the command line options from the +-- | Run a @StateT@ 'Options' @m a@ action using the command line options from the -- config file or an empty set of options as initial state. -- -- For example @@ -81,7 +83,7 @@ select :: MonadIO m => DMenuT m () - -- ^ @State Options@ action which changes the default command line + -- ^ 'State' 'Options' action which changes the default command line -- options. → [String] -- ^ List from which the user should select. @@ -121,7 +123,7 @@ selectWith :: MonadIO m => DMenuT m () - -- ^ @State Options@ action which changes the default command line + -- ^ 'State' 'Options' action which changes the default command line -- options. → (a → String) -- ^ How to display an @a@ in @dmenu@. @@ -160,7 +162,7 @@ filter :: MonadIO m => DMenuT m () - -- ^ @State Options@ action which changes the default command line + -- ^ 'State' 'Options' action which changes the default command line -- options. → [String] -- ^ List from which the user should select. @@ -190,7 +192,7 @@ filterWith :: MonadIO m => DMenuT m () - -- ^ @State Options@ action which changes the default command line + -- ^ 'State' 'Options' action which changes the default command line -- options. → (a → String) -- ^ How to display an @a@ in @dmenu@. @@ -202,6 +204,14 @@ filterWith m0 f xs = run $ m0 >> filterWithM f xs +-- | Forwards all command line arguments from 'getArgs', which appear after the +-- first @\"--\"@ argument, to @dmenu@ by setting them as 'extraArgs'. +forwardExtraArgs :: MonadDMenu m => m () +forwardExtraArgs = do + args <- liftIO getArgs + extraArgs .= drop 1 (dropWhile (/= "--") args) + + splitFirstWord :: String → (String, String) splitFirstWord = go "" where go s [] = (s, []) @@ -213,7 +223,14 @@ (Just <$> readFile path) `catch` (\(_ :: SomeException) → pure Nothing) readConfigOrDef :: MonadIO m => FilePath → m Options -readConfigOrDef = fmap f . readFileMay where +readConfigOrDef = f <=< readFileMay where f = \case - Nothing → defOptions - Just content → parseOptions content + Nothing → + pure defOptions + Just content → + case parseOptions content of + Right opts → + pure opts + Left err → liftIO $ do + putStrLn $ "Failed parsing `~/.haskell-dmenu` file: " ++ err + exitFailure