module Darcs.UI.Options.Util
( Flag
, DarcsOptDescr
, PrimDarcsOption
, noArg
, strArg
, optStrArg
, absPathArg
, absPathOrStdArg
, optAbsPathArg
, RawOptSpec(..)
, withDefault
, singleNoArg
, singleStrArg
, multiStrArg
, multiOptStrArg
, singleAbsPathArg
, multiAbsPathArg
, deprecated
, parseIntArg
, parseIndexRangeArg
, showIntArg
, showIndexRangeArg
, AbsolutePath
, AbsolutePathOrStd
, makeAbsolute
, makeAbsoluteOrStd
) where
import Darcs.Prelude
import Control.Exception ( Exception, throw )
import Data.Functor.Compose
import Data.List ( intercalate )
import Data.Maybe ( maybeToList, fromMaybe )
import Data.Typeable ( Typeable )
import System.Console.GetOpt ( OptDescr(..), ArgDescr(..) )
import Darcs.UI.Options.Core
import Darcs.UI.Options.Flags ( DarcsFlag )
import Darcs.UI.Options.Iso
import Darcs.Util.Path
( AbsolutePath
, AbsolutePathOrStd
, makeAbsolute
, makeAbsoluteOrStd
)
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
noArg :: forall f. [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
noArg [Char]
s [[Char]]
l f
f [Char]
h = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (forall a. a -> ArgDescr a
NoArg (forall a b. a -> b -> a
const f
f)) [Char]
h
type SingleArgOptDescr a f =
[Char] -> [String] -> (a -> f) -> String -> String -> DarcsOptDescr f
strArg :: SingleArgOptDescr String f
strArg :: forall f. SingleArgOptDescr [Char] f
strArg [Char]
s [[Char]]
l [Char] -> f
f [Char]
a [Char]
h = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x AbsolutePath
_ -> [Char] -> f
f [Char]
x) [Char]
a) [Char]
h
optStrArg :: SingleArgOptDescr (Maybe String) f
optStrArg :: forall f. SingleArgOptDescr (Maybe [Char]) f
optStrArg [Char]
s [[Char]]
l Maybe [Char] -> f
f [Char]
a [Char]
h = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (forall a. (Maybe [Char] -> a) -> [Char] -> ArgDescr a
OptArg (\Maybe [Char]
x AbsolutePath
_ -> Maybe [Char] -> f
f Maybe [Char]
x) [Char]
a) [Char]
h
absPathArg :: SingleArgOptDescr AbsolutePath f
absPathArg :: forall f. SingleArgOptDescr AbsolutePath f
absPathArg [Char]
s [[Char]]
l AbsolutePath -> f
f [Char]
a [Char]
h = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x AbsolutePath
wd -> AbsolutePath -> f
f forall a b. (a -> b) -> a -> b
$ AbsolutePath -> [Char] -> AbsolutePath
makeAbsolute AbsolutePath
wd [Char]
x) [Char]
a) [Char]
h
absPathOrStdArg :: SingleArgOptDescr AbsolutePathOrStd f
absPathOrStdArg :: forall f. SingleArgOptDescr AbsolutePathOrStd f
absPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
f [Char]
a [Char]
h = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x AbsolutePath
wd -> AbsolutePathOrStd -> f
f forall a b. (a -> b) -> a -> b
$ AbsolutePath -> [Char] -> AbsolutePathOrStd
makeAbsoluteOrStd AbsolutePath
wd [Char]
x) [Char]
a) [Char]
h
optAbsPathArg :: [Char] -> [String] -> String -> (AbsolutePath -> f)
-> String -> String -> DarcsOptDescr f
optAbsPathArg :: forall f.
[Char]
-> [[Char]]
-> [Char]
-> (AbsolutePath -> f)
-> [Char]
-> [Char]
-> DarcsOptDescr f
optAbsPathArg [Char]
s [[Char]]
l [Char]
d AbsolutePath -> f
f [Char]
a [Char]
h = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (forall a. (Maybe [Char] -> a) -> [Char] -> ArgDescr a
OptArg (\Maybe [Char]
x AbsolutePath
wd -> AbsolutePath -> f
f forall a b. (a -> b) -> a -> b
$ AbsolutePath -> [Char] -> AbsolutePath
makeAbsolute AbsolutePath
wd forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [Char]
d Maybe [Char]
x) [Char]
a) [Char]
h
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
instance IsoFunctor (RawOptSpec f) where
imap :: forall a b. Iso a b -> RawOptSpec f a -> RawOptSpec f b
imap (Iso a -> b
fw b -> a
_) (RawNoArg [Char]
s [[Char]]
l f
f a
v [Char]
h) = forall f v.
[Char] -> [[Char]] -> f -> v -> [Char] -> RawOptSpec f v
RawNoArg [Char]
s [[Char]]
l f
f (a -> b
fw a
v) [Char]
h
imap (Iso a -> b
fw b -> a
bw) (RawStrArg [Char]
s [[Char]]
l [Char] -> f
mkF f -> [[Char]]
unF [Char] -> a
mkV a -> [[Char]]
unV [Char]
n [Char]
h) = forall f v.
[Char]
-> [[Char]]
-> ([Char] -> f)
-> (f -> [[Char]])
-> ([Char] -> v)
-> (v -> [[Char]])
-> [Char]
-> [Char]
-> RawOptSpec f v
RawStrArg [Char]
s [[Char]]
l [Char] -> f
mkF f -> [[Char]]
unF (a -> b
fw forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> a
mkV) (a -> [[Char]]
unV forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bw) [Char]
n [Char]
h
imap (Iso a -> b
fw b -> a
bw) (RawAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF f -> [AbsolutePath]
unF AbsolutePath -> a
mkV a -> [AbsolutePath]
unV [Char]
n [Char]
h) = forall f v.
[Char]
-> [[Char]]
-> (AbsolutePath -> f)
-> (f -> [AbsolutePath])
-> (AbsolutePath -> v)
-> (v -> [AbsolutePath])
-> [Char]
-> [Char]
-> RawOptSpec f v
RawAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF f -> [AbsolutePath]
unF (a -> b
fw forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> a
mkV) (a -> [AbsolutePath]
unV forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bw) [Char]
n [Char]
h
imap (Iso a -> b
fw b -> a
bw) (RawAbsPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
mkF f -> [AbsolutePathOrStd]
unF AbsolutePathOrStd -> a
mkV a -> [AbsolutePathOrStd]
unV [Char]
n [Char]
h) = forall f v.
[Char]
-> [[Char]]
-> (AbsolutePathOrStd -> f)
-> (f -> [AbsolutePathOrStd])
-> (AbsolutePathOrStd -> v)
-> (v -> [AbsolutePathOrStd])
-> [Char]
-> [Char]
-> RawOptSpec f v
RawAbsPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
mkF f -> [AbsolutePathOrStd]
unF (a -> b
fw forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePathOrStd -> a
mkV) (a -> [AbsolutePathOrStd]
unV forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bw) [Char]
n [Char]
h
imap (Iso a -> b
fw b -> a
bw) (RawOptAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF f -> [AbsolutePath]
unF AbsolutePath -> a
mkV a -> [AbsolutePath]
unV [Char]
d [Char]
n [Char]
h) = forall f v.
[Char]
-> [[Char]]
-> (AbsolutePath -> f)
-> (f -> [AbsolutePath])
-> (AbsolutePath -> v)
-> (v -> [AbsolutePath])
-> [Char]
-> [Char]
-> [Char]
-> RawOptSpec f v
RawOptAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF f -> [AbsolutePath]
unF (a -> b
fw forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> a
mkV) (a -> [AbsolutePath]
unV forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bw) [Char]
d [Char]
n [Char]
h
switchNames :: RawOptSpec f v -> [String]
switchNames :: forall f v. RawOptSpec f v -> [[Char]]
switchNames (RawNoArg [Char]
_ [[Char]]
l f
_ v
_ [Char]
_) = [[Char]]
l
switchNames (RawStrArg [Char]
_ [[Char]]
l [Char] -> f
_ f -> [[Char]]
_ [Char] -> v
_ v -> [[Char]]
_ [Char]
_ [Char]
_) = [[Char]]
l
switchNames (RawAbsPathArg [Char]
_ [[Char]]
l AbsolutePath -> f
_ f -> [AbsolutePath]
_ AbsolutePath -> v
_ v -> [AbsolutePath]
_ [Char]
_ [Char]
_) = [[Char]]
l
switchNames (RawAbsPathOrStdArg [Char]
_ [[Char]]
l AbsolutePathOrStd -> f
_ f -> [AbsolutePathOrStd]
_ AbsolutePathOrStd -> v
_ v -> [AbsolutePathOrStd]
_ [Char]
_ [Char]
_) = [[Char]]
l
switchNames (RawOptAbsPathArg [Char]
_ [[Char]]
l AbsolutePath -> f
_ f -> [AbsolutePath]
_ AbsolutePath -> v
_ v -> [AbsolutePath]
_ [Char]
_ [Char]
_ [Char]
_) = [[Char]]
l
rawUnparse :: Eq v => [RawOptSpec f v] -> v -> [f]
rawUnparse :: forall v f. Eq v => [RawOptSpec f v] -> v -> [f]
rawUnparse [RawOptSpec f v]
ropts v
val =
[ f
f | RawNoArg [Char]
_ [[Char]]
_ f
f v
v [Char]
_ <- [RawOptSpec f v]
ropts, v
v forall a. Eq a => a -> a -> Bool
== v
val ]
forall a. [a] -> [a] -> [a]
++ [ [Char] -> f
mkF [Char]
s | RawStrArg [Char]
_ [[Char]]
_ [Char] -> f
mkF f -> [[Char]]
_ [Char] -> v
mkV v -> [[Char]]
unV [Char]
_ [Char]
_ <- [RawOptSpec f v]
ropts, [Char]
s <- v -> [[Char]]
unV v
val, [Char] -> v
mkV [Char]
s forall a. Eq a => a -> a -> Bool
== v
val ]
forall a. [a] -> [a] -> [a]
++ [ AbsolutePath -> f
mkF AbsolutePath
p | RawAbsPathArg [Char]
_ [[Char]]
_ AbsolutePath -> f
mkF f -> [AbsolutePath]
_ AbsolutePath -> v
mkV v -> [AbsolutePath]
unV [Char]
_ [Char]
_ <- [RawOptSpec f v]
ropts, AbsolutePath
p <- v -> [AbsolutePath]
unV v
val, AbsolutePath -> v
mkV AbsolutePath
p forall a. Eq a => a -> a -> Bool
== v
val ]
forall a. [a] -> [a] -> [a]
++ [ AbsolutePathOrStd -> f
mkF AbsolutePathOrStd
p | RawAbsPathOrStdArg [Char]
_ [[Char]]
_ AbsolutePathOrStd -> f
mkF f -> [AbsolutePathOrStd]
_ AbsolutePathOrStd -> v
mkV v -> [AbsolutePathOrStd]
unV [Char]
_ [Char]
_ <- [RawOptSpec f v]
ropts, AbsolutePathOrStd
p <- v -> [AbsolutePathOrStd]
unV v
val, AbsolutePathOrStd -> v
mkV AbsolutePathOrStd
p forall a. Eq a => a -> a -> Bool
== v
val ]
forall a. [a] -> [a] -> [a]
++ [ AbsolutePath -> f
mkF AbsolutePath
p | RawOptAbsPathArg [Char]
_ [[Char]]
_ AbsolutePath -> f
mkF f -> [AbsolutePath]
_ AbsolutePath -> v
mkV v -> [AbsolutePath]
unV [Char]
_ [Char]
_ [Char]
_ <- [RawOptSpec f v]
ropts, AbsolutePath
p <- v -> [AbsolutePath]
unV v
val, AbsolutePath -> v
mkV AbsolutePath
p forall a. Eq a => a -> a -> Bool
== v
val ]
rawParse :: Eq f => [RawOptSpec f v] -> [f] -> [(v,RawOptSpec f v)]
rawParse :: forall f v.
Eq f =>
[RawOptSpec f v] -> [f] -> [(v, RawOptSpec f v)]
rawParse [RawOptSpec f v]
ropts = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap f -> [(v, RawOptSpec f v)]
rawParseFlag where
rawParseFlag :: f -> [(v, RawOptSpec f v)]
rawParseFlag f
f = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a} {a}.
Eq a =>
a -> RawOptSpec a a -> [(a, RawOptSpec a a)]
go f
f) [RawOptSpec f v]
ropts
go :: a -> RawOptSpec a a -> [(a, RawOptSpec a a)]
go a
f o :: RawOptSpec a a
o@(RawNoArg [Char]
_ [[Char]]
_ a
f' a
v [Char]
_) = [ (a
v, RawOptSpec a a
o) | a
f forall a. Eq a => a -> a -> Bool
== a
f' ]
go a
f o :: RawOptSpec a a
o@(RawStrArg [Char]
_ [[Char]]
_ [Char] -> a
_ a -> [[Char]]
unF [Char] -> a
mkV a -> [[Char]]
_ [Char]
_ [Char]
_) = [ ([Char] -> a
mkV [Char]
s, RawOptSpec a a
o) | [Char]
s <- a -> [[Char]]
unF a
f ]
go a
f o :: RawOptSpec a a
o@(RawAbsPathArg [Char]
_ [[Char]]
_ AbsolutePath -> a
_ a -> [AbsolutePath]
unF AbsolutePath -> a
mkV a -> [AbsolutePath]
_ [Char]
_ [Char]
_) = [ (AbsolutePath -> a
mkV AbsolutePath
p, RawOptSpec a a
o) | AbsolutePath
p <- a -> [AbsolutePath]
unF a
f ]
go a
f o :: RawOptSpec a a
o@(RawAbsPathOrStdArg [Char]
_ [[Char]]
_ AbsolutePathOrStd -> a
_ a -> [AbsolutePathOrStd]
unF AbsolutePathOrStd -> a
mkV a -> [AbsolutePathOrStd]
_ [Char]
_ [Char]
_) = [ (AbsolutePathOrStd -> a
mkV AbsolutePathOrStd
p, RawOptSpec a a
o) | AbsolutePathOrStd
p <- a -> [AbsolutePathOrStd]
unF a
f ]
go a
f o :: RawOptSpec a a
o@(RawOptAbsPathArg [Char]
_ [[Char]]
_ AbsolutePath -> a
_ a -> [AbsolutePath]
unF AbsolutePath -> a
mkV a -> [AbsolutePath]
_ [Char]
_ [Char]
_ [Char]
_) = [ (AbsolutePath -> a
mkV AbsolutePath
p, RawOptSpec a a
o) | AbsolutePath
p <- a -> [AbsolutePath]
unF a
f ]
defHead :: a -> [a] -> a
defHead :: forall a. a -> [a] -> a
defHead a
def [] = a
def
defHead a
_ (a
x:[a]
_) = a
x
addDefaultHelp :: Eq v => v -> RawOptSpec f v -> DarcsOptDescr f
addDefaultHelp :: forall v f. Eq v => v -> RawOptSpec f v -> DarcsOptDescr f
addDefaultHelp v
dval (RawNoArg [Char]
s [[Char]]
l f
f v
v [Char]
h)
| v
dval forall a. Eq a => a -> a -> Bool
== v
v = forall f. [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
noArg [Char]
s [[Char]]
l f
f ([Char]
hforall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
| Bool
otherwise = forall f. [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
noArg [Char]
s [[Char]]
l f
f [Char]
h
addDefaultHelp v
dval (RawStrArg [Char]
s [[Char]]
l [Char] -> f
mkF f -> [[Char]]
_ [Char] -> v
mkV v -> [[Char]]
unV [Char]
a [Char]
h)
| [v
dval] forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map [Char] -> v
mkV (v -> [[Char]]
unV v
dval) = forall f. SingleArgOptDescr [Char] f
strArg [Char]
s [[Char]]
l [Char] -> f
mkF [Char]
a ([Char]
hforall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
| Bool
otherwise = forall f. SingleArgOptDescr [Char] f
strArg [Char]
s [[Char]]
l [Char] -> f
mkF [Char]
a [Char]
h
addDefaultHelp v
dval (RawAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF f -> [AbsolutePath]
_ AbsolutePath -> v
mkV v -> [AbsolutePath]
unV [Char]
a [Char]
h)
| [v
dval] forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map AbsolutePath -> v
mkV (v -> [AbsolutePath]
unV v
dval) = forall f. SingleArgOptDescr AbsolutePath f
absPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF [Char]
a ([Char]
hforall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
| Bool
otherwise = forall f. SingleArgOptDescr AbsolutePath f
absPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF [Char]
a [Char]
h
addDefaultHelp v
dval (RawAbsPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
mkF f -> [AbsolutePathOrStd]
_ AbsolutePathOrStd -> v
mkV v -> [AbsolutePathOrStd]
unV [Char]
a [Char]
h)
| [v
dval] forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map AbsolutePathOrStd -> v
mkV (v -> [AbsolutePathOrStd]
unV v
dval) = forall f. SingleArgOptDescr AbsolutePathOrStd f
absPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
mkF [Char]
a ([Char]
hforall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
| Bool
otherwise = forall f. SingleArgOptDescr AbsolutePathOrStd f
absPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
mkF [Char]
a [Char]
h
addDefaultHelp v
dval (RawOptAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF f -> [AbsolutePath]
_ AbsolutePath -> v
mkV v -> [AbsolutePath]
unV [Char]
d [Char]
a [Char]
h)
| [v
dval] forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map AbsolutePath -> v
mkV (v -> [AbsolutePath]
unV v
dval) = forall f.
[Char]
-> [[Char]]
-> [Char]
-> (AbsolutePath -> f)
-> [Char]
-> [Char]
-> DarcsOptDescr f
optAbsPathArg [Char]
s [[Char]]
l [Char]
d AbsolutePath -> f
mkF [Char]
a ([Char]
hforall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
| Bool
otherwise = forall f.
[Char]
-> [[Char]]
-> [Char]
-> (AbsolutePath -> f)
-> [Char]
-> [Char]
-> DarcsOptDescr f
optAbsPathArg [Char]
s [[Char]]
l [Char]
d AbsolutePath -> f
mkF [Char]
a [Char]
h
withDefault :: Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault :: forall v. Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault v
dval [RawOptSpec Flag v]
ropts = OptSpec {[DarcsOptDescr Flag]
[Flag] -> [[Char]]
forall {c}. (v -> c) -> [Flag] -> c
forall {c}. ([Flag] -> c) -> v -> c
odesc :: [DarcsOptDescr Flag]
ocheck :: [Flag] -> [[Char]]
oparse :: (v -> a) -> [Flag] -> a
ounparse :: ([Flag] -> a) -> v -> a
odesc :: [DarcsOptDescr Flag]
ocheck :: [Flag] -> [[Char]]
oparse :: forall {c}. (v -> c) -> [Flag] -> c
ounparse :: forall {c}. ([Flag] -> c) -> v -> c
..} where
ounparse :: ([Flag] -> c) -> v -> c
ounparse [Flag] -> c
k = [Flag] -> c
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v f. Eq v => [RawOptSpec f v] -> v -> [f]
rawUnparse [RawOptSpec Flag v]
ropts
oparse :: (v -> c) -> [Flag] -> c
oparse v -> c
k = v -> c
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> a
defHead v
dval forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f v.
Eq f =>
[RawOptSpec f v] -> [f] -> [(v, RawOptSpec f v)]
rawParse [RawOptSpec Flag v]
ropts
ocheck :: [Flag] -> [[Char]]
ocheck [Flag]
fs = case forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall f v.
Eq f =>
[RawOptSpec f v] -> [f] -> [(v, RawOptSpec f v)]
rawParse [RawOptSpec Flag v]
ropts [Flag]
fs) of
[] -> []
[RawOptSpec Flag v
_] -> []
[RawOptSpec Flag v]
ropts' -> [[Char]
"conflicting options: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f v. RawOptSpec f v -> [[Char]]
switchNames) [RawOptSpec Flag v]
ropts')]
odesc :: [DarcsOptDescr Flag]
odesc = forall a b. (a -> b) -> [a] -> [b]
map (forall v f. Eq v => v -> RawOptSpec f v -> DarcsOptDescr f
addDefaultHelp v
dval) [RawOptSpec Flag v]
ropts
singleNoArg :: [Char] -> [String] -> Flag -> String -> PrimDarcsOption Bool
singleNoArg :: [Char] -> [[Char]] -> Flag -> [Char] -> PrimDarcsOption Bool
singleNoArg [Char]
s [[Char]]
l Flag
f [Char]
h = forall v. Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault Bool
False [forall f v.
[Char] -> [[Char]] -> f -> v -> [Char] -> RawOptSpec f v
RawNoArg [Char]
s [[Char]]
l Flag
f Bool
True [Char]
h]
singleStrArg :: [Char] -> [String] -> (String -> Flag) -> (Flag -> Maybe String)
-> String -> String -> PrimDarcsOption (Maybe String)
singleStrArg :: [Char]
-> [[Char]]
-> ([Char] -> Flag)
-> (Flag -> Maybe [Char])
-> [Char]
-> [Char]
-> PrimDarcsOption (Maybe [Char])
singleStrArg [Char]
s [[Char]]
l [Char] -> Flag
mkf Flag -> Maybe [Char]
isf [Char]
n [Char]
h =
forall v. Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault forall a. Maybe a
Nothing [ forall f v.
[Char]
-> [[Char]]
-> ([Char] -> f)
-> (f -> [[Char]])
-> ([Char] -> v)
-> (v -> [[Char]])
-> [Char]
-> [Char]
-> RawOptSpec f v
RawStrArg [Char]
s [[Char]]
l [Char] -> Flag
mkf (forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> Maybe [Char]
isf) forall a. a -> Maybe a
Just forall a. Maybe a -> [a]
maybeToList [Char]
n [Char]
h ]
singleAbsPathArg :: [Char] -> [String]
-> (AbsolutePath -> Flag) -> (Flag -> Maybe AbsolutePath)
-> String -> String -> PrimDarcsOption (Maybe AbsolutePath)
singleAbsPathArg :: [Char]
-> [[Char]]
-> (AbsolutePath -> Flag)
-> (Flag -> Maybe AbsolutePath)
-> [Char]
-> [Char]
-> PrimDarcsOption (Maybe AbsolutePath)
singleAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> Flag
mkf Flag -> Maybe AbsolutePath
isf [Char]
n [Char]
h =
forall v. Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault forall a. Maybe a
Nothing [ forall f v.
[Char]
-> [[Char]]
-> (AbsolutePath -> f)
-> (f -> [AbsolutePath])
-> (AbsolutePath -> v)
-> (v -> [AbsolutePath])
-> [Char]
-> [Char]
-> RawOptSpec f v
RawAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> Flag
mkf (forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> Maybe AbsolutePath
isf) forall a. a -> Maybe a
Just forall a. Maybe a -> [a]
maybeToList [Char]
n [Char]
h ]
multiStrArg :: [Char] -> [String] -> (String -> Flag) -> ([Flag] -> [String])
-> String -> String -> PrimDarcsOption [String]
multiStrArg :: [Char]
-> [[Char]]
-> ([Char] -> Flag)
-> ([Flag] -> [[Char]])
-> [Char]
-> [Char]
-> PrimDarcsOption [[Char]]
multiStrArg = forall a.
SingleArgOptDescr a Flag
-> [Char]
-> [[Char]]
-> (a -> Flag)
-> ([Flag] -> [a])
-> [Char]
-> [Char]
-> PrimDarcsOption [a]
multiArg forall f. SingleArgOptDescr [Char] f
strArg
multiOptStrArg :: [Char] -> [String] -> (Maybe String -> Flag)
-> ([Flag] -> [Maybe String]) -> String -> String
-> PrimDarcsOption [Maybe String]
multiOptStrArg :: [Char]
-> [[Char]]
-> (Maybe [Char] -> Flag)
-> ([Flag] -> [Maybe [Char]])
-> [Char]
-> [Char]
-> PrimDarcsOption [Maybe [Char]]
multiOptStrArg = forall a.
SingleArgOptDescr a Flag
-> [Char]
-> [[Char]]
-> (a -> Flag)
-> ([Flag] -> [a])
-> [Char]
-> [Char]
-> PrimDarcsOption [a]
multiArg forall f. SingleArgOptDescr (Maybe [Char]) f
optStrArg
multiAbsPathArg :: [Char] -> [String] -> (AbsolutePath -> Flag) -> ([Flag] -> [AbsolutePath])
-> String -> String -> PrimDarcsOption [AbsolutePath]
multiAbsPathArg :: [Char]
-> [[Char]]
-> (AbsolutePath -> Flag)
-> ([Flag] -> [AbsolutePath])
-> [Char]
-> [Char]
-> PrimDarcsOption [AbsolutePath]
multiAbsPathArg = forall a.
SingleArgOptDescr a Flag
-> [Char]
-> [[Char]]
-> (a -> Flag)
-> ([Flag] -> [a])
-> [Char]
-> [Char]
-> PrimDarcsOption [a]
multiArg forall f. SingleArgOptDescr AbsolutePath f
absPathArg
multiArg :: SingleArgOptDescr a Flag
-> [Char] -> [String] -> (a -> Flag) -> ([Flag] -> [a])
-> String -> String -> PrimDarcsOption [a]
multiArg :: forall a.
SingleArgOptDescr a Flag
-> [Char]
-> [[Char]]
-> (a -> Flag)
-> ([Flag] -> [a])
-> [Char]
-> [Char]
-> PrimDarcsOption [a]
multiArg SingleArgOptDescr a Flag
singleArg [Char]
s [[Char]]
l a -> Flag
mkf [Flag] -> [a]
isf [Char]
n [Char]
h = OptSpec {[DarcsOptDescr Flag]
forall {c}. ([a] -> c) -> [Flag] -> c
forall {t}. ([Flag] -> t) -> [a] -> t
forall {p} {a}. p -> [a]
odesc :: [DarcsOptDescr Flag]
ocheck :: forall {p} {a}. p -> [a]
oparse :: forall {c}. ([a] -> c) -> [Flag] -> c
ounparse :: forall {t}. ([Flag] -> t) -> [a] -> t
odesc :: [DarcsOptDescr Flag]
ocheck :: [Flag] -> [[Char]]
oparse :: ([a] -> a) -> [Flag] -> a
ounparse :: ([Flag] -> a) -> [a] -> a
..} where
ounparse :: ([Flag] -> t) -> [a] -> t
ounparse [Flag] -> t
k [a]
xs = [Flag] -> t
k [ a -> Flag
mkf a
x | a
x <- [a]
xs ]
oparse :: ([a] -> c) -> [Flag] -> c
oparse [a] -> c
k = [a] -> c
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Flag] -> [a]
isf
ocheck :: p -> [a]
ocheck p
_ = []
odesc :: [DarcsOptDescr Flag]
odesc = [SingleArgOptDescr a Flag
singleArg [Char]
s [[Char]]
l a -> Flag
mkf [Char]
n [Char]
h]
deprecated :: [String] -> [RawOptSpec Flag v] -> PrimDarcsOption ()
deprecated :: forall v. [[Char]] -> [RawOptSpec Flag v] -> PrimDarcsOption ()
deprecated [[Char]]
comments [RawOptSpec Flag v]
ropts = OptSpec {[DarcsOptDescr Flag]
[Flag] -> [[Char]]
forall {t} {p}. (() -> t) -> p -> t
forall {a} {t} {p}. ([a] -> t) -> p -> t
odesc :: [DarcsOptDescr Flag]
ocheck :: [Flag] -> [[Char]]
oparse :: forall {t} {p}. (() -> t) -> p -> t
ounparse :: forall {a} {t} {p}. ([a] -> t) -> p -> t
odesc :: [DarcsOptDescr Flag]
ocheck :: [Flag] -> [[Char]]
oparse :: (() -> a) -> [Flag] -> a
ounparse :: ([Flag] -> a) -> () -> a
..} where
ounparse :: ([a] -> t) -> p -> t
ounparse [a] -> t
k p
_ = [a] -> t
k []
oparse :: (() -> t) -> p -> t
oparse () -> t
k p
_ = () -> t
k ()
ocheck :: [Flag] -> [[Char]]
ocheck [Flag]
fs = case forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall f v.
Eq f =>
[RawOptSpec f v] -> [f] -> [(v, RawOptSpec f v)]
rawParse [RawOptSpec Flag v]
ropts [Flag]
fs) of
[] -> []
[RawOptSpec Flag v]
ropts' -> ([Char]
"deprecated option(s): " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall f v. RawOptSpec f v -> [[Char]]
switchNames [RawOptSpec Flag v]
ropts')) forall a. a -> [a] -> [a]
: [[Char]]
comments
odesc :: [DarcsOptDescr Flag]
odesc = forall a b. (a -> b) -> [a] -> [b]
map forall {f} {v}. RawOptSpec f v -> DarcsOptDescr f
noDefaultHelp [RawOptSpec Flag v]
ropts
noDefaultHelp :: RawOptSpec f v -> DarcsOptDescr f
noDefaultHelp (RawNoArg [Char]
s [[Char]]
l f
f v
_ [Char]
h) = forall f. [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
noArg [Char]
s [[Char]]
l f
f [Char]
h
noDefaultHelp (RawStrArg [Char]
s [[Char]]
l [Char] -> f
mkF f -> [[Char]]
_ [Char] -> v
_ v -> [[Char]]
_ [Char]
a [Char]
h) = forall f. SingleArgOptDescr [Char] f
strArg [Char]
s [[Char]]
l [Char] -> f
mkF [Char]
a [Char]
h
noDefaultHelp (RawAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF f -> [AbsolutePath]
_ AbsolutePath -> v
_ v -> [AbsolutePath]
_ [Char]
a [Char]
h) = forall f. SingleArgOptDescr AbsolutePath f
absPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF [Char]
a [Char]
h
noDefaultHelp (RawAbsPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
mkF f -> [AbsolutePathOrStd]
_ AbsolutePathOrStd -> v
_ v -> [AbsolutePathOrStd]
_ [Char]
a [Char]
h) = forall f. SingleArgOptDescr AbsolutePathOrStd f
absPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
mkF [Char]
a [Char]
h
noDefaultHelp (RawOptAbsPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF f -> [AbsolutePath]
_ AbsolutePath -> v
_ v -> [AbsolutePath]
_ [Char]
d [Char]
a [Char]
h) = forall f.
[Char]
-> [[Char]]
-> [Char]
-> (AbsolutePath -> f)
-> [Char]
-> [Char]
-> DarcsOptDescr f
optAbsPathArg [Char]
s [[Char]]
l [Char]
d AbsolutePath -> f
mkF [Char]
a [Char]
h
data ArgumentParseError = ArgumentParseError String String
deriving (ArgumentParseError -> ArgumentParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgumentParseError -> ArgumentParseError -> Bool
$c/= :: ArgumentParseError -> ArgumentParseError -> Bool
== :: ArgumentParseError -> ArgumentParseError -> Bool
$c== :: ArgumentParseError -> ArgumentParseError -> Bool
Eq, Typeable)
instance Exception ArgumentParseError
instance Show ArgumentParseError where
show :: ArgumentParseError -> [Char]
show (ArgumentParseError [Char]
arg [Char]
expected) =
[[Char]] -> [Char]
unwords [[Char]
"cannot parse flag argument",forall a. Show a => a -> [Char]
show [Char]
arg,[Char]
"as",[Char]
expected]
parseIntArg :: String -> (Int -> Bool) -> String -> Int
parseIntArg :: [Char] -> (Int -> Bool) -> [Char] -> Int
parseIntArg [Char]
expected Int -> Bool
cond [Char]
s =
case forall a. Read a => ReadS a
reads [Char]
s of
(Int
n,[Char]
""):[(Int, [Char])]
_ | Int -> Bool
cond Int
n -> Int
n
[(Int, [Char])]
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> ArgumentParseError
ArgumentParseError [Char]
s [Char]
expected)
parseIndexRangeArg :: String -> (Int,Int)
parseIndexRangeArg :: [Char] -> (Int, Int)
parseIndexRangeArg [Char]
s =
case forall a. Read a => ReadS a
reads [Char]
s of
(Int
n,[Char]
""):[(Int, [Char])]
_ | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 -> (Int
n,Int
n)
(Int
n,Char
'-':[Char]
s'):[(Int, [Char])]
_ | Int
n forall a. Ord a => a -> a -> Bool
> Int
0, (Int
m,[Char]
""):[(Int, [Char])]
_ <- forall a. Read a => ReadS a
reads [Char]
s', Int
m forall a. Ord a => a -> a -> Bool
> Int
0 -> (Int
n,Int
m)
[(Int, [Char])]
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> ArgumentParseError
ArgumentParseError [Char]
s [Char]
"index range")
showIntArg :: Int -> String
showIntArg :: Int -> [Char]
showIntArg = forall a. Show a => a -> [Char]
show
showIndexRangeArg :: (Int,Int) -> String
showIndexRangeArg :: (Int, Int) -> [Char]
showIndexRangeArg (Int
n,Int
m) = forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
m