{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
module HaskellCI.OptparseGrammar (
    OptparseGrammar,
    runOptparseGrammar,
) where

import HaskellCI.Prelude

import Control.Applicative (many)
import Data.Foldable       (asum)

import qualified Distribution.Compat.Lens    as C
import qualified Distribution.Compat.Newtype as C
import qualified Distribution.FieldGrammar   as C
import qualified Distribution.Fields         as C
import qualified Distribution.Parsec         as C
import qualified Distribution.Pretty         as C
import qualified Distribution.Version        as C
import qualified Options.Applicative         as O

import HaskellCI.OptionsGrammar

data SomeParser s where
    SP :: (Maybe MetaVar -> Maybe O.Completer -> Maybe Help -> O.Parser (s -> s)) -> SomeParser s

newtype OptparseGrammar s a = OG [SomeParser s]
  deriving (forall a b.
 (a -> b) -> OptparseGrammar s a -> OptparseGrammar s b)
-> (forall a b. a -> OptparseGrammar s b -> OptparseGrammar s a)
-> Functor (OptparseGrammar s)
forall a b. a -> OptparseGrammar s b -> OptparseGrammar s a
forall a b. (a -> b) -> OptparseGrammar s a -> OptparseGrammar s b
forall s a b. a -> OptparseGrammar s b -> OptparseGrammar s a
forall s a b.
(a -> b) -> OptparseGrammar s a -> OptparseGrammar s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b.
(a -> b) -> OptparseGrammar s a -> OptparseGrammar s b
fmap :: forall a b. (a -> b) -> OptparseGrammar s a -> OptparseGrammar s b
$c<$ :: forall s a b. a -> OptparseGrammar s b -> OptparseGrammar s a
<$ :: forall a b. a -> OptparseGrammar s b -> OptparseGrammar s a
Functor

runOptparseGrammar :: OptparseGrammar s a -> O.Parser (s -> s)
runOptparseGrammar :: forall s a. OptparseGrammar s a -> Parser (s -> s)
runOptparseGrammar (OG [SomeParser s]
ps) = ([s -> s] -> s -> s) -> Parser [s -> s] -> Parser (s -> s)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((s -> s) -> (s -> s) -> s -> s) -> (s -> s) -> [s -> s] -> s -> s
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((s -> s) -> (s -> s) -> s -> s) -> (s -> s) -> (s -> s) -> s -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip (s -> s) -> (s -> s) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) s -> s
forall a. a -> a
id) (Parser [s -> s] -> Parser (s -> s))
-> Parser [s -> s] -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ Parser (s -> s) -> Parser [s -> s]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser (s -> s) -> Parser [s -> s])
-> Parser (s -> s) -> Parser [s -> s]
forall a b. (a -> b) -> a -> b
$ [Parser (s -> s)] -> Parser (s -> s)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (s -> s)
p Maybe MetaVar
forall a. Maybe a
Nothing Maybe Completer
forall a. Maybe a
Nothing Maybe MetaVar
forall a. Maybe a
Nothing
    | SP Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (s -> s)
p <- [SomeParser s]
ps
    ]

instance Applicative (OptparseGrammar s) where
    pure :: forall a. a -> OptparseGrammar s a
pure a
_ = [SomeParser s] -> OptparseGrammar s a
forall s a. [SomeParser s] -> OptparseGrammar s a
OG []
    OG [SomeParser s]
f <*> :: forall a b.
OptparseGrammar s (a -> b)
-> OptparseGrammar s a -> OptparseGrammar s b
<*> OG [SomeParser s]
x = [SomeParser s] -> OptparseGrammar s b
forall s a. [SomeParser s] -> OptparseGrammar s a
OG ([SomeParser s]
f [SomeParser s] -> [SomeParser s] -> [SomeParser s]
forall a. [a] -> [a] -> [a]
++ [SomeParser s]
x)

instance C.FieldGrammar ParsecPretty OptparseGrammar where
    blurFieldGrammar :: forall a b d.
ALens' a b -> OptparseGrammar b d -> OptparseGrammar a d
blurFieldGrammar ALens' a b
l (OG [SomeParser b]
ps) = [SomeParser a] -> OptparseGrammar a d
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (a -> a))
-> SomeParser a
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (a -> a))
 -> SomeParser a)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (a -> a))
-> SomeParser a
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
v Maybe Completer
c Maybe MetaVar
h -> ((b -> b) -> a -> a) -> Parser (b -> b) -> Parser (a -> a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ALens' a b
l ALens' a b -> (b -> b) -> a -> a
forall s t a b. ALens s t a b -> (a -> b) -> s -> t
C.#%~) (Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (b -> b)
p Maybe MetaVar
v Maybe Completer
c Maybe MetaVar
h)
        | SP Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (b -> b)
p <- [SomeParser b]
ps
        ]

    -- we don't support unique fields atm
    uniqueFieldAla :: forall b a s.
(ParsecPretty b, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> OptparseGrammar s a
uniqueFieldAla FieldName
_ a -> b
_ ALens' s a
_ = [SomeParser s] -> OptparseGrammar s a
forall s a. [SomeParser s] -> OptparseGrammar s a
OG []

    -- the non default flag has help entry
    booleanFieldDef :: forall s.
FieldName -> ALens' s Bool -> Bool -> OptparseGrammar s Bool
booleanFieldDef FieldName
fn ALens' s Bool
l Bool
def = [SomeParser s] -> OptparseGrammar s Bool
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
_m Maybe Completer
_c Maybe MetaVar
h -> ALens' s Bool -> Parser Bool -> Parser (s -> s)
forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s Bool
l (Parser Bool -> Parser (s -> s)) -> Parser Bool -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
O.flag' Bool
True  (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ FieldName -> Maybe MetaVar -> Mod FlagFields Bool
forall (mods :: * -> *) a.
HasName mods =>
FieldName -> Maybe MetaVar -> Mod mods a
flagMods FieldName
fn (Maybe MetaVar -> Maybe MetaVar
th Maybe MetaVar
h)
        , (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
_m Maybe Completer
_c Maybe MetaVar
h -> ALens' s Bool -> Parser Bool -> Parser (s -> s)
forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s Bool
l (Parser Bool -> Parser (s -> s)) -> Parser Bool -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
O.flag' Bool
False (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ FieldName -> Maybe MetaVar -> Mod FlagFields Bool
forall (mods :: * -> *) a.
HasName mods =>
FieldName -> Maybe MetaVar -> Mod mods a
flagMods (FieldName
"no-" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
fn) (Maybe MetaVar -> Maybe MetaVar
fh Maybe MetaVar
h)
        ]
      where
        th :: Maybe MetaVar -> Maybe MetaVar
th Maybe MetaVar
h = if Bool
def then Maybe MetaVar
forall a. Maybe a
Nothing else Maybe MetaVar
h
        fh :: Maybe MetaVar -> Maybe MetaVar
fh Maybe MetaVar
h = if Bool
def then Maybe MetaVar
h else Maybe MetaVar
forall a. Maybe a
Nothing

    optionalFieldAla :: forall b a s.
(ParsecPretty b, Newtype a b) =>
FieldName
-> (a -> b) -> ALens' s (Maybe a) -> OptparseGrammar s (Maybe a)
optionalFieldAla FieldName
fn a -> b
c ALens' s (Maybe a)
l = [SomeParser s] -> OptparseGrammar s (Maybe a)
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
m Maybe Completer
cpl Maybe MetaVar
h -> ALens' s (Maybe a) -> Parser a -> Parser (s -> s)
forall s a. ALens' s (Maybe a) -> Parser a -> Parser (s -> s)
setOptionalOG ALens' s (Maybe a)
l (Parser a -> Parser (s -> s)) -> Parser a -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ((a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
C.unpack' a -> b
c (b -> a) -> ReadM b -> ReadM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM b
forall a. Parsec a => ReadM a
readMParsec) (Mod OptionFields a -> Parser a) -> Mod OptionFields a -> Parser a
forall a b. (a -> b) -> a -> b
$ FieldName
-> Maybe MetaVar
-> Maybe Completer
-> Maybe MetaVar
-> Mod OptionFields a
forall (mods :: * -> *) a.
(HasName mods, HasCompleter mods, HasMetavar mods) =>
FieldName
-> Maybe MetaVar -> Maybe Completer -> Maybe MetaVar -> Mod mods a
optionMods FieldName
fn Maybe MetaVar
m Maybe Completer
cpl Maybe MetaVar
h ]

    optionalFieldDefAla :: forall b a s.
(ParsecPretty b, Newtype a b, Eq a) =>
FieldName -> (a -> b) -> ALens' s a -> a -> OptparseGrammar s a
optionalFieldDefAla FieldName
fn a -> b
c ALens' s a
l a
def = [SomeParser s] -> OptparseGrammar s a
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
m Maybe Completer
cpl Maybe MetaVar
h -> ALens' s a -> Parser a -> Parser (s -> s)
forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s a
l (Parser a -> Parser (s -> s)) -> Parser a -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ((a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
C.unpack' a -> b
c (b -> a) -> ReadM b -> ReadM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM b
forall a. Parsec a => ReadM a
readMParsec) (Mod OptionFields a -> Parser a) -> Mod OptionFields a -> Parser a
forall a b. (a -> b) -> a -> b
$ FieldName
-> Maybe MetaVar
-> Maybe Completer
-> Maybe MetaVar
-> Mod OptionFields a
forall (mods :: * -> *) a.
(HasName mods, HasCompleter mods, HasMetavar mods) =>
FieldName
-> Maybe MetaVar -> Maybe Completer -> Maybe MetaVar -> Mod mods a
optionMods FieldName
fn Maybe MetaVar
m Maybe Completer
cpl ((MetaVar -> MetaVar) -> Maybe MetaVar -> Maybe MetaVar
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaVar -> MetaVar
hdef Maybe MetaVar
h) ]
      where
        hdef :: MetaVar -> MetaVar
hdef MetaVar
h = MetaVar
h MetaVar -> MetaVar -> MetaVar
forall a. [a] -> [a] -> [a]
++ MetaVar
" (Default: " MetaVar -> MetaVar -> MetaVar
forall a. [a] -> [a] -> [a]
++ b -> MetaVar
forall a. Pretty a => a -> MetaVar
C.prettyShow ((a -> b) -> a -> b
forall o n. Newtype o n => (o -> n) -> o -> n
C.pack' a -> b
c a
def) MetaVar -> MetaVar -> MetaVar
forall a. [a] -> [a] -> [a]
++ MetaVar
")"

    monoidalFieldAla :: forall b a s.
(ParsecPretty b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> OptparseGrammar s a
monoidalFieldAla FieldName
fn a -> b
c ALens' s a
l = [SomeParser s] -> OptparseGrammar s a
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
m Maybe Completer
cpl Maybe MetaVar
h -> ALens' s a -> Parser a -> Parser (s -> s)
forall a s. Monoid a => ALens' s a -> Parser a -> Parser (s -> s)
monoidOG ALens' s a
l (Parser a -> Parser (s -> s)) -> Parser a -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ((a -> b) -> b -> a
forall o n. Newtype o n => (o -> n) -> n -> o
C.unpack' a -> b
c (b -> a) -> ReadM b -> ReadM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM b
forall a. Parsec a => ReadM a
readMParsec) (Mod OptionFields a -> Parser a) -> Mod OptionFields a -> Parser a
forall a b. (a -> b) -> a -> b
$ FieldName
-> Maybe MetaVar
-> Maybe Completer
-> Maybe MetaVar
-> Mod OptionFields a
forall (mods :: * -> *) a.
(HasName mods, HasCompleter mods, HasMetavar mods) =>
FieldName
-> Maybe MetaVar -> Maybe Completer -> Maybe MetaVar -> Mod mods a
optionMods FieldName
fn Maybe MetaVar
m Maybe Completer
cpl Maybe MetaVar
h ]

    prefixedFields :: forall s.
FieldName
-> ALens' s [(MetaVar, MetaVar)]
-> OptparseGrammar s [(MetaVar, MetaVar)]
prefixedFields FieldName
_ ALens' s [(MetaVar, MetaVar)]
_   = [(MetaVar, MetaVar)] -> OptparseGrammar s [(MetaVar, MetaVar)]
forall a. a -> OptparseGrammar s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    knownField :: forall s. FieldName -> OptparseGrammar s ()
knownField FieldName
_         = () -> OptparseGrammar s ()
forall a. a -> OptparseGrammar s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    deprecatedSince :: forall s a.
CabalSpecVersion
-> MetaVar -> OptparseGrammar s a -> OptparseGrammar s a
deprecatedSince CabalSpecVersion
_  MetaVar
_ = OptparseGrammar s a -> OptparseGrammar s a
forall a. a -> a
id
    availableSince :: forall a s.
CabalSpecVersion -> a -> OptparseGrammar s a -> OptparseGrammar s a
availableSince CabalSpecVersion
_ a
_   = OptparseGrammar s a -> OptparseGrammar s a
forall a. a -> a
id
    removedIn :: forall s a.
CabalSpecVersion
-> MetaVar -> OptparseGrammar s a -> OptparseGrammar s a
removedIn CabalSpecVersion
_ MetaVar
_        = OptparseGrammar s a -> OptparseGrammar s a
forall a. a -> a
id
    hiddenField :: forall s a. OptparseGrammar s a -> OptparseGrammar s a
hiddenField          = OptparseGrammar s a -> OptparseGrammar s a
forall a. a -> a
id

    freeTextField :: forall s.
FieldName
-> ALens' s (Maybe MetaVar) -> OptparseGrammar s (Maybe MetaVar)
freeTextField FieldName
fn ALens' s (Maybe MetaVar)
l = [SomeParser s] -> OptparseGrammar s (Maybe MetaVar)
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
m Maybe Completer
c Maybe MetaVar
h -> ALens' s (Maybe MetaVar) -> Parser MetaVar -> Parser (s -> s)
forall s a. ALens' s (Maybe a) -> Parser a -> Parser (s -> s)
setOptionalOG ALens' s (Maybe MetaVar)
l (Parser MetaVar -> Parser (s -> s))
-> Parser MetaVar -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields MetaVar -> Parser MetaVar
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption (Mod OptionFields MetaVar -> Parser MetaVar)
-> Mod OptionFields MetaVar -> Parser MetaVar
forall a b. (a -> b) -> a -> b
$ FieldName
-> Maybe MetaVar
-> Maybe Completer
-> Maybe MetaVar
-> Mod OptionFields MetaVar
forall (mods :: * -> *) a.
(HasName mods, HasCompleter mods, HasMetavar mods) =>
FieldName
-> Maybe MetaVar -> Maybe Completer -> Maybe MetaVar -> Mod mods a
optionMods FieldName
fn Maybe MetaVar
m Maybe Completer
c Maybe MetaVar
h ]

    freeTextFieldDef :: forall s.
FieldName -> ALens' s MetaVar -> OptparseGrammar s MetaVar
freeTextFieldDef FieldName
fn ALens' s MetaVar
l = [SomeParser s] -> OptparseGrammar s MetaVar
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
m Maybe Completer
c Maybe MetaVar
h -> ALens' s MetaVar -> Parser MetaVar -> Parser (s -> s)
forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s MetaVar
l (Parser MetaVar -> Parser (s -> s))
-> Parser MetaVar -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields MetaVar -> Parser MetaVar
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption (Mod OptionFields MetaVar -> Parser MetaVar)
-> Mod OptionFields MetaVar -> Parser MetaVar
forall a b. (a -> b) -> a -> b
$ FieldName
-> Maybe MetaVar
-> Maybe Completer
-> Maybe MetaVar
-> Mod OptionFields MetaVar
forall (mods :: * -> *) a.
(HasName mods, HasCompleter mods, HasMetavar mods) =>
FieldName
-> Maybe MetaVar -> Maybe Completer -> Maybe MetaVar -> Mod mods a
optionMods FieldName
fn Maybe MetaVar
m Maybe Completer
c Maybe MetaVar
h ]

    freeTextFieldDefST :: forall s.
FieldName -> ALens' s ShortText -> OptparseGrammar s ShortText
freeTextFieldDefST FieldName
fn ALens' s ShortText
l = [SomeParser s] -> OptparseGrammar s ShortText
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
m Maybe Completer
c Maybe MetaVar
h -> ALens' s ShortText -> Parser ShortText -> Parser (s -> s)
forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s ShortText
l (Parser ShortText -> Parser (s -> s))
-> Parser ShortText -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields ShortText -> Parser ShortText
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption (Mod OptionFields ShortText -> Parser ShortText)
-> Mod OptionFields ShortText -> Parser ShortText
forall a b. (a -> b) -> a -> b
$ FieldName
-> Maybe MetaVar
-> Maybe Completer
-> Maybe MetaVar
-> Mod OptionFields ShortText
forall (mods :: * -> *) a.
(HasName mods, HasCompleter mods, HasMetavar mods) =>
FieldName
-> Maybe MetaVar -> Maybe Completer -> Maybe MetaVar -> Mod mods a
optionMods FieldName
fn Maybe MetaVar
m Maybe Completer
c Maybe MetaVar
h ]

instance OptionsGrammar ParsecPretty OptparseGrammar where
    help :: forall s a. MetaVar -> OptparseGrammar s a -> OptparseGrammar s a
help MetaVar
h (OG [SomeParser s]
ps) = [SomeParser s] -> OptparseGrammar s a
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
m Maybe Completer
c Maybe MetaVar
_h -> Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (s -> s)
p Maybe MetaVar
m Maybe Completer
c (MetaVar -> Maybe MetaVar
forall a. a -> Maybe a
Just MetaVar
h)
        | SP Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (s -> s)
p <- [SomeParser s]
ps
        ]

    metahelp :: forall s a.
MetaVar -> MetaVar -> OptparseGrammar s a -> OptparseGrammar s a
metahelp MetaVar
m MetaVar
h (OG [SomeParser s]
ps) = [SomeParser s] -> OptparseGrammar s a
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
_m Maybe Completer
c Maybe MetaVar
_h -> Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (s -> s)
p (MetaVar -> Maybe MetaVar
forall a. a -> Maybe a
Just MetaVar
m) Maybe Completer
c (MetaVar -> Maybe MetaVar
forall a. a -> Maybe a
Just MetaVar
h)
        | SP Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (s -> s)
p <- [SomeParser s]
ps
        ]

    metaCompleterHelp :: forall s a.
MetaVar
-> Completer
-> MetaVar
-> OptparseGrammar s a
-> OptparseGrammar s a
metaCompleterHelp MetaVar
m Completer
c MetaVar
h (OG [SomeParser s]
ps) = [SomeParser s] -> OptparseGrammar s a
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
_m Maybe Completer
_c Maybe MetaVar
_h -> Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (s -> s)
p (MetaVar -> Maybe MetaVar
forall a. a -> Maybe a
Just MetaVar
m) (Completer -> Maybe Completer
forall a. a -> Maybe a
Just Completer
c) (MetaVar -> Maybe MetaVar
forall a. a -> Maybe a
Just MetaVar
h)
        | SP Maybe MetaVar
-> Maybe Completer -> Maybe MetaVar -> Parser (s -> s)
p <- [SomeParser s]
ps
        ]

    -- example: @rangeField tests #cfgTests anyVersion@, generates options:
    --
    -- --tests
    -- --no-tests
    -- --tests-jobs RANGE
    --
    -- where the --no-tests has help, because it's not default.
    --
    rangeField :: forall s.
FieldName
-> ALens' s VersionRange
-> VersionRange
-> OptparseGrammar s VersionRange
rangeField FieldName
fn ALens' s VersionRange
l VersionRange
def = [SomeParser s] -> OptparseGrammar s VersionRange
forall s a. [SomeParser s] -> OptparseGrammar s a
OG
        [ (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
_m Maybe Completer
_c  Maybe MetaVar
h -> ALens' s VersionRange -> Parser VersionRange -> Parser (s -> s)
forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s VersionRange
l (Parser VersionRange -> Parser (s -> s))
-> Parser VersionRange -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ VersionRange -> Mod FlagFields VersionRange -> Parser VersionRange
forall a. a -> Mod FlagFields a -> Parser a
O.flag' VersionRange
C.anyVersion (Mod FlagFields VersionRange -> Parser VersionRange)
-> Mod FlagFields VersionRange -> Parser VersionRange
forall a b. (a -> b) -> a -> b
$ FieldName -> Maybe MetaVar -> Mod FlagFields VersionRange
forall (mods :: * -> *) a.
HasName mods =>
FieldName -> Maybe MetaVar -> Mod mods a
flagMods FieldName
fn (Maybe MetaVar -> Maybe MetaVar
th Maybe MetaVar
h)
        , (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
_m Maybe Completer
_c  Maybe MetaVar
h -> ALens' s VersionRange -> Parser VersionRange -> Parser (s -> s)
forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s VersionRange
l (Parser VersionRange -> Parser (s -> s))
-> Parser VersionRange -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ VersionRange -> Mod FlagFields VersionRange -> Parser VersionRange
forall a. a -> Mod FlagFields a -> Parser a
O.flag' VersionRange
C.noVersion  (Mod FlagFields VersionRange -> Parser VersionRange)
-> Mod FlagFields VersionRange -> Parser VersionRange
forall a b. (a -> b) -> a -> b
$ FieldName -> Maybe MetaVar -> Mod FlagFields VersionRange
forall (mods :: * -> *) a.
HasName mods =>
FieldName -> Maybe MetaVar -> Mod mods a
flagMods (FieldName
"no-" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
fn) (Maybe MetaVar -> Maybe MetaVar
fh Maybe MetaVar
h)
        , (Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall s.
(Maybe MetaVar
 -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
SP ((Maybe MetaVar
  -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
 -> SomeParser s)
-> (Maybe MetaVar
    -> Maybe Completer -> Maybe MetaVar -> Parser (s -> s))
-> SomeParser s
forall a b. (a -> b) -> a -> b
$ \Maybe MetaVar
_m Maybe Completer
_c Maybe MetaVar
_h -> ALens' s VersionRange -> Parser VersionRange -> Parser (s -> s)
forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s VersionRange
l (Parser VersionRange -> Parser (s -> s))
-> Parser VersionRange -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ ReadM VersionRange
-> Mod OptionFields VersionRange -> Parser VersionRange
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ReadM VersionRange
forall a. Parsec a => ReadM a
readMParsec (Mod OptionFields VersionRange -> Parser VersionRange)
-> Mod OptionFields VersionRange -> Parser VersionRange
forall a b. (a -> b) -> a -> b
$ MetaVar -> Mod OptionFields VersionRange
forall (f :: * -> *) a. HasName f => MetaVar -> Mod f a
O.long (FieldName -> MetaVar
fromUTF8BS (FieldName -> MetaVar) -> FieldName -> MetaVar
forall a b. (a -> b) -> a -> b
$ FieldName
fn FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
"-jobs") Mod OptionFields VersionRange
-> Mod OptionFields VersionRange -> Mod OptionFields VersionRange
forall a. Semigroup a => a -> a -> a
<> MetaVar -> Mod OptionFields VersionRange
forall (f :: * -> *) a. HasMetavar f => MetaVar -> Mod f a
O.metavar MetaVar
"RANGE"
        ]
      where
        th :: Maybe MetaVar -> Maybe MetaVar
th Maybe MetaVar
h = if VersionRange -> VersionRange -> Bool
equivVersionRanges VersionRange
def VersionRange
C.anyVersion then Maybe MetaVar
forall a. Maybe a
Nothing else Maybe MetaVar
h
        fh :: Maybe MetaVar -> Maybe MetaVar
fh Maybe MetaVar
h = if VersionRange -> VersionRange -> Bool
equivVersionRanges VersionRange
def VersionRange
C.anyVersion then Maybe MetaVar
h else Maybe MetaVar
forall a. Maybe a
Nothing

optionMods :: (O.HasName mods, O.HasCompleter mods, O.HasMetavar mods)
           => C.FieldName -> Maybe MetaVar -> Maybe O.Completer -> Maybe Help -> O.Mod mods a
optionMods :: forall (mods :: * -> *) a.
(HasName mods, HasCompleter mods, HasMetavar mods) =>
FieldName
-> Maybe MetaVar -> Maybe Completer -> Maybe MetaVar -> Mod mods a
optionMods FieldName
fn Maybe MetaVar
mmetavar Maybe Completer
mcompl Maybe MetaVar
mhelp = FieldName -> Maybe MetaVar -> Mod mods a
forall (mods :: * -> *) a.
HasName mods =>
FieldName -> Maybe MetaVar -> Mod mods a
flagMods FieldName
fn Maybe MetaVar
mhelp
    Mod mods a -> Mod mods a -> Mod mods a
forall a. Semigroup a => a -> a -> a
<> Mod mods a
-> (MetaVar -> Mod mods a) -> Maybe MetaVar -> Mod mods a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mod mods a
forall a. Monoid a => a
mempty MetaVar -> Mod mods a
forall (f :: * -> *) a. HasMetavar f => MetaVar -> Mod f a
O.metavar Maybe MetaVar
mmetavar
    Mod mods a -> Mod mods a -> Mod mods a
forall a. Semigroup a => a -> a -> a
<> Mod mods a
-> (Completer -> Mod mods a) -> Maybe Completer -> Mod mods a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mod mods a
forall a. Monoid a => a
mempty Completer -> Mod mods a
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
O.completer Maybe Completer
mcompl

flagMods :: O.HasName mods => C.FieldName -> Maybe Help -> O.Mod mods a
flagMods :: forall (mods :: * -> *) a.
HasName mods =>
FieldName -> Maybe MetaVar -> Mod mods a
flagMods FieldName
fn Maybe MetaVar
mhelp = MetaVar -> Mod mods a
forall (f :: * -> *) a. HasName f => MetaVar -> Mod f a
O.long (FieldName -> MetaVar
fromUTF8BS FieldName
fn)
    Mod mods a -> Mod mods a -> Mod mods a
forall a. Semigroup a => a -> a -> a
<> Mod mods a
-> (MetaVar -> Mod mods a) -> Maybe MetaVar -> Mod mods a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mod mods a
forall a. Monoid a => a
mempty MetaVar -> Mod mods a
forall (f :: * -> *) a. MetaVar -> Mod f a
O.help Maybe MetaVar
mhelp

readMParsec :: C.Parsec a => O.ReadM a
readMParsec :: forall a. Parsec a => ReadM a
readMParsec = (MetaVar -> Either MetaVar a) -> ReadM a
forall a. (MetaVar -> Either MetaVar a) -> ReadM a
O.eitherReader MetaVar -> Either MetaVar a
forall a. Parsec a => MetaVar -> Either MetaVar a
C.eitherParsec

setOG :: C.ALens' s a -> O.Parser a -> O.Parser (s -> s)
setOG :: forall s a. ALens' s a -> Parser a -> Parser (s -> s)
setOG ALens' s a
l = (a -> s -> s) -> Parser a -> Parser (s -> s)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ALens' s a
l ALens' s a -> a -> s -> s
forall s t a b. ALens s t a b -> b -> s -> t
C.#~)

setOptionalOG :: C.ALens' s (Maybe a) -> O.Parser a -> O.Parser (s -> s)
setOptionalOG :: forall s a. ALens' s (Maybe a) -> Parser a -> Parser (s -> s)
setOptionalOG ALens' s (Maybe a)
l = (a -> s -> s) -> Parser a -> Parser (s -> s)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> s -> s) -> Parser a -> Parser (s -> s))
-> (a -> s -> s) -> Parser a -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ \a
x -> ALens' s (Maybe a)
l ALens' s (Maybe a) -> Maybe a -> s -> s
forall s t a b. ALens s t a b -> b -> s -> t
C.#~ a -> Maybe a
forall a. a -> Maybe a
Just a
x

monoidOG :: Monoid a => C.ALens' s a -> O.Parser a -> O.Parser (s -> s)
monoidOG :: forall a s. Monoid a => ALens' s a -> Parser a -> Parser (s -> s)
monoidOG ALens' s a
l = (a -> s -> s) -> Parser a -> Parser (s -> s)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> s -> s) -> Parser a -> Parser (s -> s))
-> (a -> s -> s) -> Parser a -> Parser (s -> s)
forall a b. (a -> b) -> a -> b
$ \a
x -> ALens' s a
l ALens' s a -> (a -> a) -> s -> s
forall s t a b. ALens s t a b -> (a -> b) -> s -> t
C.#%~ \a
y -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
y a
x