ENH add wrap to command line text

This commit is contained in:
Nathan Dwarshuis 2020-05-01 22:22:28 -04:00
parent 7c1d899be6
commit 09e8bc9372
2 changed files with 25 additions and 22 deletions

View File

@ -13,11 +13,13 @@ import Data.List.Split (splitOn)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Map.Ordered as O import qualified Data.Map.Ordered as O
import Data.Maybe import Data.Maybe
import Data.Text (unpack)
import Rofi.Command import Rofi.Command
import Text.Printf import Text.Printf
import Text.Regex.TDFA import Text.Regex.TDFA
import Text.Wrap
import System.Console.GetOpt import System.Console.GetOpt
import System.Directory import System.Directory
@ -56,32 +58,32 @@ initMountConf a = conf <$> getEffectiveUserName
options :: [OptDescr (MountConf -> MountConf)] options :: [OptDescr (MountConf -> MountConf)]
options = options =
-- TODO clean up massive text blocks here with textwrap
[ Option ['s'] ["secret"] [ Option ['s'] ["secret"]
(ReqArg (\s m -> m { credentials = addGetSecret (credentials m) s } ) "SECRET") (ReqArg (\s m -> m { credentials = addGetSecret (credentials m) s } ) "SECRET")
("Use libsecret to retrieve password for DIR using ATTR/VAL pairs.\n" ++ $ wrap "Use libsecret to retrieve password for DIR using ATTR/VAL pairs. \
"The pairs will be supplied to a 'secret-tool lookup' call.\n" ++ \The pairs will be supplied to a 'secret-tool lookup' call. \
"Argument is formatted like 'DIR:ATTR1=VAL1,ATTR2=VAL2...'") \ Argument is formatted like 'DIR:ATTR1=VAL1,ATTR2=VAL2...'"
, Option ['d'] ["directory"] , Option ['d'] ["directory"]
(ReqArg (\s m -> m { mountDir = s } ) "DIR") (ReqArg (\s m -> m { mountDir = s } ) "DIR")
("The directory in which new mountpoints will be created. This is\n" ++ $ wrap "The DIR in which new mountpoints will be created. This is assumed \
"assumed to be writable to the current user, and will be used for\n" ++ \to be writable to the current user, and will be used for fuse \
"fuse entries as well as user mounts in fstab. For the latter, it is\n" ++ \entries as well as user mounts in fstab. For the latter, it is \
"assumed that all user mounts contain this directory if a mountpoint\n" ++ \assumed that all user mounts contain this directory if a \
"does not already exist for them. If not diven this will default to\n" ++ \mountpoint does not already exist for them. If not given this will \
"'/media/USER'.") \default to '/media/USER'."
, Option ['p'] ["password"] , Option ['p'] ["password"]
(ReqArg (\s m -> m { credentials = addGetPrompt (credentials m) s } ) "DIR") (ReqArg (\s m -> m { credentials = addGetPrompt (credentials m) s } ) "DIR")
"Prompt for password when mounting DIR." "Prompt for password when mounting DIR."
] ]
where
wrap = unpack . wrapText defaultWrapSettings 40
parse :: [String] -> IO () parse :: [String] -> IO ()
parse args = case getOpt Permute options args of parse args = case getOpt Permute options args of
(o, n, []) -> do (o, n, []) -> initMountConf n >>= \i -> runMounts $ foldl (flip id) i o
i <- initMountConf n (_, _, errs) -> ioError $ userError $ concat errs ++ usageInfo h options
runMounts $ foldl (flip id) i o where
-- TODO make this a real error h = "Usage: rofi-dev [OPTIONS] [-- ROFI-OPTIONS]"
(_, _, errs) -> putStrLn $ concat errs ++ usageInfo "header" options
addGetSecret :: DevicePasswords -> String -> DevicePasswords addGetSecret :: DevicePasswords -> String -> DevicePasswords
addGetSecret pwds c = case splitPrefix c of addGetSecret pwds c = case splitPrefix c of
@ -292,16 +294,15 @@ instance Mountable CIFS where
-- TODO this smells like something that should be in a typeclass -- TODO this smells like something that should be in a typeclass
fstabToCIFS :: FSTabEntry -> RofiIO MountConf CIFS fstabToCIFS :: FSTabEntry -> RofiIO MountConf CIFS
fstabToCIFS FSTabEntry{ fstabSpec = s, fstabDir = d, fstabOptions = o } = do fstabToCIFS FSTabEntry{ fstabSpec = s, fstabDir = d, fstabOptions = o } = do
-- This is a hack. If the options specify "guest" don't require a -- If the options specify "guest" don't require a password. Else try to find a
-- password. Else try to find a means to get the password from the -- means to get the password from the command line options provided for the
-- command line options provided for the this mountpoint. If nothing is -- this mountpoint. If nothing is found, prompt for a password. In any case,
-- found, create a dummy function that returns "" as the password, which -- the output will be passed to env variable PASSWD when mounting this cifs
-- will be passed to the env variable PASSWD when mounting this cifs -- directory and cause it to fail. Setting the env variable is necessary as
-- directory and cause it to fail. Setting the env variable is necessary
-- the cifs mount call will prompt for a password and hang otherwise. -- the cifs mount call will prompt for a password and hang otherwise.
pwd <- if M.member "guest" o pwd <- if M.member "guest" o
then return Nothing then return Nothing
else Just . M.findWithDefault (return $ Just "") d <$> asks credentials else Just . M.findWithDefault readPassword d <$> asks credentials
let r = Removable { deviceSpec = smartSlashPrefix s, label = takeFileName d } let r = Removable { deviceSpec = smartSlashPrefix s, label = takeFileName d }
return $ CIFS r d pwd return $ CIFS r d pwd
where where

View File

@ -36,6 +36,8 @@ dependencies:
- filepath >= 1.4.2.1 - filepath >= 1.4.2.1
- unliftio >= 0.2.12 - unliftio >= 0.2.12
- unliftio-core >= 0.1.2.0 - unliftio-core >= 0.1.2.0
- word-wrap >= 0.4.1
- text >= 1.2.3.1
# - cassava >= 0.5.2.0 # - cassava >= 0.5.2.0
# - vector >= 0.12.0.3 # - vector >= 0.12.0.3