-- | Constructing 'OptSpec's and 'OptDescr's
module Darcs.UI.Options.Util
    ( Flag
    -- * Instantiating 'OptSpec' and 'PrimOptSpec'
    , DarcsOptDescr
    , PrimDarcsOption
    -- * Constructing 'DarcsOptDescr's
    , noArg
    , strArg
    , optStrArg
    , absPathArg
    , absPathOrStdArg
    , optAbsPathArg
      -- * Raw option specs
    , RawOptSpec(..)
    , withDefault
    -- * Simple primitive scalar valued options
    , singleNoArg
    , singleStrArg
    -- * Simple primitive list valued options
    , multiStrArg
    , multiOptStrArg
    , singleAbsPathArg
    , multiAbsPathArg
    , deprecated
    -- * Parsing/showing option arguments
    , parseIntArg
    , parseIndexRangeArg
    , showIntArg
    , showIndexRangeArg
    -- * Re-exports
    , 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
    )

-- * Instantiating 'OptSpec' and 'PrimOptSpec'

-- | This type synonym is here for brevity and because we want to import
-- the data constructors (but not the type) of 'DarcsFlag' qualified.
type Flag = DarcsFlag

{- | We do not instantiate the @d@ in @'OptSpec' d f@ directly with
'System.Console.GetOpt.OptDescr'. Instead we (post-) compose it with @(->)
'DarcsUtil.Path.AbsolutePath'@. Modulo newtype noise, this is the same as

@ type 'DarcsOptDescr' f = 'System.Console.GetOpt.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 DarcsOptDescr = Compose OptDescr ((->) AbsolutePath)

-- | This is 'PrimOptSpec' instantiated with 'DarcsOptDescr' and 'Flag'.
type PrimDarcsOption v = forall a. PrimOptSpec DarcsOptDescr Flag a v

-- * Constructing 'DarcsOptDescr's

-- | Construct a 'DarcsOptDescr' with no arguments.
noArg :: [Char] -> [String] -> f -> String -> DarcsOptDescr f
noArg :: [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
noArg [Char]
s [[Char]]
l f
f [Char]
h = OptDescr (AbsolutePath -> f) -> DarcsOptDescr f
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (OptDescr (AbsolutePath -> f) -> DarcsOptDescr f)
-> OptDescr (AbsolutePath -> f) -> DarcsOptDescr f
forall a b. (a -> b) -> a -> b
$ [Char]
-> [[Char]]
-> ArgDescr (AbsolutePath -> f)
-> [Char]
-> OptDescr (AbsolutePath -> f)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l ((AbsolutePath -> f) -> ArgDescr (AbsolutePath -> f)
forall a. a -> ArgDescr a
NoArg (f -> AbsolutePath -> f
forall a b. a -> b -> a
const f
f)) [Char]
h

-- | A 'DarcsOptDescr' that requires a single argument of type 'a' and handles
-- flags of type 'f'.
type SingleArgOptDescr a f =
        [Char] -> [String] -> (a -> f) -> String -> String -> DarcsOptDescr f

-- | Construct a 'DarcsOptDescr' with a 'String' argument.
strArg :: SingleArgOptDescr String f
strArg :: SingleArgOptDescr [Char] f
strArg [Char]
s [[Char]]
l [Char] -> f
f [Char]
a [Char]
h = OptDescr (AbsolutePath -> f)
-> Compose OptDescr ((->) AbsolutePath) f
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (OptDescr (AbsolutePath -> f)
 -> Compose OptDescr ((->) AbsolutePath) f)
-> OptDescr (AbsolutePath -> f)
-> Compose OptDescr ((->) AbsolutePath) f
forall a b. (a -> b) -> a -> b
$ [Char]
-> [[Char]]
-> ArgDescr (AbsolutePath -> f)
-> [Char]
-> OptDescr (AbsolutePath -> f)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (([Char] -> AbsolutePath -> f)
-> [Char] -> ArgDescr (AbsolutePath -> f)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x AbsolutePath
_ -> [Char] -> f
f [Char]
x) [Char]
a) [Char]
h

-- | Construct a 'DarcsOptDescr' with an optional 'String' argument.
optStrArg :: SingleArgOptDescr (Maybe String) f
optStrArg :: SingleArgOptDescr (Maybe [Char]) f
optStrArg [Char]
s [[Char]]
l Maybe [Char] -> f
f [Char]
a [Char]
h = OptDescr (AbsolutePath -> f)
-> Compose OptDescr ((->) AbsolutePath) f
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (OptDescr (AbsolutePath -> f)
 -> Compose OptDescr ((->) AbsolutePath) f)
-> OptDescr (AbsolutePath -> f)
-> Compose OptDescr ((->) AbsolutePath) f
forall a b. (a -> b) -> a -> b
$ [Char]
-> [[Char]]
-> ArgDescr (AbsolutePath -> f)
-> [Char]
-> OptDescr (AbsolutePath -> f)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l ((Maybe [Char] -> AbsolutePath -> f)
-> [Char] -> ArgDescr (AbsolutePath -> f)
forall a. (Maybe [Char] -> a) -> [Char] -> ArgDescr a
OptArg (\Maybe [Char]
x AbsolutePath
_ -> Maybe [Char] -> f
f Maybe [Char]
x) [Char]
a) [Char]
h

-- | Construct a 'DarcsOptDescr' with an 'AbsolutePath'
-- argument.
absPathArg :: SingleArgOptDescr AbsolutePath f
absPathArg :: SingleArgOptDescr AbsolutePath f
absPathArg [Char]
s [[Char]]
l AbsolutePath -> f
f [Char]
a [Char]
h = OptDescr (AbsolutePath -> f)
-> Compose OptDescr ((->) AbsolutePath) f
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (OptDescr (AbsolutePath -> f)
 -> Compose OptDescr ((->) AbsolutePath) f)
-> OptDescr (AbsolutePath -> f)
-> Compose OptDescr ((->) AbsolutePath) f
forall a b. (a -> b) -> a -> b
$ [Char]
-> [[Char]]
-> ArgDescr (AbsolutePath -> f)
-> [Char]
-> OptDescr (AbsolutePath -> f)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (([Char] -> AbsolutePath -> f)
-> [Char] -> ArgDescr (AbsolutePath -> f)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x AbsolutePath
wd -> AbsolutePath -> f
f (AbsolutePath -> f) -> AbsolutePath -> f
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> [Char] -> AbsolutePath
makeAbsolute AbsolutePath
wd [Char]
x) [Char]
a) [Char]
h

-- | Construct a 'DarcsOptDescr' with an 'AbsolutePathOrStd'
-- argument.
absPathOrStdArg :: SingleArgOptDescr AbsolutePathOrStd f
absPathOrStdArg :: SingleArgOptDescr AbsolutePathOrStd f
absPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
f [Char]
a [Char]
h = OptDescr (AbsolutePath -> f)
-> Compose OptDescr ((->) AbsolutePath) f
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (OptDescr (AbsolutePath -> f)
 -> Compose OptDescr ((->) AbsolutePath) f)
-> OptDescr (AbsolutePath -> f)
-> Compose OptDescr ((->) AbsolutePath) f
forall a b. (a -> b) -> a -> b
$ [Char]
-> [[Char]]
-> ArgDescr (AbsolutePath -> f)
-> [Char]
-> OptDescr (AbsolutePath -> f)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l (([Char] -> AbsolutePath -> f)
-> [Char] -> ArgDescr (AbsolutePath -> f)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x AbsolutePath
wd -> AbsolutePathOrStd -> f
f (AbsolutePathOrStd -> f) -> AbsolutePathOrStd -> f
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> [Char] -> AbsolutePathOrStd
makeAbsoluteOrStd AbsolutePath
wd [Char]
x) [Char]
a) [Char]
h

-- | Construct a 'DarcsOptDescr' with an optional 'AbsolutePath'
-- argument.
optAbsPathArg :: [Char] -> [String] -> String -> (AbsolutePath -> f)
              -> String -> String -> DarcsOptDescr f
optAbsPathArg :: [Char]
-> [[Char]]
-> [Char]
-> (AbsolutePath -> f)
-> [Char]
-> [Char]
-> DarcsOptDescr f
optAbsPathArg [Char]
s [[Char]]
l [Char]
d AbsolutePath -> f
f [Char]
a [Char]
h = OptDescr (AbsolutePath -> f) -> DarcsOptDescr f
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (OptDescr (AbsolutePath -> f) -> DarcsOptDescr f)
-> OptDescr (AbsolutePath -> f) -> DarcsOptDescr f
forall a b. (a -> b) -> a -> b
$ [Char]
-> [[Char]]
-> ArgDescr (AbsolutePath -> f)
-> [Char]
-> OptDescr (AbsolutePath -> f)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
s [[Char]]
l ((Maybe [Char] -> AbsolutePath -> f)
-> [Char] -> ArgDescr (AbsolutePath -> f)
forall a. (Maybe [Char] -> a) -> [Char] -> ArgDescr a
OptArg (\Maybe [Char]
x AbsolutePath
wd -> AbsolutePath -> f
f (AbsolutePath -> f) -> AbsolutePath -> f
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> [Char] -> AbsolutePath
makeAbsolute AbsolutePath
wd ([Char] -> AbsolutePath) -> [Char] -> AbsolutePath
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
d Maybe [Char]
x) [Char]
a) [Char]
h

-- * Raw option specs

-- | The raw material from which multi-valued options are built. See 'withDefault'.
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 :: 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) = [Char] -> [[Char]] -> f -> b -> [Char] -> RawOptSpec f b
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) = [Char]
-> [[Char]]
-> ([Char] -> f)
-> (f -> [[Char]])
-> ([Char] -> b)
-> (b -> [[Char]])
-> [Char]
-> [Char]
-> RawOptSpec f b
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 (a -> b) -> ([Char] -> a) -> [Char] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> a
mkV) (a -> [[Char]]
unV (a -> [[Char]]) -> (b -> a) -> b -> [[Char]]
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) = [Char]
-> [[Char]]
-> (AbsolutePath -> f)
-> (f -> [AbsolutePath])
-> (AbsolutePath -> b)
-> (b -> [AbsolutePath])
-> [Char]
-> [Char]
-> RawOptSpec f b
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 (a -> b) -> (AbsolutePath -> a) -> AbsolutePath -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> a
mkV) (a -> [AbsolutePath]
unV (a -> [AbsolutePath]) -> (b -> a) -> b -> [AbsolutePath]
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) = [Char]
-> [[Char]]
-> (AbsolutePathOrStd -> f)
-> (f -> [AbsolutePathOrStd])
-> (AbsolutePathOrStd -> b)
-> (b -> [AbsolutePathOrStd])
-> [Char]
-> [Char]
-> RawOptSpec f b
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 (a -> b) -> (AbsolutePathOrStd -> a) -> AbsolutePathOrStd -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePathOrStd -> a
mkV) (a -> [AbsolutePathOrStd]
unV (a -> [AbsolutePathOrStd]) -> (b -> a) -> b -> [AbsolutePathOrStd]
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) = [Char]
-> [[Char]]
-> (AbsolutePath -> f)
-> (f -> [AbsolutePath])
-> (AbsolutePath -> b)
-> (b -> [AbsolutePath])
-> [Char]
-> [Char]
-> [Char]
-> RawOptSpec f b
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 (a -> b) -> (AbsolutePath -> a) -> AbsolutePath -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> a
mkV) (a -> [AbsolutePath]
unV (a -> [AbsolutePath]) -> (b -> a) -> b -> [AbsolutePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bw) [Char]
d [Char]
n [Char]
h

-- | Get the long switch names from a raw option. Used to construct error messages.
switchNames :: RawOptSpec f v -> [String]
switchNames :: 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

-- | Given a list of 'RawOptSpec', find all flags that match a given value.
rawUnparse :: Eq v => [RawOptSpec f v] -> v -> [f]
rawUnparse :: [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 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
val ]
  [f] -> [f] -> [f]
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 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
val ]
  [f] -> [f] -> [f]
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 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
val ]
  [f] -> [f] -> [f]
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 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
val ]
  [f] -> [f] -> [f]
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 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
val ]

-- | Given a list of 'RawOptSpec', find all values that match a given flag list
-- in the order in which they appear in the flag list.
rawParse :: Eq f => [RawOptSpec f v] -> [f] -> [(v,RawOptSpec f v)]
rawParse :: [RawOptSpec f v] -> [f] -> [(v, RawOptSpec f v)]
rawParse [RawOptSpec f v]
ropts = (f -> [(v, RawOptSpec f v)]) -> [f] -> [(v, RawOptSpec f v)]
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 = (RawOptSpec f v -> [(v, RawOptSpec f v)])
-> [RawOptSpec f v] -> [(v, RawOptSpec f v)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (f -> RawOptSpec f v -> [(v, RawOptSpec f v)]
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 a -> a -> Bool
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 ]

--      [ (v, o)     | f <- fs, o@(RawNoArg _ _ f' v _) <- ropts, f == f' ]
--   ++ [ (mkV s, o) | f <- fs, o@(RawStrArg _ _ _ unF mkV _ _ _) <- ropts, s <- unF f ]
--   ++ [ (mkV p, o) | f <- fs, o@(RawAbsPathArg _ _ _ unF mkV _ _ _) <- ropts, p <- unF f ]
--   ++ [ (mkV p, o) | f <- fs, o@(RawAbsPathOrStdArg _ _ _ unF mkV _ _ _) <- ropts, p <- unF f ]
--   ++ [ (mkV p, o) | f <- fs, o@(RawOptAbsPathArg _ _ _ unF mkV _ _ _ _) <- ropts, p <- unF f ]

-- | The first element of a list, or a default if the list is empty.
defHead :: a -> [a] -> a
defHead :: a -> [a] -> a
defHead a
def []    = a
def
defHead a
_   (a
x:[a]
_) = a
x

-- | Append \" [DEFAULT\" to the help text of options that match the default value.
addDefaultHelp :: Eq v => v -> RawOptSpec f v -> DarcsOptDescr f
addDefaultHelp :: v -> RawOptSpec f v -> DarcsOptDescr f
addDefaultHelp v
dval (RawNoArg [Char]
s [[Char]]
l f
f v
v [Char]
h)
  | v
dval v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v = [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
forall f. [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
noArg [Char]
s [[Char]]
l f
f ([Char]
h[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
  | Bool
otherwise = [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
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] [v] -> [v] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Char] -> v) -> [[Char]] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> v
mkV (v -> [[Char]]
unV v
dval) = SingleArgOptDescr [Char] f
forall f. SingleArgOptDescr [Char] f
strArg [Char]
s [[Char]]
l [Char] -> f
mkF [Char]
a ([Char]
h[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
  | Bool
otherwise = SingleArgOptDescr [Char] f
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] [v] -> [v] -> Bool
forall a. Eq a => a -> a -> Bool
== (AbsolutePath -> v) -> [AbsolutePath] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map AbsolutePath -> v
mkV (v -> [AbsolutePath]
unV v
dval) = SingleArgOptDescr AbsolutePath f
forall f. SingleArgOptDescr AbsolutePath f
absPathArg [Char]
s [[Char]]
l AbsolutePath -> f
mkF [Char]
a ([Char]
h[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
  | Bool
otherwise = SingleArgOptDescr AbsolutePath f
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] [v] -> [v] -> Bool
forall a. Eq a => a -> a -> Bool
== (AbsolutePathOrStd -> v) -> [AbsolutePathOrStd] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map AbsolutePathOrStd -> v
mkV (v -> [AbsolutePathOrStd]
unV v
dval) = SingleArgOptDescr AbsolutePathOrStd f
forall f. SingleArgOptDescr AbsolutePathOrStd f
absPathOrStdArg [Char]
s [[Char]]
l AbsolutePathOrStd -> f
mkF [Char]
a ([Char]
h[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
  | Bool
otherwise = SingleArgOptDescr AbsolutePathOrStd f
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] [v] -> [v] -> Bool
forall a. Eq a => a -> a -> Bool
== (AbsolutePath -> v) -> [AbsolutePath] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map AbsolutePath -> v
mkV (v -> [AbsolutePath]
unV v
dval) = [Char]
-> [[Char]]
-> [Char]
-> (AbsolutePath -> f)
-> [Char]
-> [Char]
-> DarcsOptDescr f
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[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" [DEFAULT]")
  | Bool
otherwise = [Char]
-> [[Char]]
-> [Char]
-> (AbsolutePath -> f)
-> [Char]
-> [Char]
-> DarcsOptDescr f
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

-- | 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@).
withDefault :: Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault :: v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault v
dval [RawOptSpec Flag v]
ropts = OptSpec :: forall (d :: * -> *) f a b.
(([f] -> a) -> b)
-> (b -> [f] -> a) -> ([f] -> [[Char]]) -> [d f] -> OptSpec d f a b
OptSpec {[DarcsOptDescr Flag]
[Flag] -> [[Char]]
(v -> a) -> [Flag] -> a
([Flag] -> a) -> v -> a
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 ([Flag] -> c) -> (v -> [Flag]) -> v -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RawOptSpec Flag v] -> v -> [Flag]
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 (v -> c) -> ([Flag] -> v) -> [Flag] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> [v] -> v
forall a. a -> [a] -> a
defHead v
dval ([v] -> v) -> ([Flag] -> [v]) -> [Flag] -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v, RawOptSpec Flag v) -> v) -> [(v, RawOptSpec Flag v)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (v, RawOptSpec Flag v) -> v
forall a b. (a, b) -> a
fst ([(v, RawOptSpec Flag v)] -> [v])
-> ([Flag] -> [(v, RawOptSpec Flag v)]) -> [Flag] -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RawOptSpec Flag v] -> [Flag] -> [(v, RawOptSpec Flag v)]
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 ((v, RawOptSpec Flag v) -> RawOptSpec Flag v)
-> [(v, RawOptSpec Flag v)] -> [RawOptSpec Flag v]
forall a b. (a -> b) -> [a] -> [b]
map (v, RawOptSpec Flag v) -> RawOptSpec Flag v
forall a b. (a, b) -> b
snd ([RawOptSpec Flag v] -> [Flag] -> [(v, RawOptSpec Flag v)]
forall f v.
Eq f =>
[RawOptSpec f v] -> [f] -> [(v, RawOptSpec f v)]
rawParse [RawOptSpec Flag v]
ropts [Flag]
fs) of
    [] -> [] -- error "this should not happen"
    [RawOptSpec Flag v
_] -> []
    [RawOptSpec Flag v]
ropts' -> [[Char]
"conflicting options: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((RawOptSpec Flag v -> [Char]) -> [RawOptSpec Flag v] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" ([[Char]] -> [Char])
-> (RawOptSpec Flag v -> [[Char]]) -> RawOptSpec Flag v -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawOptSpec Flag v -> [[Char]]
forall f v. RawOptSpec f v -> [[Char]]
switchNames) [RawOptSpec Flag v]
ropts')]
  odesc :: [DarcsOptDescr Flag]
odesc = (RawOptSpec Flag v -> DarcsOptDescr Flag)
-> [RawOptSpec Flag v] -> [DarcsOptDescr Flag]
forall a b. (a -> b) -> [a] -> [b]
map (v -> RawOptSpec Flag v -> DarcsOptDescr Flag
forall v f. Eq v => v -> RawOptSpec f v -> DarcsOptDescr f
addDefaultHelp v
dval) [RawOptSpec Flag v]
ropts

-- * Simple primitive scalar valued options

-- | 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.
singleNoArg :: [Char] -> [String] -> Flag -> String -> PrimDarcsOption Bool
singleNoArg :: [Char] -> [[Char]] -> Flag -> [Char] -> PrimDarcsOption Bool
singleNoArg [Char]
s [[Char]]
l Flag
f [Char]
h = Bool -> [RawOptSpec Flag Bool] -> PrimDarcsOption Bool
forall v. Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault Bool
False [[Char]
-> [[Char]] -> Flag -> Bool -> [Char] -> RawOptSpec Flag Bool
forall f v.
[Char] -> [[Char]] -> f -> v -> [Char] -> RawOptSpec f v
RawNoArg [Char]
s [[Char]]
l Flag
f Bool
True [Char]
h]

-- | Construct a @'Maybe' 'String'@ valued option with a single flag that takes a
-- 'String' argument and has no default flag.
--
-- The arguments are: short switches, long switches, flag constructor, single flag
-- parser, help string.
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 =
  Maybe [Char]
-> [RawOptSpec Flag (Maybe [Char])]
-> PrimDarcsOption (Maybe [Char])
forall v. Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault Maybe [Char]
forall a. Maybe a
Nothing [ [Char]
-> [[Char]]
-> ([Char] -> Flag)
-> (Flag -> [[Char]])
-> ([Char] -> Maybe [Char])
-> (Maybe [Char] -> [[Char]])
-> [Char]
-> [Char]
-> RawOptSpec Flag (Maybe [Char])
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 (Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Char] -> [[Char]])
-> (Flag -> Maybe [Char]) -> Flag -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> Maybe [Char]
isf) [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList [Char]
n [Char]
h ]

-- | Construct a @'Maybe' 'AbsolutePath'@ valued option with a single flag that
-- takes an 'AbsolutePath' argument and has no default flag.
--
-- The arguments are: short switches, long switches, flag constructor, single flag
-- parser, help string.
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 =
  Maybe AbsolutePath
-> [RawOptSpec Flag (Maybe AbsolutePath)]
-> PrimDarcsOption (Maybe AbsolutePath)
forall v. Eq v => v -> [RawOptSpec Flag v] -> PrimDarcsOption v
withDefault Maybe AbsolutePath
forall a. Maybe a
Nothing [ [Char]
-> [[Char]]
-> (AbsolutePath -> Flag)
-> (Flag -> [AbsolutePath])
-> (AbsolutePath -> Maybe AbsolutePath)
-> (Maybe AbsolutePath -> [AbsolutePath])
-> [Char]
-> [Char]
-> RawOptSpec Flag (Maybe AbsolutePath)
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 (Maybe AbsolutePath -> [AbsolutePath]
forall a. Maybe a -> [a]
maybeToList (Maybe AbsolutePath -> [AbsolutePath])
-> (Flag -> Maybe AbsolutePath) -> Flag -> [AbsolutePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> Maybe AbsolutePath
isf) AbsolutePath -> Maybe AbsolutePath
forall a. a -> Maybe a
Just Maybe AbsolutePath -> [AbsolutePath]
forall a. Maybe a -> [a]
maybeToList [Char]
n [Char]
h ]

-- * Simple primitive list valued options

-- | Similar to 'singleStrArg', except that the flag can be given more than once.
-- The flag arguments are collected in a list of 'String's.
multiStrArg :: [Char] -> [String] -> (String -> Flag) -> ([Flag] -> [String])
             -> String -> String -> PrimDarcsOption [String]
multiStrArg :: [Char]
-> [[Char]]
-> ([Char] -> Flag)
-> ([Flag] -> [[Char]])
-> [Char]
-> [Char]
-> PrimDarcsOption [[Char]]
multiStrArg = SingleArgOptDescr [Char] Flag
-> [Char]
-> [[Char]]
-> ([Char] -> Flag)
-> ([Flag] -> [[Char]])
-> [Char]
-> [Char]
-> PrimDarcsOption [[Char]]
forall a.
SingleArgOptDescr a Flag
-> [Char]
-> [[Char]]
-> (a -> Flag)
-> ([Flag] -> [a])
-> [Char]
-> [Char]
-> PrimDarcsOption [a]
multiArg SingleArgOptDescr [Char] Flag
forall f. SingleArgOptDescr [Char] f
strArg

-- | Similar to 'multiStrArg', except that the flag arguments are optional.
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 = SingleArgOptDescr (Maybe [Char]) Flag
-> [Char]
-> [[Char]]
-> (Maybe [Char] -> Flag)
-> ([Flag] -> [Maybe [Char]])
-> [Char]
-> [Char]
-> PrimDarcsOption [Maybe [Char]]
forall a.
SingleArgOptDescr a Flag
-> [Char]
-> [[Char]]
-> (a -> Flag)
-> ([Flag] -> [a])
-> [Char]
-> [Char]
-> PrimDarcsOption [a]
multiArg SingleArgOptDescr (Maybe [Char]) Flag
forall f. SingleArgOptDescr (Maybe [Char]) f
optStrArg

-- | Similar to 'singleAbsPathArg', except that the flag can be given more than once.
-- The flag arguments are collected in a list of 'AbsolutePath's.
multiAbsPathArg :: [Char] -> [String] -> (AbsolutePath -> Flag) -> ([Flag] -> [AbsolutePath])
             -> String -> String -> PrimDarcsOption [AbsolutePath]
multiAbsPathArg :: [Char]
-> [[Char]]
-> (AbsolutePath -> Flag)
-> ([Flag] -> [AbsolutePath])
-> [Char]
-> [Char]
-> PrimDarcsOption [AbsolutePath]
multiAbsPathArg = SingleArgOptDescr AbsolutePath Flag
-> [Char]
-> [[Char]]
-> (AbsolutePath -> Flag)
-> ([Flag] -> [AbsolutePath])
-> [Char]
-> [Char]
-> PrimDarcsOption [AbsolutePath]
forall a.
SingleArgOptDescr a Flag
-> [Char]
-> [[Char]]
-> (a -> Flag)
-> ([Flag] -> [a])
-> [Char]
-> [Char]
-> PrimDarcsOption [a]
multiArg SingleArgOptDescr AbsolutePath Flag
forall f. SingleArgOptDescr AbsolutePath f
absPathArg

-- | A multi-arg option, defined in terms of a single-arg option, returning a
-- list of single args.
--
-- The parameters are: single argument description, short switches, long
-- switches, flag constructor, flag list parser, arg name string, help string.
multiArg :: SingleArgOptDescr a Flag
         -> [Char] -> [String] -> (a -> Flag) -> ([Flag] -> [a])
         -> String -> String -> PrimDarcsOption [a]
multiArg :: 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 :: forall (d :: * -> *) f a b.
(([f] -> a) -> b)
-> (b -> [f] -> a) -> ([f] -> [[Char]]) -> [d f] -> OptSpec d f a b
OptSpec {[DarcsOptDescr Flag]
[Flag] -> [[Char]]
([a] -> a) -> [Flag] -> a
([Flag] -> a) -> [a] -> a
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 ([a] -> c) -> ([Flag] -> [a]) -> [Flag] -> c
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]

-- | 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.
deprecated :: [String] -> [RawOptSpec Flag v] -> PrimDarcsOption ()
deprecated :: [[Char]] -> [RawOptSpec Flag v] -> PrimDarcsOption ()
deprecated [[Char]]
comments [RawOptSpec Flag v]
ropts = OptSpec :: forall (d :: * -> *) f a b.
(([f] -> a) -> b)
-> (b -> [f] -> a) -> ([f] -> [[Char]]) -> [d f] -> OptSpec d f a b
OptSpec {[DarcsOptDescr Flag]
[Flag] -> [[Char]]
([Flag] -> a) -> () -> a
(() -> a) -> [Flag] -> a
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 ((v, RawOptSpec Flag v) -> RawOptSpec Flag v)
-> [(v, RawOptSpec Flag v)] -> [RawOptSpec Flag v]
forall a b. (a -> b) -> [a] -> [b]
map (v, RawOptSpec Flag v) -> RawOptSpec Flag v
forall a b. (a, b) -> b
snd ([RawOptSpec Flag v] -> [Flag] -> [(v, RawOptSpec Flag v)]
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): " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ((RawOptSpec Flag v -> [[Char]]) -> [RawOptSpec Flag v] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RawOptSpec Flag v -> [[Char]]
forall f v. RawOptSpec f v -> [[Char]]
switchNames [RawOptSpec Flag v]
ropts')) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
comments
  odesc :: [DarcsOptDescr Flag]
odesc = (RawOptSpec Flag v -> DarcsOptDescr Flag)
-> [RawOptSpec Flag v] -> [DarcsOptDescr Flag]
forall a b. (a -> b) -> [a] -> [b]
map RawOptSpec Flag v -> DarcsOptDescr Flag
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) = [Char] -> [[Char]] -> f -> [Char] -> DarcsOptDescr f
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) = SingleArgOptDescr [Char] f
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) = SingleArgOptDescr AbsolutePath f
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) = SingleArgOptDescr AbsolutePathOrStd f
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) = [Char]
-> [[Char]]
-> [Char]
-> (AbsolutePath -> f)
-> [Char]
-> [Char]
-> DarcsOptDescr f
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

-- * Parsing option arguments

data ArgumentParseError = ArgumentParseError String String
  deriving (ArgumentParseError -> ArgumentParseError -> Bool
(ArgumentParseError -> ArgumentParseError -> Bool)
-> (ArgumentParseError -> ArgumentParseError -> Bool)
-> Eq ArgumentParseError
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",[Char] -> [Char]
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 ReadS Int
forall a. Read a => ReadS a
reads [Char]
s of
    (Int
n,[Char]
""):[(Int, [Char])]
_ | Int -> Bool
cond Int
n -> Int
n
    [(Int, [Char])]
_ -> ArgumentParseError -> Int
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 ReadS Int
forall a. Read a => ReadS a
reads [Char]
s of
    (Int
n,[Char]
""):[(Int, [Char])]
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> (Int
n,Int
n)
    (Int
n,Char
'-':[Char]
s'):[(Int, [Char])]
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0, (Int
m,[Char]
""):[(Int, [Char])]
_ <- ReadS Int
forall a. Read a => ReadS a
reads [Char]
s', Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> (Int
n,Int
m)
    [(Int, [Char])]
_ -> ArgumentParseError -> (Int, Int)
forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> ArgumentParseError
ArgumentParseError [Char]
s [Char]
"index range")

showIntArg :: Int -> String
showIntArg :: Int -> [Char]
showIntArg = Int -> [Char]
forall a. Show a => a -> [Char]
show

showIndexRangeArg :: (Int,Int) -> String
showIndexRangeArg :: (Int, Int) -> [Char]
showIndexRangeArg (Int
n,Int
m) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
m