Permalink
Browse files

Merge branch 'formatting'.

  • Loading branch information...
2 parents 378c12c + 356758a commit 73a25acffaae6ca752dfa8cf599dc46ba973b76f @pcapriotti committed Dec 8, 2013
@@ -6,19 +6,17 @@ import Control.Applicative ((<$>), (<*>), many)
import Data.Foldable (asum)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe, listToMaybe)
-import System.Exit (ExitCode(..))
import Options.Applicative.Builder
import Options.Applicative.Common
import Options.Applicative.Internal
import Options.Applicative.Types
-bashCompletionParser :: ParserInfo a -> ParserPrefs -> Parser ParserFailure
+bashCompletionParser :: ParserInfo a -> ParserPrefs -> Parser CompletionResult
bashCompletionParser pinfo pprefs = complParser
where
- failure opts = ParserFailure
- { errMessage = \progn -> unlines <$> opts progn
- , errExitCode = ExitSuccess }
+ failure opts = CompletionResult
+ { execCompletion = \progn -> unlines <$> opts progn }
complParser = asum
[ failure <$>
@@ -42,22 +40,27 @@ bashCompletionQuery pinfo pprefs ws i _ = case runCompletion compl pprefs of
. mapParser (\_ -> opt_completions)
opt_completions opt = case optMain opt of
- OptReader ns _ _ -> show_names ns
- FlagReader ns _ -> show_names ns
+ OptReader ns _ _ -> return $ show_names ns
+ FlagReader ns _ -> return $ show_names ns
ArgReader rdr -> run_completer (crCompleter rdr)
- CmdReader ns _ -> filter_names ns
+ CmdReader ns _ -> return $ filter_names ns
+ show_name :: OptName -> String
show_name (OptShort c) = '-':[c]
show_name (OptLong name) = "--" ++ name
+ show_names :: [OptName] -> [String]
show_names = filter_names . map show_name
- filter_names = return . filter is_completion
+
+ filter_names :: [String] -> [String]
+ filter_names = filter is_completion
run_completer :: Completer -> IO [String]
run_completer c = runCompleter c (fromMaybe "" (listToMaybe ws''))
(ws', ws'') = splitAt i ws
+ is_completion :: String -> Bool
is_completion =
case ws'' of
w:_ -> isPrefixOf w
@@ -34,6 +34,7 @@ module Options.Applicative.Builder (
short,
long,
help,
+ helpDoc,
value,
showDefaultWith,
showDefault,
@@ -69,8 +70,11 @@ module Options.Applicative.Builder (
fullDesc,
briefDesc,
header,
- progDesc,
+ headerDoc,
footer,
+ footerDoc,
+ progDesc,
+ progDescDoc,
failureCode,
noIntersperse,
info,
@@ -81,6 +85,7 @@ module Options.Applicative.Builder (
disambiguate,
showHelpOnError,
noBacktrack,
+ columns,
prefs,
-- * Types
@@ -103,6 +108,8 @@ import Options.Applicative.Builder.Completer
import Options.Applicative.Builder.Internal
import Options.Applicative.Common
import Options.Applicative.Types
+import Options.Applicative.Help.Pretty
+import Options.Applicative.Help.Chunk
-- readers --
@@ -131,7 +138,7 @@ long :: HasName f => String -> Mod f a
long = fieldMod . name . OptLong
-- | Specify a default value for an option.
-value :: a -> Mod f a
+value :: HasValue f => a -> Mod f a
value x = Mod id (DefaultProp (Just x) Nothing) id
-- | Specify a function to show the default value for an option.
@@ -144,7 +151,12 @@ showDefault = showDefaultWith show
-- | Specify the help text for an option.
help :: String -> Mod f a
-help s = optionMod $ \p -> p { propHelp = s }
+help s = optionMod $ \p -> p { propHelp = paragraph s }
+
+-- | Specify the help text for an option as a 'Text.PrettyPrint.ANSI.Leijen.Doc'
+-- value.
+helpDoc :: Maybe Doc -> Mod f a
+helpDoc doc = optionMod $ \p -> p { propHelp = Chunk doc }
-- | Specify the 'Option' reader.
reader :: (String -> ReadM a) -> Mod OptionFields a
@@ -159,7 +171,7 @@ noArgError :: ParseError -> Mod OptionFields a
noArgError e = fieldMod $ \p -> p { optNoArgError = e }
-- | Specify the metavariable.
-metavar :: String -> Mod f a
+metavar :: HasMetavar f => String -> Mod f a
metavar var = optionMod $ \p -> p { propMetaVar = var }
-- | Hide this option from the brief description.
@@ -306,15 +318,30 @@ briefDesc = InfoMod $ \i -> i { infoFullDesc = False }
-- | Specify a header for this parser.
header :: String -> InfoMod a
-header s = InfoMod $ \i -> i { infoHeader = s }
+header s = InfoMod $ \i -> i { infoHeader = paragraph s }
+
+-- | Specify a header for this parser as a 'Text.PrettyPrint.ANSI.Leijen.Doc'
+-- value.
+headerDoc :: Maybe Doc -> InfoMod a
+headerDoc doc = InfoMod $ \i -> i { infoHeader = Chunk doc }
-- | Specify a footer for this parser.
footer :: String -> InfoMod a
-footer s = InfoMod $ \i -> i { infoFooter = s }
+footer s = InfoMod $ \i -> i { infoFooter = paragraph s }
+
+-- | Specify a footer for this parser as a 'Text.PrettyPrint.ANSI.Leijen.Doc'
+-- value.
+footerDoc :: Maybe Doc -> InfoMod a
+footerDoc doc = InfoMod $ \i -> i { infoFooter = Chunk doc }
-- | Specify a short program description.
progDesc :: String -> InfoMod a
-progDesc s = InfoMod $ \i -> i { infoProgDesc = s }
+progDesc s = InfoMod $ \i -> i { infoProgDesc = paragraph s }
+
+-- | Specify a short program description as a 'Text.PrettyPrint.ANSI.Leijen.Doc'
+-- value.
+progDescDoc :: Maybe Doc -> InfoMod a
+progDescDoc doc = InfoMod $ \i -> i { infoProgDesc = Chunk doc }
-- | Specify an exit code if a parse error occurs.
failureCode :: Int -> InfoMod a
@@ -331,9 +358,9 @@ info parser m = applyInfoMod m base
base = ParserInfo
{ infoParser = parser
, infoFullDesc = True
- , infoProgDesc = ""
- , infoHeader = ""
- , infoFooter = ""
+ , infoProgDesc = mempty
+ , infoHeader = mempty
+ , infoFooter = mempty
, infoFailureCode = 1
, infoIntersperse = True }
@@ -356,14 +383,18 @@ showHelpOnError = PrefsMod $ \p -> p { prefShowHelpOnError = True }
noBacktrack :: PrefsMod
noBacktrack = PrefsMod $ \p -> p { prefBacktrack = False }
+columns :: Int -> PrefsMod
+columns cols = PrefsMod $ \p -> p { prefColumns = cols }
+
prefs :: PrefsMod -> ParserPrefs
prefs m = applyPrefsMod m base
where
base = ParserPrefs
{ prefMultiSuffix = ""
, prefDisambiguate = False
, prefShowHelpOnError = False
- , prefBacktrack = True }
+ , prefBacktrack = True
+ , prefColumns = 80 }
-- convenience shortcuts
@@ -3,6 +3,8 @@ module Options.Applicative.Builder.Internal (
Mod(..),
HasName(..),
HasCompleter(..),
+ HasValue,
+ HasMetavar,
OptionFields(..),
FlagFields(..),
CommandFields(..),
@@ -62,6 +64,23 @@ instance HasCompleter OptionFields where
instance HasCompleter ArgumentFields where
modCompleter f p = p { argCompleter = f (argCompleter p) }
+class HasValue f where
+ -- this is just so that it is not necessary to specify the kind of f
+ hasValueDummy :: f a -> ()
+instance HasValue OptionFields where
+ hasValueDummy _ = ()
+instance HasValue ArgumentFields where
+ hasValueDummy _ = ()
+
+class HasMetavar f where
+ hasMetavarDummy :: f a -> ()
+instance HasMetavar OptionFields where
+ hasMetavarDummy _ = ()
+instance HasMetavar ArgumentFields where
+ hasMetavarDummy _ = ()
+instance HasMetavar CommandFields where
+ hasMetavarDummy _ = ()
+
-- mod --
data DefaultProp a = DefaultProp
@@ -118,7 +137,7 @@ baseProps :: OptProperties
baseProps = OptProperties
{ propMetaVar = ""
, propVisibility = Visible
- , propHelp = ""
+ , propHelp = mempty
, propShowDefault = Nothing }
mkCommand :: Mod CommandFields a -> ([String], String -> Maybe (ParserInfo a))
Oops, something went wrong.

0 comments on commit 73a25ac

Please sign in to comment.