Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- type Flag = DarcsFlag
- type DarcsOptDescr = Compose OptDescr ((->) AbsolutePath)
- type PrimDarcsOption v = forall a. PrimOptSpec DarcsOptDescr Flag a v
- noArg :: [Char] -> [String] -> f -> String -> DarcsOptDescr f
- strArg :: SingleArgOptDescr String f
- optStrArg :: SingleArgOptDescr (Maybe String) f
- absPathArg :: SingleArgOptDescr AbsolutePath f
- absPathOrStdArg :: SingleArgOptDescr AbsolutePathOrStd f
- optAbsPathArg :: [Char] -> [String] -> String -> (AbsolutePath -> f) -> String -> String -> DarcsOptDescr f
- data RawOptSpec f v
- = RawNoArg [Char] [String] f v String
- | RawStrArg [Char] [String] (String -> f) (f -> [String]) (String -> v) (v -> [String]) String String
- | RawAbsPathArg [Char] [String] (AbsolutePath -> f) (f -> [AbsolutePath]) (AbsolutePath -> v) (v -> [AbsolutePath]) String String
- | RawAbsPathOrStdArg [Char] [String] (AbsolutePathOrStd -> f) (f -> [AbsolutePathOrStd]) (AbsolutePathOrStd -> v) (v -> [AbsolutePathOrStd]) String String
- | RawOptAbsPathArg [Char] [String] (AbsolutePath -> f) (f -> [AbsolutePath]) (AbsolutePath -> v) (v -> [AbsolutePath]) String String String
- withDefault :: Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
- singleNoArg :: [Char] -> [String] -> Flag -> String -> PrimDarcsOption Bool
- singleStrArg :: [Char] -> [String] -> (String -> Flag) -> (Flag -> Maybe String) -> String -> String -> PrimDarcsOption (Maybe String)
- multiStrArg :: [Char] -> [String] -> (String -> Flag) -> ([Flag] -> [String]) -> String -> String -> PrimDarcsOption [String]
- multiOptStrArg :: [Char] -> [String] -> (Maybe String -> Flag) -> ([Flag] -> [Maybe String]) -> String -> String -> PrimDarcsOption [Maybe String]
- singleAbsPathArg :: [Char] -> [String] -> (AbsolutePath -> Flag) -> (Flag -> Maybe AbsolutePath) -> String -> String -> PrimDarcsOption (Maybe AbsolutePath)
- multiAbsPathArg :: [Char] -> [String] -> (AbsolutePath -> Flag) -> ([Flag] -> [AbsolutePath]) -> String -> String -> PrimDarcsOption [AbsolutePath]
- deprecated :: [String] -> [RawOptSpec Flag v] -> PrimDarcsOption ()
- parseIntArg :: String -> (Int -> Bool) -> String -> Int
- parseIndexRangeArg :: String -> (Int, Int)
- showIntArg :: Int -> String
- showIndexRangeArg :: (Int, Int) -> String
- withDashes :: [Char] -> [String] -> [String]
- data AbsolutePath
- data AbsolutePathOrStd
Documentation
type Flag = DarcsFlag Source #
This type synonym is here for brevity and because we want to import
the data constructors (but not the type) of DarcsFlag
qualified.
Instantiating OptSpec
and PrimOptSpec
type DarcsOptDescr = Compose OptDescr ((->) AbsolutePath) Source #
We do not instantiate the d
in
directly with
OptSpec
d fOptDescr
. Instead we (post-) compose it with (->)
. Modulo newtype noise, this is the same asAbsolutePath
typeDarcsOptDescr
f =OptDescr
(AbsolutePath
-> f)
This is so we can pass a directory relative to which an option argument is interpreted (if it has the form of a relative path).
type PrimDarcsOption v = forall a. PrimOptSpec DarcsOptDescr Flag a v Source #
This is PrimOptSpec
instantiated with DarcsOptDescr
and Flag
.
Constructing DarcsOptDescr
s
noArg :: [Char] -> [String] -> f -> String -> DarcsOptDescr f Source #
Construct a DarcsOptDescr
with no arguments.
optStrArg :: SingleArgOptDescr (Maybe String) f Source #
Construct a DarcsOptDescr
with an optional String
argument.
absPathArg :: SingleArgOptDescr AbsolutePath f Source #
Construct a DarcsOptDescr
with an AbsolutePath
argument.
absPathOrStdArg :: SingleArgOptDescr AbsolutePathOrStd f Source #
Construct a DarcsOptDescr
with an AbsolutePathOrStd
argument.
optAbsPathArg :: [Char] -> [String] -> String -> (AbsolutePath -> f) -> String -> String -> DarcsOptDescr f Source #
Construct a DarcsOptDescr
with an optional AbsolutePath
argument.
Raw option specs
data RawOptSpec f v Source #
The raw material from which multi-valued options are built. See withDefault
.
RawNoArg [Char] [String] f v String | |
RawStrArg [Char] [String] (String -> f) (f -> [String]) (String -> v) (v -> [String]) String String | |
RawAbsPathArg [Char] [String] (AbsolutePath -> f) (f -> [AbsolutePath]) (AbsolutePath -> v) (v -> [AbsolutePath]) String String | |
RawAbsPathOrStdArg [Char] [String] (AbsolutePathOrStd -> f) (f -> [AbsolutePathOrStd]) (AbsolutePathOrStd -> v) (v -> [AbsolutePathOrStd]) String String | |
RawOptAbsPathArg [Char] [String] (AbsolutePath -> f) (f -> [AbsolutePath]) (AbsolutePath -> v) (v -> [AbsolutePath]) String String String |
Instances
IsoFunctor (RawOptSpec f) Source # | |
Defined in Darcs.UI.Options.Util imap :: Iso a b -> RawOptSpec f a -> RawOptSpec f b Source # |
withDefault :: Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v Source #
Construct a PrimDarcsOption
from a default value and a list of RawOptSpec
.
Precondition: the list must have an entry for each possible value (type v
).
Simple primitive scalar valued options
singleNoArg :: [Char] -> [String] -> Flag -> String -> PrimDarcsOption Bool Source #
Construct a Bool
valued option with a single flag that takes no arguments
and has no default flag.
The arguments are: short switches, long switches, flag value, help string.
singleStrArg :: [Char] -> [String] -> (String -> Flag) -> (Flag -> Maybe String) -> String -> String -> PrimDarcsOption (Maybe String) Source #
Simple primitive list valued options
multiStrArg :: [Char] -> [String] -> (String -> Flag) -> ([Flag] -> [String]) -> String -> String -> PrimDarcsOption [String] Source #
Similar to singleStrArg
, except that the flag can be given more than once.
The flag arguments are collected in a list of String
s.
multiOptStrArg :: [Char] -> [String] -> (Maybe String -> Flag) -> ([Flag] -> [Maybe String]) -> String -> String -> PrimDarcsOption [Maybe String] Source #
Similar to multiStrArg
, except that the flag arguments are optional.
singleAbsPathArg :: [Char] -> [String] -> (AbsolutePath -> Flag) -> (Flag -> Maybe AbsolutePath) -> String -> String -> PrimDarcsOption (Maybe AbsolutePath) Source #
Construct a
valued option with a single flag that
takes an Maybe
AbsolutePath
AbsolutePath
argument and has no default flag.
The arguments are: short switches, long switches, flag constructor, single flag parser, help string.
multiAbsPathArg :: [Char] -> [String] -> (AbsolutePath -> Flag) -> ([Flag] -> [AbsolutePath]) -> String -> String -> PrimDarcsOption [AbsolutePath] Source #
Similar to singleAbsPathArg
, except that the flag can be given more than once.
The flag arguments are collected in a list of AbsolutePath
s.
deprecated :: [String] -> [RawOptSpec Flag v] -> PrimDarcsOption () Source #
A deprecated option. If you want to deprecate only some flags and not the
whole option, extract the RawOptSpec
s out of the original option and create
a new deprecated option.
The strings in the first argument are appended to the automatically generated
error message in case additional hints should be provided.
Parsing/showing option arguments
showIntArg :: Int -> String Source #
Re-exports
data AbsolutePath Source #
Instances
Show AbsolutePath Source # | |
Defined in Darcs.Util.Path showsPrec :: Int -> AbsolutePath -> ShowS # show :: AbsolutePath -> String # showList :: [AbsolutePath] -> ShowS # | |
FilePathLike AbsolutePath Source # | |
Defined in Darcs.Util.Path toFilePath :: AbsolutePath -> FilePath Source # | |
FilePathOrURL AbsolutePath Source # | |
Defined in Darcs.Util.Path toPath :: AbsolutePath -> String Source # | |
Eq AbsolutePath Source # | |
Defined in Darcs.Util.Path (==) :: AbsolutePath -> AbsolutePath -> Bool # (/=) :: AbsolutePath -> AbsolutePath -> Bool # | |
Ord AbsolutePath Source # | |
Defined in Darcs.Util.Path compare :: AbsolutePath -> AbsolutePath -> Ordering # (<) :: AbsolutePath -> AbsolutePath -> Bool # (<=) :: AbsolutePath -> AbsolutePath -> Bool # (>) :: AbsolutePath -> AbsolutePath -> Bool # (>=) :: AbsolutePath -> AbsolutePath -> Bool # max :: AbsolutePath -> AbsolutePath -> AbsolutePath # min :: AbsolutePath -> AbsolutePath -> AbsolutePath # |
data AbsolutePathOrStd Source #
This is for situations where a string (e.g. a command line argument) may take the value "-" to mean stdin or stdout (which one depends on context) instead of a normal file path.
Instances
Show AbsolutePathOrStd Source # | |
Defined in Darcs.Util.Path showsPrec :: Int -> AbsolutePathOrStd -> ShowS # show :: AbsolutePathOrStd -> String # showList :: [AbsolutePathOrStd] -> ShowS # | |
Eq AbsolutePathOrStd Source # | |
Defined in Darcs.Util.Path (==) :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool # (/=) :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool # | |
Ord AbsolutePathOrStd Source # | |
Defined in Darcs.Util.Path compare :: AbsolutePathOrStd -> AbsolutePathOrStd -> Ordering # (<) :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool # (<=) :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool # (>) :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool # (>=) :: AbsolutePathOrStd -> AbsolutePathOrStd -> Bool # max :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd # min :: AbsolutePathOrStd -> AbsolutePathOrStd -> AbsolutePathOrStd # |