{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ViewPatterns #-}

-- | Flags are arguments to your current command that are prefixed with "-" or
-- "--", for example "-v" or "--verbose". These flags can have zero or one
-- argument. (Butcher internally has more general concept of "CmdPart" that
-- could handle any number of arguments, so take this as what this module aims
-- to provide, not what you could theoretically implement on top of butcher).

-- Note that the current implementation only accepts "--foo param" but not
-- "--foo=param". Someone really ought to implement support for the latter
-- at some point :)
module UI.Butcher.Monadic.Flag
  ( Flag(..)
  , flagHelp
  , flagHelpStr
  , flagDefault
  , flagHidden
  , addSimpleBoolFlag
  , addSimpleCountFlag
  , addSimpleFlagA
  , addFlagReadParam
  , addFlagReadParams
  -- , addFlagReadParamA
  , addFlagStringParam
  , addFlagStringParams
  -- , addFlagStringParamA
  )
where



#include "prelude.inc"
import           Control.Monad.Free
import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
import qualified Control.Monad.Trans.MultiState.Strict as MultiStateS

import qualified Text.PrettyPrint as PP

import           Data.HList.ContainsType

import           UI.Butcher.Monadic.Internal.Types
import           UI.Butcher.Monadic.Internal.Core

import           Data.List.Extra ( firstJust )



-- TODO: perhaps move this to Types module and refactor all code to use it
newtype InpParseString a = InpParseString (StateS.StateT String Maybe a)
  deriving ((forall a b. (a -> b) -> InpParseString a -> InpParseString b)
-> (forall a b. a -> InpParseString b -> InpParseString a)
-> Functor InpParseString
forall a b. a -> InpParseString b -> InpParseString a
forall a b. (a -> b) -> InpParseString a -> InpParseString b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> InpParseString b -> InpParseString a
$c<$ :: forall a b. a -> InpParseString b -> InpParseString a
fmap :: forall a b. (a -> b) -> InpParseString a -> InpParseString b
$cfmap :: forall a b. (a -> b) -> InpParseString a -> InpParseString b
Functor, Functor InpParseString
Functor InpParseString
-> (forall a. a -> InpParseString a)
-> (forall a b.
    InpParseString (a -> b) -> InpParseString a -> InpParseString b)
-> (forall a b c.
    (a -> b -> c)
    -> InpParseString a -> InpParseString b -> InpParseString c)
-> (forall a b.
    InpParseString a -> InpParseString b -> InpParseString b)
-> (forall a b.
    InpParseString a -> InpParseString b -> InpParseString a)
-> Applicative InpParseString
forall a. a -> InpParseString a
forall a b.
InpParseString a -> InpParseString b -> InpParseString a
forall a b.
InpParseString a -> InpParseString b -> InpParseString b
forall a b.
InpParseString (a -> b) -> InpParseString a -> InpParseString b
forall a b c.
(a -> b -> c)
-> InpParseString a -> InpParseString b -> InpParseString c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
InpParseString a -> InpParseString b -> InpParseString a
$c<* :: forall a b.
InpParseString a -> InpParseString b -> InpParseString a
*> :: forall a b.
InpParseString a -> InpParseString b -> InpParseString b
$c*> :: forall a b.
InpParseString a -> InpParseString b -> InpParseString b
liftA2 :: forall a b c.
(a -> b -> c)
-> InpParseString a -> InpParseString b -> InpParseString c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> InpParseString a -> InpParseString b -> InpParseString c
<*> :: forall a b.
InpParseString (a -> b) -> InpParseString a -> InpParseString b
$c<*> :: forall a b.
InpParseString (a -> b) -> InpParseString a -> InpParseString b
pure :: forall a. a -> InpParseString a
$cpure :: forall a. a -> InpParseString a
Applicative, Applicative InpParseString
Applicative InpParseString
-> (forall a b.
    InpParseString a -> (a -> InpParseString b) -> InpParseString b)
-> (forall a b.
    InpParseString a -> InpParseString b -> InpParseString b)
-> (forall a. a -> InpParseString a)
-> Monad InpParseString
forall a. a -> InpParseString a
forall a b.
InpParseString a -> InpParseString b -> InpParseString b
forall a b.
InpParseString a -> (a -> InpParseString b) -> InpParseString b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> InpParseString a
$creturn :: forall a. a -> InpParseString a
>> :: forall a b.
InpParseString a -> InpParseString b -> InpParseString b
$c>> :: forall a b.
InpParseString a -> InpParseString b -> InpParseString b
>>= :: forall a b.
InpParseString a -> (a -> InpParseString b) -> InpParseString b
$c>>= :: forall a b.
InpParseString a -> (a -> InpParseString b) -> InpParseString b
Monad, State.Class.MonadState String, Applicative InpParseString
Applicative InpParseString
-> (forall a. InpParseString a)
-> (forall a.
    InpParseString a -> InpParseString a -> InpParseString a)
-> (forall a. InpParseString a -> InpParseString [a])
-> (forall a. InpParseString a -> InpParseString [a])
-> Alternative InpParseString
forall a. InpParseString a
forall a. InpParseString a -> InpParseString [a]
forall a. InpParseString a -> InpParseString a -> InpParseString a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. InpParseString a -> InpParseString [a]
$cmany :: forall a. InpParseString a -> InpParseString [a]
some :: forall a. InpParseString a -> InpParseString [a]
$csome :: forall a. InpParseString a -> InpParseString [a]
<|> :: forall a. InpParseString a -> InpParseString a -> InpParseString a
$c<|> :: forall a. InpParseString a -> InpParseString a -> InpParseString a
empty :: forall a. InpParseString a
$cempty :: forall a. InpParseString a
Alternative, Monad InpParseString
Alternative InpParseString
Alternative InpParseString
-> Monad InpParseString
-> (forall a. InpParseString a)
-> (forall a.
    InpParseString a -> InpParseString a -> InpParseString a)
-> MonadPlus InpParseString
forall a. InpParseString a
forall a. InpParseString a -> InpParseString a -> InpParseString a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. InpParseString a -> InpParseString a -> InpParseString a
$cmplus :: forall a. InpParseString a -> InpParseString a -> InpParseString a
mzero :: forall a. InpParseString a
$cmzero :: forall a. InpParseString a
MonadPlus)

runInpParseString :: String -> InpParseString a -> Maybe (a, String)
runInpParseString :: forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString [Char]
s (InpParseString StateT [Char] Maybe a
m) = StateT [Char] Maybe a -> [Char] -> Maybe (a, [Char])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StateS.runStateT StateT [Char] Maybe a
m [Char]
s

pExpect :: String -> InpParseString ()
pExpect :: [Char] -> InpParseString ()
pExpect [Char]
s = StateT [Char] Maybe () -> InpParseString ()
forall a. StateT [Char] Maybe a -> InpParseString a
InpParseString (StateT [Char] Maybe () -> InpParseString ())
-> StateT [Char] Maybe () -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ do
  [Char]
inp <- StateT [Char] Maybe [Char]
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
  case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [Char]
s [Char]
inp of
    Maybe [Char]
Nothing -> StateT [Char] Maybe ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Just [Char]
rest -> [Char] -> StateT [Char] Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put [Char]
rest

pExpectEof :: InpParseString ()
pExpectEof :: InpParseString ()
pExpectEof =
  StateT [Char] Maybe () -> InpParseString ()
forall a. StateT [Char] Maybe a -> InpParseString a
InpParseString (StateT [Char] Maybe () -> InpParseString ())
-> StateT [Char] Maybe () -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ StateT [Char] Maybe [Char]
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get StateT [Char] Maybe [Char]
-> ([Char] -> StateT [Char] Maybe ()) -> StateT [Char] Maybe ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
inp -> if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
inp then () -> StateT [Char] Maybe ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else StateT [Char] Maybe ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- pDropSpace :: InpParseString ()
-- pDropSpace = InpParseString $ StateS.modify (dropWhile (==' '))

pOption :: InpParseString () -> InpParseString ()
pOption :: InpParseString () -> InpParseString ()
pOption InpParseString ()
m = InpParseString ()
m InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> InpParseString ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()



-- | flag-description monoid. You probably won't need to use the constructor;
-- mzero or any (<>) of flag(Help|Default) works well.
data Flag p = Flag
  { forall p. Flag p -> Maybe Doc
_flag_help       :: Maybe PP.Doc
  , forall p. Flag p -> Maybe p
_flag_default    :: Maybe p
  , forall p. Flag p -> Visibility
_flag_visibility :: Visibility
  }

appendFlag :: Flag p -> Flag p -> Flag p
appendFlag :: forall p. Flag p -> Flag p -> Flag p
appendFlag (Flag Maybe Doc
a1 Maybe p
b1 Visibility
c1) (Flag Maybe Doc
a2 Maybe p
b2 Visibility
c2) = Maybe Doc -> Maybe p -> Visibility -> Flag p
forall p. Maybe Doc -> Maybe p -> Visibility -> Flag p
Flag (Maybe Doc
a1 Maybe Doc -> Maybe Doc -> Maybe Doc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Doc
a2)
                                                  (Maybe p
b1 Maybe p -> Maybe p -> Maybe p
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe p
b2)
                                                  (Visibility -> Visibility -> Visibility
appVis Visibility
c1 Visibility
c2)
 where
  appVis :: Visibility -> Visibility -> Visibility
appVis Visibility
Visible Visibility
Visible = Visibility
Visible
  appVis Visibility
_       Visibility
_       = Visibility
Hidden

instance Semigroup (Flag p) where
  <> :: Flag p -> Flag p -> Flag p
(<>) = Flag p -> Flag p -> Flag p
forall p. Flag p -> Flag p -> Flag p
appendFlag

instance Monoid (Flag p) where
  mempty :: Flag p
mempty = Maybe Doc -> Maybe p -> Visibility -> Flag p
forall p. Maybe Doc -> Maybe p -> Visibility -> Flag p
Flag Maybe Doc
forall a. Maybe a
Nothing Maybe p
forall a. Maybe a
Nothing Visibility
Visible
  mappend :: Flag p -> Flag p -> Flag p
mappend = Flag p -> Flag p -> Flag p
forall a. Semigroup a => a -> a -> a
(<>)

-- | Create a 'Flag' with just a help text.
flagHelp :: PP.Doc -> Flag p
flagHelp :: forall p. Doc -> Flag p
flagHelp Doc
h = Flag p
forall a. Monoid a => a
mempty { _flag_help :: Maybe Doc
_flag_help = Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
h }

-- | Create a 'Flag' with just a help text.
flagHelpStr :: String -> Flag p
flagHelpStr :: forall p. [Char] -> Flag p
flagHelpStr [Char]
s =
  Flag p
forall a. Monoid a => a
mempty { _flag_help :: Maybe Doc
_flag_help = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
PP.fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([Char] -> Doc) -> [[Char]] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Doc
PP.text ([[Char]] -> [Doc]) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
List.words [Char]
s }

-- | Create a 'Flag' with just a default value.
flagDefault :: p -> Flag p
flagDefault :: forall p. p -> Flag p
flagDefault p
d = Flag Any
forall a. Monoid a => a
mempty { _flag_default :: Maybe p
_flag_default = p -> Maybe p
forall a. a -> Maybe a
Just p
d }

-- | Create a 'Flag' marked as hidden. Similar to hidden commands, hidden
-- flags will not included in pretty-printing (help, usage etc.)
--
-- This feature is not well tested yet.
flagHidden :: Flag p
flagHidden :: forall p. Flag p
flagHidden = Flag p
forall a. Monoid a => a
mempty { _flag_visibility :: Visibility
_flag_visibility = Visibility
Hidden }

wrapHidden :: Flag p -> PartDesc -> PartDesc
wrapHidden :: forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag p
f = case Flag p -> Visibility
forall p. Flag p -> Visibility
_flag_visibility Flag p
f of
  Visibility
Visible -> PartDesc -> PartDesc
forall a. a -> a
id
  Visibility
Hidden  -> PartDesc -> PartDesc
PartHidden

-- | A no-parameter flag where non-occurence means False, occurence means True.
addSimpleBoolFlag
  :: Applicative f
  => String -- ^ short flag chars, i.e. "v" for -v
  -> [String] -- ^ list of long names, e.g. ["verbose"]
  -> Flag Void -- ^ properties
  -> CmdParser f out Bool
addSimpleBoolFlag :: forall (f :: * -> *) out.
Applicative f =>
[Char] -> [[Char]] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag [Char]
shorts [[Char]]
longs Flag Void
flag =
  [Char] -> [[Char]] -> Flag Void -> f () -> CmdParser f out Bool
forall (f :: * -> *) out.
[Char] -> [[Char]] -> Flag Void -> f () -> CmdParser f out Bool
addSimpleBoolFlagAll [Char]
shorts [[Char]]
longs Flag Void
flag (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Applicative-enabled version of 'addSimpleFlag'
addSimpleFlagA
  :: String -- ^ short flag chars, i.e. "v" for -v
  -> [String] -- ^ list of long names, e.g. ["verbose"]
  -> Flag Void -- ^ properties
  -> f () -- ^ action to execute whenever this matches
  -> CmdParser f out ()
addSimpleFlagA :: forall (f :: * -> *) out.
[Char] -> [[Char]] -> Flag Void -> f () -> CmdParser f out ()
addSimpleFlagA [Char]
shorts [[Char]]
longs Flag Void
flag f ()
act
  = Free (CmdParserF f out) Bool -> Free (CmdParserF f out) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Free (CmdParserF f out) Bool -> Free (CmdParserF f out) ())
-> Free (CmdParserF f out) Bool -> Free (CmdParserF f out) ()
forall a b. (a -> b) -> a -> b
$ [Char]
-> [[Char]] -> Flag Void -> f () -> Free (CmdParserF f out) Bool
forall (f :: * -> *) out.
[Char] -> [[Char]] -> Flag Void -> f () -> CmdParser f out Bool
addSimpleBoolFlagAll [Char]
shorts [[Char]]
longs Flag Void
flag f ()
act

addSimpleBoolFlagAll
  :: String
  -> [String]
  -> Flag Void
  -> f ()
  -> CmdParser f out Bool
addSimpleBoolFlagAll :: forall (f :: * -> *) out.
[Char] -> [[Char]] -> Flag Void -> f () -> CmdParser f out Bool
addSimpleBoolFlagAll [Char]
shorts [[Char]]
longs Flag Void
flag f ()
a = ([()] -> Bool)
-> Free (CmdParserF f out) [()] -> Free (CmdParserF f out) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not (Bool -> Bool) -> ([()] -> Bool) -> [()] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
  (Free (CmdParserF f out) [()] -> Free (CmdParserF f out) Bool)
-> Free (CmdParserF f out) [()] -> Free (CmdParserF f out) Bool
forall a b. (a -> b) -> a -> b
$ ManyUpperBound
-> PartDesc
-> ([Char] -> Maybe ((), [Char]))
-> (() -> f ())
-> Free (CmdParserF f out) [()]
forall p (f :: * -> *) out.
Typeable p =>
ManyUpperBound
-> PartDesc
-> ([Char] -> Maybe (p, [Char]))
-> (p -> f ())
-> CmdParser f out [p]
addCmdPartManyA ManyUpperBound
ManyUpperBound1 (Flag Void -> PartDesc -> PartDesc
forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag Void
flag PartDesc
desc) [Char] -> Maybe ((), [Char])
parseF (\() -> f ()
a)
 where
  allStrs :: [[Char]]
allStrs = (Char -> [Char]) -> [Char] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
c -> [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c]) [Char]
shorts [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Char]
s -> [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s) [[Char]]
longs
  desc :: PartDesc
  desc :: PartDesc
desc =
    ((PartDesc -> PartDesc)
-> (Doc -> PartDesc -> PartDesc)
-> Maybe Doc
-> PartDesc
-> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id Doc -> PartDesc -> PartDesc
PartWithHelp (Maybe Doc -> PartDesc -> PartDesc)
-> Maybe Doc -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ Flag Void -> Maybe Doc
forall p. Flag p -> Maybe Doc
_flag_help Flag Void
flag)
      (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$   [PartDesc] -> PartDesc
PartAlts
      ([PartDesc] -> PartDesc) -> [PartDesc] -> PartDesc
forall a b. (a -> b) -> a -> b
$   [Char] -> PartDesc
PartLiteral
      ([Char] -> PartDesc) -> [[Char]] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
allStrs
  parseF :: String -> Maybe ((), String)
  parseF :: [Char] -> Maybe ((), [Char])
parseF ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace -> [Char]
str) =
    (([Char] -> Maybe ((), [Char])) -> [[Char]] -> Maybe ((), [Char])
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust (\[Char]
s -> [ ((), Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) [Char]
str) | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
str ]) [[Char]]
allStrs)
      Maybe ((), [Char]) -> Maybe ((), [Char]) -> Maybe ((), [Char])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( ([Char] -> Maybe ((), [Char])) -> [[Char]] -> Maybe ((), [Char])
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust
            ( \[Char]
s ->
              [ ((), Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char]
str) | ([Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
str ]
            )
            [[Char]]
allStrs
          )

-- | A no-parameter flag that can occur multiple times. Returns the number of
-- occurences (0 or more).
addSimpleCountFlag :: Applicative f
                   => String -- ^ short flag chars, i.e. "v" for -v
                   -> [String] -- ^ list of long names, i.e. ["verbose"]
                   -> Flag Void -- ^ properties
                   -> CmdParser f out Int
addSimpleCountFlag :: forall (f :: * -> *) out.
Applicative f =>
[Char] -> [[Char]] -> Flag Void -> CmdParser f out Int
addSimpleCountFlag [Char]
shorts [[Char]]
longs Flag Void
flag = ([()] -> Int)
-> Free (CmdParserF f out) [()] -> Free (CmdParserF f out) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  (Free (CmdParserF f out) [()] -> Free (CmdParserF f out) Int)
-> Free (CmdParserF f out) [()] -> Free (CmdParserF f out) Int
forall a b. (a -> b) -> a -> b
$ ManyUpperBound
-> PartDesc
-> ([Char] -> Maybe ((), [Char]))
-> Free (CmdParserF f out) [()]
forall (f :: * -> *) p out.
(Applicative f, Typeable p) =>
ManyUpperBound
-> PartDesc -> ([Char] -> Maybe (p, [Char])) -> CmdParser f out [p]
addCmdPartMany ManyUpperBound
ManyUpperBoundN (Flag Void -> PartDesc -> PartDesc
forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag Void
flag PartDesc
desc) [Char] -> Maybe ((), [Char])
parseF
 where
    -- we _could_ allow this to parse repeated short flags, like "-vvv"
    -- (meaning "-v -v -v") correctly.
  allStrs :: [[Char]]
allStrs = (Char -> [Char]) -> [Char] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Char
c -> [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c]) [Char]
shorts [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Char]
s -> [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s) [[Char]]
longs
  desc :: PartDesc
  desc :: PartDesc
desc =
    ((PartDesc -> PartDesc)
-> (Doc -> PartDesc -> PartDesc)
-> Maybe Doc
-> PartDesc
-> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id Doc -> PartDesc -> PartDesc
PartWithHelp (Maybe Doc -> PartDesc -> PartDesc)
-> Maybe Doc -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ Flag Void -> Maybe Doc
forall p. Flag p -> Maybe Doc
_flag_help Flag Void
flag)
      (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$   [PartDesc] -> PartDesc
PartAlts
      ([PartDesc] -> PartDesc) -> [PartDesc] -> PartDesc
forall a b. (a -> b) -> a -> b
$   [Char] -> PartDesc
PartLiteral
      ([Char] -> PartDesc) -> [[Char]] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
allStrs
  parseF :: String -> Maybe ((), String)
  parseF :: [Char] -> Maybe ((), [Char])
parseF ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace -> [Char]
str) =
    (([Char] -> Maybe ((), [Char])) -> [[Char]] -> Maybe ((), [Char])
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust (\[Char]
s -> [ ((), Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) [Char]
str) | [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
str ]) [[Char]]
allStrs)
      Maybe ((), [Char]) -> Maybe ((), [Char]) -> Maybe ((), [Char])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( ([Char] -> Maybe ((), [Char])) -> [[Char]] -> Maybe ((), [Char])
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust
            ( \[Char]
s ->
              [ ((), Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Char]
str) | ([Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ") [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
str ]
            )
            [[Char]]
allStrs
          )

-- | One-argument flag, where the argument is parsed via its Read instance.
addFlagReadParam
  :: forall f p out
   . (Applicative f, Typeable p, Text.Read.Read p, Show p)
  => String -- ^ short flag chars, i.e. "v" for -v
  -> [String] -- ^ list of long names, i.e. ["verbose"]
  -> String -- ^ param name
  -> Flag p -- ^ properties
  -> CmdParser f out p
addFlagReadParam :: forall (f :: * -> *) p out.
(Applicative f, Typeable p, Read p, Show p) =>
[Char] -> [[Char]] -> [Char] -> Flag p -> CmdParser f out p
addFlagReadParam [Char]
shorts [[Char]]
longs [Char]
name Flag p
flag =
  PartDesc
-> (Input -> Maybe (p, Input)) -> (p -> f ()) -> CmdParser f out p
forall p (f :: * -> *) out.
Typeable p =>
PartDesc
-> (Input -> Maybe (p, Input)) -> (p -> f ()) -> CmdParser f out p
addCmdPartInpA (Flag p -> PartDesc -> PartDesc
forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag p
flag PartDesc
desc) Input -> Maybe (p, Input)
parseF (\p
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
 where
  allStrs :: [Either [Char] [Char]]
allStrs =
    [ [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c] | Char
c <- [Char]
shorts ] [Either [Char] [Char]]
-> [Either [Char] [Char]] -> [Either [Char] [Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
l | [Char]
l <- [[Char]]
longs ]
  desc :: PartDesc
desc =
    ((PartDesc -> PartDesc)
-> (Doc -> PartDesc -> PartDesc)
-> Maybe Doc
-> PartDesc
-> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id Doc -> PartDesc -> PartDesc
PartWithHelp (Maybe Doc -> PartDesc -> PartDesc)
-> Maybe Doc -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ Flag p -> Maybe Doc
forall p. Flag p -> Maybe Doc
_flag_help Flag p
flag)
      (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ (PartDesc -> PartDesc)
-> (p -> PartDesc -> PartDesc) -> Maybe p -> PartDesc -> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id ([Char] -> PartDesc -> PartDesc
PartDefault ([Char] -> PartDesc -> PartDesc)
-> (p -> [Char]) -> p -> PartDesc -> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> [Char]
forall a. Show a => a -> [Char]
show) (Flag p -> Maybe p
forall p. Flag p -> Maybe p
_flag_default Flag p
flag)
      (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ [PartDesc] -> PartDesc
PartSeq [PartDesc
desc1, PartDesc
desc2]
  desc1 :: PartDesc
  desc1 :: PartDesc
desc1 = [PartDesc] -> PartDesc
PartAlts ([PartDesc] -> PartDesc) -> [PartDesc] -> PartDesc
forall a b. (a -> b) -> a -> b
$ [Char] -> PartDesc
PartLiteral ([Char] -> PartDesc)
-> (Either [Char] [Char] -> [Char])
-> Either [Char] [Char]
-> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char])
-> ([Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Char]
forall a. a -> a
id [Char] -> [Char]
forall a. a -> a
id (Either [Char] [Char] -> PartDesc)
-> [Either [Char] [Char]] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either [Char] [Char]]
allStrs
  desc2 :: PartDesc
desc2 = [Char] -> PartDesc
PartVariable [Char]
name
  parseF :: Input -> Maybe (p, Input)
  parseF :: Input -> Maybe (p, Input)
parseF Input
inp = case Input
inp of
    InputString [Char]
str ->
      Maybe (p, Input)
-> ((p, [Char]) -> Maybe (p, Input))
-> Maybe (p, [Char])
-> Maybe (p, Input)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Flag p -> Maybe p
forall p. Flag p -> Maybe p
_flag_default Flag p
flag Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p
x -> (p
x, Input
inp)) ((p, Input) -> Maybe (p, Input)
forall a. a -> Maybe a
Just ((p, Input) -> Maybe (p, Input))
-> ((p, [Char]) -> (p, Input)) -> (p, [Char]) -> Maybe (p, Input)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Input) -> (p, [Char]) -> (p, Input)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Char] -> Input
InputString)
        (Maybe (p, [Char]) -> Maybe (p, Input))
-> Maybe (p, [Char]) -> Maybe (p, Input)
forall a b. (a -> b) -> a -> b
$ Maybe (p, [Char])
parseResult
     where
      parseResult :: Maybe (p, [Char])
parseResult = [Char] -> InpParseString p -> Maybe (p, [Char])
forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
str) (InpParseString p -> Maybe (p, [Char]))
-> InpParseString p -> Maybe (p, [Char])
forall a b. (a -> b) -> a -> b
$ do
        [InpParseString ()] -> InpParseString ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Data.Foldable.msum ([InpParseString ()] -> InpParseString ())
-> [InpParseString ()] -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ [Either [Char] [Char]]
allStrs [Either [Char] [Char]]
-> (Either [Char] [Char] -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption ([Char] -> InpParseString ()
pExpect [Char]
" " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> InpParseString ()
pExpect [Char]
"=")
          Right [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> InpParseString ()
pExpect [Char]
" " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> InpParseString ()
pExpect [Char]
"=")
        StateT [Char] Maybe p -> InpParseString p
forall a. StateT [Char] Maybe a -> InpParseString a
InpParseString (StateT [Char] Maybe p -> InpParseString p)
-> StateT [Char] Maybe p -> InpParseString p
forall a b. (a -> b) -> a -> b
$ do
          [Char]
i <- StateT [Char] Maybe [Char]
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
          case ReadS p
forall a. Read a => ReadS a
Text.Read.reads [Char]
i of
            ((p
x, Char
' ':[Char]
r):[(p, [Char])]
_) -> [Char] -> StateT [Char] Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
r) StateT [Char] Maybe () -> p -> StateT [Char] Maybe p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x
            ((p
x, [Char]
""   ):[(p, [Char])]
_) -> [Char] -> StateT [Char] Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put [Char]
"" StateT [Char] Maybe () -> p -> StateT [Char] Maybe p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x
            [(p, [Char])]
_              -> StateT [Char] Maybe p
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    InputArgs ([Char]
arg1:[[Char]]
argR) -> case [Char] -> InpParseString () -> Maybe ((), [Char])
forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString [Char]
arg1 InpParseString ()
parser of
      Just ((), [Char]
"") -> case [[Char]]
argR of
        []          -> Maybe (p, Input)
forall a. Maybe a
Nothing
        ([Char]
arg2:[[Char]]
rest) -> [Char] -> Maybe p
forall a. Read a => [Char] -> Maybe a
Text.Read.readMaybe [Char]
arg2 Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p
x -> (p
x, [[Char]] -> Input
InputArgs [[Char]]
rest)
      Just ((), [Char]
remainingStr) ->
        [Char] -> Maybe p
forall a. Read a => [Char] -> Maybe a
Text.Read.readMaybe [Char]
remainingStr Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p
x -> (p
x, [[Char]] -> Input
InputArgs [[Char]]
argR)
      Maybe ((), [Char])
Nothing -> Flag p -> Maybe p
forall p. Flag p -> Maybe p
_flag_default Flag p
flag Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p
d -> (p
d, Input
inp)
     where
      parser :: InpParseString ()
      parser :: InpParseString ()
parser = do
        [InpParseString ()] -> InpParseString ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Data.Foldable.msum ([InpParseString ()] -> InpParseString ())
-> [InpParseString ()] -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ [Either [Char] [Char]]
allStrs [Either [Char] [Char]]
-> (Either [Char] [Char] -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption ([Char] -> InpParseString ()
pExpect [Char]
"=")
          Right [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> InpParseString ()
pExpect [Char]
"=" InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InpParseString ()
pExpectEof)
    InputArgs [[Char]]
_ -> Flag p -> Maybe p
forall p. Flag p -> Maybe p
_flag_default Flag p
flag Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p
d -> (p
d, Input
inp)

-- | One-argument flag, where the argument is parsed via its Read instance.
-- This version can accumulate multiple values by using the same flag with
-- different arguments multiple times.
--
-- E.g. "--foo 3 --foo 5" yields [3,5].
addFlagReadParams
  :: forall f p out
   . (Applicative f, Typeable p, Text.Read.Read p, Show p)
  => String -- ^ short flag chars, i.e. "v" for -v
  -> [String] -- ^ list of long names, i.e. ["verbose"]
  -> String -- ^ param name
  -> Flag p -- ^ properties
  -> CmdParser f out [p]
addFlagReadParams :: forall (f :: * -> *) p out.
(Applicative f, Typeable p, Read p, Show p) =>
[Char] -> [[Char]] -> [Char] -> Flag p -> CmdParser f out [p]
addFlagReadParams [Char]
shorts [[Char]]
longs [Char]
name Flag p
flag
  = [Char]
-> [[Char]]
-> [Char]
-> Flag p
-> (p -> f ())
-> CmdParser f out [p]
forall (f :: * -> *) p out.
(Typeable p, Read p, Show p) =>
[Char]
-> [[Char]]
-> [Char]
-> Flag p
-> (p -> f ())
-> CmdParser f out [p]
addFlagReadParamsAll [Char]
shorts [[Char]]
longs [Char]
name Flag p
flag (\p
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- TODO: this implementation is wrong, because it uses addCmdPartManyInpA
--       while this really is no Many.
-- | Applicative-enabled version of 'addFlagReadParam'
-- addFlagReadParamA
--   :: forall f p out
--    . (Typeable p, Text.Read.Read p, Show p)
--   => String -- ^ short flag chars, i.e. "v" for -v
--   -> [String] -- ^ list of long names, i.e. ["verbose"]
--   -> String -- ^ param name
--   -> Flag p -- ^ properties
--   -> (p -> f ()) -- ^ action to execute when ths param matches
--   -> CmdParser f out ()
-- addFlagReadParamA shorts longs name flag act
--   = void $ addFlagReadParamsAll shorts longs name flag act

addFlagReadParamsAll
  :: forall f p out . (Typeable p, Text.Read.Read p, Show p) => String -- ^ short flag chars, i.e. "v" for -v
     -> [String] -- ^ list of long names, i.e. ["verbose"]
     -> String -- ^ param name
     -> Flag p -- ^ properties
     -> (p -> f ()) -- ^ action to execute when ths param matches
     -> CmdParser f out [p]
addFlagReadParamsAll :: forall (f :: * -> *) p out.
(Typeable p, Read p, Show p) =>
[Char]
-> [[Char]]
-> [Char]
-> Flag p
-> (p -> f ())
-> CmdParser f out [p]
addFlagReadParamsAll [Char]
shorts [[Char]]
longs [Char]
name Flag p
flag p -> f ()
act = ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> CmdParser f out [p]
forall p (f :: * -> *) out.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> CmdParser f out [p]
addCmdPartManyInpA
  ManyUpperBound
ManyUpperBoundN
  (Flag p -> PartDesc -> PartDesc
forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag p
flag PartDesc
desc)
  Input -> Maybe (p, Input)
parseF
  p -> f ()
act
 where
  allStrs :: [Either [Char] [Char]]
allStrs =
    [ [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c] | Char
c <- [Char]
shorts ] [Either [Char] [Char]]
-> [Either [Char] [Char]] -> [Either [Char] [Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
l | [Char]
l <- [[Char]]
longs ]
  desc :: PartDesc
desc = ((PartDesc -> PartDesc)
-> (Doc -> PartDesc -> PartDesc)
-> Maybe Doc
-> PartDesc
-> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id Doc -> PartDesc -> PartDesc
PartWithHelp (Maybe Doc -> PartDesc -> PartDesc)
-> Maybe Doc -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ Flag p -> Maybe Doc
forall p. Flag p -> Maybe Doc
_flag_help Flag p
flag) (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ [PartDesc] -> PartDesc
PartSeq [PartDesc
desc1, PartDesc
desc2]
  desc1 :: PartDesc
  desc1 :: PartDesc
desc1 = [PartDesc] -> PartDesc
PartAlts ([PartDesc] -> PartDesc) -> [PartDesc] -> PartDesc
forall a b. (a -> b) -> a -> b
$ [Char] -> PartDesc
PartLiteral ([Char] -> PartDesc)
-> (Either [Char] [Char] -> [Char])
-> Either [Char] [Char]
-> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char])
-> ([Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Char]
forall a. a -> a
id [Char] -> [Char]
forall a. a -> a
id (Either [Char] [Char] -> PartDesc)
-> [Either [Char] [Char]] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either [Char] [Char]]
allStrs
  desc2 :: PartDesc
desc2 =
    ((PartDesc -> PartDesc)
-> (p -> PartDesc -> PartDesc) -> Maybe p -> PartDesc -> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id ([Char] -> PartDesc -> PartDesc
PartDefault ([Char] -> PartDesc -> PartDesc)
-> (p -> [Char]) -> p -> PartDesc -> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> [Char]
forall a. Show a => a -> [Char]
show) (Maybe p -> PartDesc -> PartDesc)
-> Maybe p -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ Flag p -> Maybe p
forall p. Flag p -> Maybe p
_flag_default Flag p
flag) (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ [Char] -> PartDesc
PartVariable [Char]
name
  parseF :: Input -> Maybe (p, Input)
  parseF :: Input -> Maybe (p, Input)
parseF Input
inp = case Input
inp of
    InputString [Char]
str ->
      ((p, [Char]) -> (p, Input))
-> Maybe (p, [Char]) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> Input) -> (p, [Char]) -> (p, Input)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Char] -> Input
InputString) (Maybe (p, [Char]) -> Maybe (p, Input))
-> Maybe (p, [Char]) -> Maybe (p, Input)
forall a b. (a -> b) -> a -> b
$ Maybe (p, [Char])
parseResult
     where
      parseResult :: Maybe (p, [Char])
parseResult = [Char] -> InpParseString p -> Maybe (p, [Char])
forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
str) (InpParseString p -> Maybe (p, [Char]))
-> InpParseString p -> Maybe (p, [Char])
forall a b. (a -> b) -> a -> b
$ do
        [InpParseString ()] -> InpParseString ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Data.Foldable.msum ([InpParseString ()] -> InpParseString ())
-> [InpParseString ()] -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ [Either [Char] [Char]]
allStrs [Either [Char] [Char]]
-> (Either [Char] [Char] -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption ([Char] -> InpParseString ()
pExpect [Char]
" " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> InpParseString ()
pExpect [Char]
"=")
          Right [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> InpParseString ()
pExpect [Char]
" " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> InpParseString ()
pExpect [Char]
"=")
        StateT [Char] Maybe p -> InpParseString p
forall a. StateT [Char] Maybe a -> InpParseString a
InpParseString (StateT [Char] Maybe p -> InpParseString p)
-> StateT [Char] Maybe p -> InpParseString p
forall a b. (a -> b) -> a -> b
$ do
          [Char]
i <- StateT [Char] Maybe [Char]
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
          case ReadS p
forall a. Read a => ReadS a
Text.Read.reads [Char]
i of
            ((p
x, Char
' ':[Char]
r):[(p, [Char])]
_) -> [Char] -> StateT [Char] Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
r) StateT [Char] Maybe () -> p -> StateT [Char] Maybe p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x
            ((p
x, [Char]
""   ):[(p, [Char])]
_) -> [Char] -> StateT [Char] Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put [Char]
"" StateT [Char] Maybe () -> p -> StateT [Char] Maybe p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x
            [(p, [Char])]
_              -> Maybe p -> StateT [Char] Maybe p
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe p -> StateT [Char] Maybe p)
-> Maybe p -> StateT [Char] Maybe p
forall a b. (a -> b) -> a -> b
$ Flag p -> Maybe p
forall p. Flag p -> Maybe p
_flag_default Flag p
flag
    InputArgs ([Char]
arg1:[[Char]]
argR) -> case [Char] -> InpParseString () -> Maybe ((), [Char])
forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString [Char]
arg1 InpParseString ()
parser of
      Just ((), [Char]
"") -> case [[Char]]
argR of
        []          -> Maybe (p, Input)
mdef
        ([Char]
arg2:[[Char]]
rest) -> ([Char] -> Maybe p
forall a. Read a => [Char] -> Maybe a
Text.Read.readMaybe [Char]
arg2 Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p
x -> (p
x, [[Char]] -> Input
InputArgs [[Char]]
rest)) Maybe (p, Input) -> Maybe (p, Input) -> Maybe (p, Input)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (p, Input)
mdef
        where mdef :: Maybe (p, Input)
mdef = Flag p -> Maybe p
forall p. Flag p -> Maybe p
_flag_default Flag p
flag Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p
p -> (p
p, [[Char]] -> Input
InputArgs [[Char]]
argR)
      Just ((), [Char]
remainingStr) ->
        [Char] -> Maybe p
forall a. Read a => [Char] -> Maybe a
Text.Read.readMaybe [Char]
remainingStr Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \p
x -> (p
x, [[Char]] -> Input
InputArgs [[Char]]
argR)
      Maybe ((), [Char])
Nothing -> Maybe (p, Input)
forall a. Maybe a
Nothing
     where
      parser :: InpParseString ()
      parser :: InpParseString ()
parser = do
        [InpParseString ()] -> InpParseString ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Data.Foldable.msum ([InpParseString ()] -> InpParseString ())
-> [InpParseString ()] -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ [Either [Char] [Char]]
allStrs [Either [Char] [Char]]
-> (Either [Char] [Char] -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption ([Char] -> InpParseString ()
pExpect [Char]
"=")
          Right [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> InpParseString ()
pExpect [Char]
"=" InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InpParseString ()
pExpectEof)
    InputArgs [[Char]]
_ -> Maybe (p, Input)
forall a. Maybe a
Nothing

-- | One-argument flag where the argument can be an arbitrary string.
addFlagStringParam
  :: forall f out . (Applicative f) => String -- ^ short flag chars, i.e. "v" for -v
     -> [String] -- ^ list of long names, i.e. ["verbose"]
     -> String -- ^ param name
     -> Flag String -- ^ properties
     -> CmdParser f out String
addFlagStringParam :: forall (f :: * -> *) out.
Applicative f =>
[Char]
-> [[Char]] -> [Char] -> Flag [Char] -> CmdParser f out [Char]
addFlagStringParam [Char]
shorts [[Char]]
longs [Char]
name Flag [Char]
flag =
  PartDesc
-> (Input -> Maybe ([Char], Input))
-> ([Char] -> f ())
-> CmdParser f out [Char]
forall p (f :: * -> *) out.
Typeable p =>
PartDesc
-> (Input -> Maybe (p, Input)) -> (p -> f ()) -> CmdParser f out p
addCmdPartInpA (Flag [Char] -> PartDesc -> PartDesc
forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag [Char]
flag PartDesc
desc) Input -> Maybe ([Char], Input)
parseF (\[Char]
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
 where
  allStrs :: [Either [Char] [Char]]
allStrs =
    [ [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c] | Char
c <- [Char]
shorts ] [Either [Char] [Char]]
-> [Either [Char] [Char]] -> [Either [Char] [Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
l | [Char]
l <- [[Char]]
longs ]
  desc :: PartDesc
desc = ((PartDesc -> PartDesc)
-> (Doc -> PartDesc -> PartDesc)
-> Maybe Doc
-> PartDesc
-> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id Doc -> PartDesc -> PartDesc
PartWithHelp (Maybe Doc -> PartDesc -> PartDesc)
-> Maybe Doc -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ Flag [Char] -> Maybe Doc
forall p. Flag p -> Maybe Doc
_flag_help Flag [Char]
flag) (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ [PartDesc] -> PartDesc
PartSeq [PartDesc
desc1, PartDesc
desc2]
  desc1 :: PartDesc
  desc1 :: PartDesc
desc1 = [PartDesc] -> PartDesc
PartAlts ([PartDesc] -> PartDesc) -> [PartDesc] -> PartDesc
forall a b. (a -> b) -> a -> b
$ [Char] -> PartDesc
PartLiteral ([Char] -> PartDesc)
-> (Either [Char] [Char] -> [Char])
-> Either [Char] [Char]
-> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char])
-> ([Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Char]
forall a. a -> a
id [Char] -> [Char]
forall a. a -> a
id (Either [Char] [Char] -> PartDesc)
-> [Either [Char] [Char]] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either [Char] [Char]]
allStrs
  desc2 :: PartDesc
desc2 = [Char] -> PartDesc
PartVariable [Char]
name
  parseF :: Input -> Maybe (String, Input)
  parseF :: Input -> Maybe ([Char], Input)
parseF Input
inp = case Input
inp of
    InputString [Char]
str ->
      Maybe ([Char], Input)
-> (([Char], [Char]) -> Maybe ([Char], Input))
-> Maybe ([Char], [Char])
-> Maybe ([Char], Input)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Flag [Char] -> Maybe [Char]
forall p. Flag p -> Maybe p
_flag_default Flag [Char]
flag Maybe [Char]
-> ([Char] -> ([Char], Input)) -> Maybe ([Char], Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Char]
x -> ([Char]
x, Input
inp)) (([Char], Input) -> Maybe ([Char], Input)
forall a. a -> Maybe a
Just (([Char], Input) -> Maybe ([Char], Input))
-> (([Char], [Char]) -> ([Char], Input))
-> ([Char], [Char])
-> Maybe ([Char], Input)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Input) -> ([Char], [Char]) -> ([Char], Input)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Char] -> Input
InputString)
        (Maybe ([Char], [Char]) -> Maybe ([Char], Input))
-> Maybe ([Char], [Char]) -> Maybe ([Char], Input)
forall a b. (a -> b) -> a -> b
$ Maybe ([Char], [Char])
parseResult
     where
      parseResult :: Maybe ([Char], [Char])
parseResult = [Char] -> InpParseString [Char] -> Maybe ([Char], [Char])
forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
str) (InpParseString [Char] -> Maybe ([Char], [Char]))
-> InpParseString [Char] -> Maybe ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ do
        [InpParseString ()] -> InpParseString ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Data.Foldable.msum ([InpParseString ()] -> InpParseString ())
-> [InpParseString ()] -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ [Either [Char] [Char]]
allStrs [Either [Char] [Char]]
-> (Either [Char] [Char] -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption ([Char] -> InpParseString ()
pExpect [Char]
" " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> InpParseString ()
pExpect [Char]
"=")
          Right [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> InpParseString ()
pExpect [Char]
" " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> InpParseString ()
pExpect [Char]
"=")
        StateT [Char] Maybe [Char] -> InpParseString [Char]
forall a. StateT [Char] Maybe a -> InpParseString a
InpParseString (StateT [Char] Maybe [Char] -> InpParseString [Char])
-> StateT [Char] Maybe [Char] -> InpParseString [Char]
forall a b. (a -> b) -> a -> b
$ do
          [Char]
i <- StateT [Char] Maybe [Char]
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
          let ([Char]
x, [Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Char.isSpace ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
i
          [Char] -> StateT [Char] Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put [Char]
rest
          [Char] -> StateT [Char] Maybe [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
x
    InputArgs ([Char]
arg1:[[Char]]
argR) -> case [Char] -> InpParseString () -> Maybe ((), [Char])
forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString [Char]
arg1 InpParseString ()
parser of
      Just ((), [Char]
"") -> case [[Char]]
argR of
        []       -> Maybe ([Char], Input)
forall a. Maybe a
Nothing
        ([Char]
x:[[Char]]
rest) -> ([Char], Input) -> Maybe ([Char], Input)
forall a. a -> Maybe a
Just ([Char]
x, [[Char]] -> Input
InputArgs [[Char]]
rest)
      Just ((), [Char]
remainingStr) -> ([Char], Input) -> Maybe ([Char], Input)
forall a. a -> Maybe a
Just ([Char]
remainingStr, [[Char]] -> Input
InputArgs [[Char]]
argR)
      Maybe ((), [Char])
Nothing                 -> Flag [Char] -> Maybe [Char]
forall p. Flag p -> Maybe p
_flag_default Flag [Char]
flag Maybe [Char]
-> ([Char] -> ([Char], Input)) -> Maybe ([Char], Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Char]
d -> ([Char]
d, Input
inp)
     where
      parser :: InpParseString ()
      parser :: InpParseString ()
parser = do
        [InpParseString ()] -> InpParseString ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Data.Foldable.msum ([InpParseString ()] -> InpParseString ())
-> [InpParseString ()] -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ [Either [Char] [Char]]
allStrs [Either [Char] [Char]]
-> (Either [Char] [Char] -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption ([Char] -> InpParseString ()
pExpect [Char]
"=")
          Right [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> InpParseString ()
pExpect [Char]
"=" InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InpParseString ()
pExpectEof)
    InputArgs [[Char]]
_ -> Flag [Char] -> Maybe [Char]
forall p. Flag p -> Maybe p
_flag_default Flag [Char]
flag Maybe [Char]
-> ([Char] -> ([Char], Input)) -> Maybe ([Char], Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Char]
d -> ([Char]
d, Input
inp)

-- | One-argument flag where the argument can be an arbitrary string.
-- This version can accumulate multiple values by using the same flag with
-- different arguments multiple times.
--
-- E.g. "--foo abc --foo def" yields ["abc", "def"].
addFlagStringParams
  :: forall f out
   . (Applicative f)
  => String -- ^ short flag chars, i.e. "v" for -v
  -> [String] -- ^ list of long names, i.e. ["verbose"]
  -> String -- ^ param name
  -> Flag Void -- ^ properties
  -> CmdParser f out [String]
addFlagStringParams :: forall (f :: * -> *) out.
Applicative f =>
[Char]
-> [[Char]] -> [Char] -> Flag Void -> CmdParser f out [[Char]]
addFlagStringParams [Char]
shorts [[Char]]
longs [Char]
name Flag Void
flag
  = [Char]
-> [[Char]]
-> [Char]
-> Flag Void
-> ([Char] -> f ())
-> CmdParser f out [[Char]]
forall (f :: * -> *) out.
[Char]
-> [[Char]]
-> [Char]
-> Flag Void
-> ([Char] -> f ())
-> CmdParser f out [[Char]]
addFlagStringParamsAll [Char]
shorts [[Char]]
longs [Char]
name Flag Void
flag (\[Char]
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- TODO: this implementation is wrong, because it uses addCmdPartManyInpA
--       while this really is no Many.
-- -- | Applicative-enabled version of 'addFlagStringParam'
-- addFlagStringParamA
--   :: forall f out
--   .  String -- ^ short flag chars, i.e. "v" for -v
--   -> [String] -- ^ list of long names, i.e. ["verbose"]
--   -> String -- ^ param name
--   -> Flag Void -- ^ properties
--   -> (String -> f ()) -- ^ action to execute when ths param matches
--   -> CmdParser f out ()
-- addFlagStringParamA shorts longs name flag act
--   = void $ addFlagStringParamsAll shorts longs name flag act

addFlagStringParamsAll
  :: forall f out . String
     -> [String]
     -> String
     -> Flag Void -- we forbid the default because it has bad interaction
               -- with the eat-anything behaviour of the string parser.
     -> (String -> f ())
     -> CmdParser f out [String]
addFlagStringParamsAll :: forall (f :: * -> *) out.
[Char]
-> [[Char]]
-> [Char]
-> Flag Void
-> ([Char] -> f ())
-> CmdParser f out [[Char]]
addFlagStringParamsAll [Char]
shorts [[Char]]
longs [Char]
name Flag Void
flag [Char] -> f ()
act = ManyUpperBound
-> PartDesc
-> (Input -> Maybe ([Char], Input))
-> ([Char] -> f ())
-> CmdParser f out [[Char]]
forall p (f :: * -> *) out.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> CmdParser f out [p]
addCmdPartManyInpA
  ManyUpperBound
ManyUpperBoundN
  (Flag Void -> PartDesc -> PartDesc
forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag Void
flag PartDesc
desc)
  Input -> Maybe ([Char], Input)
parseF
  [Char] -> f ()
act
 where
  allStrs :: [Either [Char] [Char]]
allStrs =
    [ [Char] -> Either [Char] [Char]
forall a b. a -> Either a b
Left ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
c] | Char
c <- [Char]
shorts ] [Either [Char] [Char]]
-> [Either [Char] [Char]] -> [Either [Char] [Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char] -> Either [Char] [Char]
forall a b. b -> Either a b
Right ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
l | [Char]
l <- [[Char]]
longs ]
  desc :: PartDesc
desc = ((PartDesc -> PartDesc)
-> (Doc -> PartDesc -> PartDesc)
-> Maybe Doc
-> PartDesc
-> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id Doc -> PartDesc -> PartDesc
PartWithHelp (Maybe Doc -> PartDesc -> PartDesc)
-> Maybe Doc -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ Flag Void -> Maybe Doc
forall p. Flag p -> Maybe Doc
_flag_help Flag Void
flag) (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ [PartDesc] -> PartDesc
PartSeq [PartDesc
desc1, PartDesc
desc2]
  desc1 :: PartDesc
  desc1 :: PartDesc
desc1 = [PartDesc] -> PartDesc
PartAlts ([PartDesc] -> PartDesc) -> [PartDesc] -> PartDesc
forall a b. (a -> b) -> a -> b
$ [Char] -> PartDesc
PartLiteral ([Char] -> PartDesc)
-> (Either [Char] [Char] -> [Char])
-> Either [Char] [Char]
-> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char])
-> ([Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Char]
forall a. a -> a
id [Char] -> [Char]
forall a. a -> a
id (Either [Char] [Char] -> PartDesc)
-> [Either [Char] [Char]] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either [Char] [Char]]
allStrs
  desc2 :: PartDesc
desc2 =
    ((PartDesc -> PartDesc)
-> (Void -> PartDesc -> PartDesc)
-> Maybe Void
-> PartDesc
-> PartDesc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PartDesc -> PartDesc
forall a. a -> a
id ([Char] -> PartDesc -> PartDesc
PartDefault ([Char] -> PartDesc -> PartDesc)
-> (Void -> [Char]) -> Void -> PartDesc -> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Void -> [Char]
forall a. Show a => a -> [Char]
show) (Maybe Void -> PartDesc -> PartDesc)
-> Maybe Void -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ Flag Void -> Maybe Void
forall p. Flag p -> Maybe p
_flag_default Flag Void
flag) (PartDesc -> PartDesc) -> PartDesc -> PartDesc
forall a b. (a -> b) -> a -> b
$ [Char] -> PartDesc
PartVariable [Char]
name
  parseF :: Input -> Maybe (String, Input)
  parseF :: Input -> Maybe ([Char], Input)
parseF Input
inp = case Input
inp of
    InputString [Char]
str -> (([Char], [Char]) -> ([Char], Input))
-> Maybe ([Char], [Char]) -> Maybe ([Char], Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Char] -> Input) -> ([Char], [Char]) -> ([Char], Input)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Char] -> Input
InputString) (Maybe ([Char], [Char]) -> Maybe ([Char], Input))
-> Maybe ([Char], [Char]) -> Maybe ([Char], Input)
forall a b. (a -> b) -> a -> b
$ Maybe ([Char], [Char])
parseResult
     where
      parseResult :: Maybe ([Char], [Char])
parseResult = [Char] -> InpParseString [Char] -> Maybe ([Char], [Char])
forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
str) (InpParseString [Char] -> Maybe ([Char], [Char]))
-> InpParseString [Char] -> Maybe ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ do
        [InpParseString ()] -> InpParseString ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Data.Foldable.msum ([InpParseString ()] -> InpParseString ())
-> [InpParseString ()] -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ [Either [Char] [Char]]
allStrs [Either [Char] [Char]]
-> (Either [Char] [Char] -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption ([Char] -> InpParseString ()
pExpect [Char]
" " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> InpParseString ()
pExpect [Char]
"=")
          Right [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> InpParseString ()
pExpect [Char]
" " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> InpParseString ()
pExpect [Char]
"=")
        StateT [Char] Maybe [Char] -> InpParseString [Char]
forall a. StateT [Char] Maybe a -> InpParseString a
InpParseString (StateT [Char] Maybe [Char] -> InpParseString [Char])
-> StateT [Char] Maybe [Char] -> InpParseString [Char]
forall a b. (a -> b) -> a -> b
$ do
          [Char]
i <- StateT [Char] Maybe [Char]
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
          let ([Char]
x, [Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Char.isSpace ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace [Char]
i
          [Char] -> StateT [Char] Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put [Char]
rest
          [Char] -> StateT [Char] Maybe [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
x
    InputArgs ([Char]
arg1:[[Char]]
argR) -> case [Char] -> InpParseString () -> Maybe ((), [Char])
forall a. [Char] -> InpParseString a -> Maybe (a, [Char])
runInpParseString [Char]
arg1 InpParseString ()
parser of
      Just ((), [Char]
""          ) -> case [[Char]]
argR of
        []       -> Maybe ([Char], Input)
forall a. Maybe a
Nothing
        ([Char]
x:[[Char]]
rest) -> ([Char], Input) -> Maybe ([Char], Input)
forall a. a -> Maybe a
Just ([Char]
x, [[Char]] -> Input
InputArgs [[Char]]
rest)
      Just ((), [Char]
remainingStr) -> ([Char], Input) -> Maybe ([Char], Input)
forall a. a -> Maybe a
Just ([Char]
remainingStr, [[Char]] -> Input
InputArgs [[Char]]
argR)
      Maybe ((), [Char])
Nothing                 -> Maybe ([Char], Input)
forall a. Maybe a
Nothing
     where
      parser :: InpParseString ()
      parser :: InpParseString ()
parser = do
        [InpParseString ()] -> InpParseString ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
Data.Foldable.msum ([InpParseString ()] -> InpParseString ())
-> [InpParseString ()] -> InpParseString ()
forall a b. (a -> b) -> a -> b
$ [Either [Char] [Char]]
allStrs [Either [Char] [Char]]
-> (Either [Char] [Char] -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption ([Char] -> InpParseString ()
pExpect [Char]
"=")
          Right [Char]
s -> [Char] -> InpParseString ()
pExpect [Char]
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> InpParseString ()
pExpect [Char]
"=" InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InpParseString ()
pExpectEof)
    InputArgs [[Char]]
_ -> Maybe ([Char], Input)
forall a. Maybe a
Nothing