{-# 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 (a -> InpParseString b -> InpParseString a
(a -> b) -> InpParseString a -> InpParseString b
(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
<$ :: a -> InpParseString b -> InpParseString a
$c<$ :: forall a b. a -> InpParseString b -> InpParseString a
fmap :: (a -> b) -> InpParseString a -> InpParseString b
$cfmap :: forall a b. (a -> b) -> InpParseString a -> InpParseString b
Functor, Functor InpParseString
a -> InpParseString a
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
InpParseString a -> InpParseString b -> InpParseString b
InpParseString a -> InpParseString b -> InpParseString a
InpParseString (a -> b) -> InpParseString a -> InpParseString b
(a -> b -> c)
-> InpParseString a -> InpParseString b -> InpParseString c
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
<* :: InpParseString a -> InpParseString b -> InpParseString a
$c<* :: forall a b.
InpParseString a -> InpParseString b -> InpParseString a
*> :: InpParseString a -> InpParseString b -> InpParseString b
$c*> :: forall a b.
InpParseString a -> InpParseString b -> InpParseString b
liftA2 :: (a -> b -> c)
-> InpParseString a -> InpParseString b -> InpParseString c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> InpParseString a -> InpParseString b -> InpParseString c
<*> :: InpParseString (a -> b) -> InpParseString a -> InpParseString b
$c<*> :: forall a b.
InpParseString (a -> b) -> InpParseString a -> InpParseString b
pure :: a -> InpParseString a
$cpure :: forall a. a -> InpParseString a
$cp1Applicative :: Functor InpParseString
Applicative, Applicative InpParseString
a -> InpParseString a
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
InpParseString a -> (a -> InpParseString b) -> InpParseString b
InpParseString a -> InpParseString b -> InpParseString b
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 :: a -> InpParseString a
$creturn :: forall a. a -> InpParseString a
>> :: InpParseString a -> InpParseString b -> InpParseString b
$c>> :: forall a b.
InpParseString a -> InpParseString b -> InpParseString b
>>= :: InpParseString a -> (a -> InpParseString b) -> InpParseString b
$c>>= :: forall a b.
InpParseString a -> (a -> InpParseString b) -> InpParseString b
$cp1Monad :: Applicative InpParseString
Monad, State.Class.MonadState String, Applicative InpParseString
InpParseString a
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
InpParseString a -> InpParseString a -> InpParseString a
InpParseString a -> InpParseString [a]
InpParseString a -> InpParseString [a]
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 :: InpParseString a -> InpParseString [a]
$cmany :: forall a. InpParseString a -> InpParseString [a]
some :: InpParseString a -> InpParseString [a]
$csome :: forall a. InpParseString a -> InpParseString [a]
<|> :: InpParseString a -> InpParseString a -> InpParseString a
$c<|> :: forall a. InpParseString a -> InpParseString a -> InpParseString a
empty :: InpParseString a
$cempty :: forall a. InpParseString a
$cp1Alternative :: Applicative InpParseString
Alternative, Monad InpParseString
Alternative InpParseString
InpParseString a
(Alternative InpParseString, Monad InpParseString) =>
(forall a. InpParseString a)
-> (forall a.
    InpParseString a -> InpParseString a -> InpParseString a)
-> MonadPlus InpParseString
InpParseString a -> InpParseString a -> InpParseString a
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 :: InpParseString a -> InpParseString a -> InpParseString a
$cmplus :: forall a. InpParseString a -> InpParseString a -> InpParseString a
mzero :: InpParseString a
$cmzero :: forall a. InpParseString a
$cp2MonadPlus :: Monad InpParseString
$cp1MonadPlus :: Alternative InpParseString
MonadPlus)

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

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

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

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

pOption :: InpParseString () -> InpParseString ()
pOption :: InpParseString () -> InpParseString ()
pOption m :: 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
  { Flag p -> Maybe Doc
_flag_help       :: Maybe PP.Doc
  , Flag p -> Maybe p
_flag_default    :: Maybe p
  , Flag p -> Visibility
_flag_visibility :: Visibility
  }

appendFlag :: Flag p -> Flag p -> Flag p
appendFlag :: Flag p -> Flag p -> Flag p
appendFlag (Flag a1 :: Maybe Doc
a1 b1 :: Maybe p
b1 c1 :: Visibility
c1) (Flag a2 :: Maybe Doc
a2 b2 :: Maybe p
b2 c2 :: 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 Visible Visible = Visibility
Visible
  appVis _       _       = 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 :: Doc -> Flag p
flagHelp h :: 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 :: String -> Flag p
flagHelpStr s :: String
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
$ (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
PP.text ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [String]
List.words String
s }

-- | Create a 'Flag' with just a default value.
flagDefault :: p -> Flag p
flagDefault :: p -> Flag p
flagDefault d :: 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 :: Flag p
flagHidden = Flag p
forall a. Monoid a => a
mempty { _flag_visibility :: Visibility
_flag_visibility = Visibility
Hidden }

wrapHidden :: Flag p -> PartDesc -> PartDesc
wrapHidden :: Flag p -> PartDesc -> PartDesc
wrapHidden f :: Flag p
f = case Flag p -> Visibility
forall p. Flag p -> Visibility
_flag_visibility Flag p
f of
  Visible -> PartDesc -> PartDesc
forall a. a -> a
id
  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 :: String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag shorts :: String
shorts longs :: [String]
longs flag :: Flag Void
flag =
  String -> [String] -> Flag Void -> f () -> CmdParser f out Bool
forall (f :: * -> *) out.
String -> [String] -> Flag Void -> f () -> CmdParser f out Bool
addSimpleBoolFlagAll String
shorts [String]
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 :: String -> [String] -> Flag Void -> f () -> CmdParser f out ()
addSimpleFlagA shorts :: String
shorts longs :: [String]
longs flag :: Flag Void
flag act :: f ()
act
  = Free (CmdParserF f out) Bool -> CmdParser f out ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Free (CmdParserF f out) Bool -> CmdParser f out ())
-> Free (CmdParserF f out) Bool -> CmdParser f out ()
forall a b. (a -> b) -> a -> b
$ String
-> [String] -> Flag Void -> f () -> Free (CmdParserF f out) Bool
forall (f :: * -> *) out.
String -> [String] -> Flag Void -> f () -> CmdParser f out Bool
addSimpleBoolFlagAll String
shorts [String]
longs Flag Void
flag f ()
act

addSimpleBoolFlagAll
  :: String
  -> [String]
  -> Flag Void
  -> f ()
  -> CmdParser f out Bool
addSimpleBoolFlagAll :: String -> [String] -> Flag Void -> f () -> CmdParser f out Bool
addSimpleBoolFlagAll shorts :: String
shorts longs :: [String]
longs flag :: Flag Void
flag a :: f ()
a = ([()] -> Bool)
-> Free (CmdParserF f out) [()] -> CmdParser 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) [()] -> CmdParser f out Bool)
-> Free (CmdParserF f out) [()] -> CmdParser f out Bool
forall a b. (a -> b) -> a -> b
$ ManyUpperBound
-> PartDesc
-> (String -> Maybe ((), String))
-> (() -> f ())
-> Free (CmdParserF f out) [()]
forall p (f :: * -> *) out.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (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) String -> Maybe ((), String)
parseF (\() -> f ()
a)
 where
  allStrs :: [String]
allStrs = (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c :: Char
c -> "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]) String
shorts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\s :: String
s -> "--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) [String]
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
$   String -> PartDesc
PartLiteral
      (String -> PartDesc) -> [String] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
allStrs
  parseF :: String -> Maybe ((), String)
  parseF :: String -> Maybe ((), String)
parseF ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace -> String
str) =
    ((String -> Maybe ((), String)) -> [String] -> Maybe ((), String)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust (\s :: String
s -> [ ((), Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) String
str) | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str ]) [String]
allStrs)
      Maybe ((), String) -> Maybe ((), String) -> Maybe ((), String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( (String -> Maybe ((), String)) -> [String] -> Maybe ((), String)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust
            ( \s :: String
s ->
              [ ((), Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) String
str) | (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " ") String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str ]
            )
            [String]
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 :: String -> [String] -> Flag Void -> CmdParser f out Int
addSimpleCountFlag shorts :: String
shorts longs :: [String]
longs flag :: Flag Void
flag = ([()] -> Int)
-> Free (CmdParserF f out) [()] -> CmdParser 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) [()] -> CmdParser f out Int)
-> Free (CmdParserF f out) [()] -> CmdParser f out Int
forall a b. (a -> b) -> a -> b
$ ManyUpperBound
-> PartDesc
-> (String -> Maybe ((), String))
-> Free (CmdParserF f out) [()]
forall (f :: * -> *) p out.
(Applicative f, Typeable p) =>
ManyUpperBound
-> PartDesc -> (String -> Maybe (p, String)) -> CmdParser f out [p]
addCmdPartMany ManyUpperBound
ManyUpperBoundN (Flag Void -> PartDesc -> PartDesc
forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag Void
flag PartDesc
desc) String -> Maybe ((), String)
parseF
 where
    -- we _could_ allow this to parse repeated short flags, like "-vvv"
    -- (meaning "-v -v -v") correctly.
  allStrs :: [String]
allStrs = (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c :: Char
c -> "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]) String
shorts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\s :: String
s -> "--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) [String]
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
$   String -> PartDesc
PartLiteral
      (String -> PartDesc) -> [String] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
allStrs
  parseF :: String -> Maybe ((), String)
  parseF :: String -> Maybe ((), String)
parseF ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace -> String
str) =
    ((String -> Maybe ((), String)) -> [String] -> Maybe ((), String)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust (\s :: String
s -> [ ((), Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) String
str) | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str ]) [String]
allStrs)
      Maybe ((), String) -> Maybe ((), String) -> Maybe ((), String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( (String -> Maybe ((), String)) -> [String] -> Maybe ((), String)
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust
            ( \s :: String
s ->
              [ ((), Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) String
str) | (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " ") String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str ]
            )
            [String]
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 :: String -> [String] -> String -> Flag p -> CmdParser f out p
addFlagReadParam shorts :: String
shorts longs :: [String]
longs name :: String
name flag :: 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 (\_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
 where
  allStrs :: [Either String String]
allStrs =
    [ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] | Char
c <- String
shorts ] [Either String String]
-> [Either String String] -> [Either String String]
forall a. [a] -> [a] -> [a]
++ [ String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l | String
l <- [String]
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 (String -> PartDesc -> PartDesc
PartDefault (String -> PartDesc -> PartDesc)
-> (p -> String) -> p -> PartDesc -> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> String
forall a. Show a => a -> String
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
$ String -> PartDesc
PartLiteral (String -> PartDesc)
-> (Either String String -> String)
-> Either String String
-> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id (Either String String -> PartDesc)
-> [Either String String] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String String]
allStrs
  desc2 :: PartDesc
desc2 = String -> PartDesc
PartVariable String
name
  parseF :: Input -> Maybe (p, Input)
  parseF :: Input -> Maybe (p, Input)
parseF inp :: Input
inp = case Input
inp of
    InputString str :: String
str ->
      Maybe (p, Input)
-> ((p, String) -> Maybe (p, Input))
-> Maybe (p, String)
-> 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
<&> \x :: p
x -> (p
x, Input
inp)) ((p, Input) -> Maybe (p, Input)
forall a. a -> Maybe a
Just ((p, Input) -> Maybe (p, Input))
-> ((p, String) -> (p, Input)) -> (p, String) -> Maybe (p, Input)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Input) -> (p, String) -> (p, Input)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> Input
InputString)
        (Maybe (p, String) -> Maybe (p, Input))
-> Maybe (p, String) -> Maybe (p, Input)
forall a b. (a -> b) -> a -> b
$ Maybe (p, String)
parseResult
     where
      parseResult :: Maybe (p, String)
parseResult = String -> InpParseString p -> Maybe (p, String)
forall a. String -> InpParseString a -> Maybe (a, String)
runInpParseString ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
str) (InpParseString p -> Maybe (p, String))
-> InpParseString p -> Maybe (p, String)
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 String String]
allStrs [Either String String]
-> (Either String String -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption (String -> InpParseString ()
pExpect " " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> InpParseString ()
pExpect "=")
          Right s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> InpParseString ()
pExpect " " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> InpParseString ()
pExpect "=")
        StateT String Maybe p -> InpParseString p
forall a. StateT String Maybe a -> InpParseString a
InpParseString (StateT String Maybe p -> InpParseString p)
-> StateT String Maybe p -> InpParseString p
forall a b. (a -> b) -> a -> b
$ do
          String
i <- StateT String Maybe String
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
          case ReadS p
forall a. Read a => ReadS a
Text.Read.reads String
i of
            ((x :: p
x, ' ':r :: String
r):_) -> String -> StateT String Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
r) StateT String Maybe () -> p -> StateT String Maybe p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x
            ((x :: p
x, ""   ):_) -> String -> StateT String Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put "" StateT String Maybe () -> p -> StateT String Maybe p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x
            _              -> StateT String Maybe p
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    InputArgs (arg1 :: String
arg1:argR :: [String]
argR) -> case String -> InpParseString () -> Maybe ((), String)
forall a. String -> InpParseString a -> Maybe (a, String)
runInpParseString String
arg1 InpParseString ()
parser of
      Just ((), "") -> case [String]
argR of
        []          -> Maybe (p, Input)
forall a. Maybe a
Nothing
        (arg2 :: String
arg2:rest :: [String]
rest) -> String -> Maybe p
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
arg2 Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \x :: p
x -> (p
x, [String] -> Input
InputArgs [String]
rest)
      Just ((), remainingStr :: String
remainingStr) ->
        String -> Maybe p
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
remainingStr Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \x :: p
x -> (p
x, [String] -> Input
InputArgs [String]
argR)
      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
<&> \d :: 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 String String]
allStrs [Either String String]
-> (Either String String -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption (String -> InpParseString ()
pExpect "=")
          Right s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> InpParseString ()
pExpect "=" InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InpParseString ()
pExpectEof)
    InputArgs _ -> 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
<&> \d :: 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 :: String -> [String] -> String -> Flag p -> CmdParser f out [p]
addFlagReadParams shorts :: String
shorts longs :: [String]
longs name :: String
name flag :: Flag p
flag
  = String
-> [String]
-> String
-> Flag p
-> (p -> f ())
-> CmdParser f out [p]
forall (f :: * -> *) p out.
(Typeable p, Read p, Show p) =>
String
-> [String]
-> String
-> Flag p
-> (p -> f ())
-> CmdParser f out [p]
addFlagReadParamsAll String
shorts [String]
longs String
name Flag p
flag (\_ -> () -> 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 :: String
-> [String]
-> String
-> Flag p
-> (p -> f ())
-> CmdParser f out [p]
addFlagReadParamsAll shorts :: String
shorts longs :: [String]
longs name :: String
name flag :: Flag p
flag act :: 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 String String]
allStrs =
    [ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] | Char
c <- String
shorts ] [Either String String]
-> [Either String String] -> [Either String String]
forall a. [a] -> [a] -> [a]
++ [ String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l | String
l <- [String]
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
$ String -> PartDesc
PartLiteral (String -> PartDesc)
-> (Either String String -> String)
-> Either String String
-> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id (Either String String -> PartDesc)
-> [Either String String] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String String]
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 (String -> PartDesc -> PartDesc
PartDefault (String -> PartDesc -> PartDesc)
-> (p -> String) -> p -> PartDesc -> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> String
forall a. Show a => a -> String
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
$ String -> PartDesc
PartVariable String
name
  parseF :: Input -> Maybe (p, Input)
  parseF :: Input -> Maybe (p, Input)
parseF inp :: Input
inp = case Input
inp of
    InputString str :: String
str ->
      ((p, String) -> (p, Input))
-> Maybe (p, String) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Input) -> (p, String) -> (p, Input)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> Input
InputString) (Maybe (p, String) -> Maybe (p, Input))
-> Maybe (p, String) -> Maybe (p, Input)
forall a b. (a -> b) -> a -> b
$ Maybe (p, String)
parseResult
     where
      parseResult :: Maybe (p, String)
parseResult = String -> InpParseString p -> Maybe (p, String)
forall a. String -> InpParseString a -> Maybe (a, String)
runInpParseString ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
str) (InpParseString p -> Maybe (p, String))
-> InpParseString p -> Maybe (p, String)
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 String String]
allStrs [Either String String]
-> (Either String String -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption (String -> InpParseString ()
pExpect " " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> InpParseString ()
pExpect "=")
          Right s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> InpParseString ()
pExpect " " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> InpParseString ()
pExpect "=")
        StateT String Maybe p -> InpParseString p
forall a. StateT String Maybe a -> InpParseString a
InpParseString (StateT String Maybe p -> InpParseString p)
-> StateT String Maybe p -> InpParseString p
forall a b. (a -> b) -> a -> b
$ do
          String
i <- StateT String Maybe String
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
          case ReadS p
forall a. Read a => ReadS a
Text.Read.reads String
i of
            ((x :: p
x, ' ':r :: String
r):_) -> String -> StateT String Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
r) StateT String Maybe () -> p -> StateT String Maybe p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x
            ((x :: p
x, ""   ):_) -> String -> StateT String Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put "" StateT String Maybe () -> p -> StateT String Maybe p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
x
            _              -> Maybe p -> StateT String Maybe p
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe p -> StateT String Maybe p)
-> Maybe p -> StateT String 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 (arg1 :: String
arg1:argR :: [String]
argR) -> case String -> InpParseString () -> Maybe ((), String)
forall a. String -> InpParseString a -> Maybe (a, String)
runInpParseString String
arg1 InpParseString ()
parser of
      Just ((), "") -> case [String]
argR of
        []          -> Maybe (p, Input)
mdef
        (arg2 :: String
arg2:rest :: [String]
rest) -> (String -> Maybe p
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
arg2 Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \x :: p
x -> (p
x, [String] -> Input
InputArgs [String]
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
p, [String] -> Input
InputArgs [String]
argR)
      Just ((), remainingStr :: String
remainingStr) ->
        String -> Maybe p
forall a. Read a => String -> Maybe a
Text.Read.readMaybe String
remainingStr Maybe p -> (p -> (p, Input)) -> Maybe (p, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \x :: p
x -> (p
x, [String] -> Input
InputArgs [String]
argR)
      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 String String]
allStrs [Either String String]
-> (Either String String -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption (String -> InpParseString ()
pExpect "=")
          Right s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> InpParseString ()
pExpect "=" InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InpParseString ()
pExpectEof)
    InputArgs _ -> 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 :: String
-> [String] -> String -> Flag String -> CmdParser f out String
addFlagStringParam shorts :: String
shorts longs :: [String]
longs name :: String
name flag :: Flag String
flag =
  PartDesc
-> (Input -> Maybe (String, Input))
-> (String -> f ())
-> CmdParser f out String
forall p (f :: * -> *) out.
Typeable p =>
PartDesc
-> (Input -> Maybe (p, Input)) -> (p -> f ()) -> CmdParser f out p
addCmdPartInpA (Flag String -> PartDesc -> PartDesc
forall p. Flag p -> PartDesc -> PartDesc
wrapHidden Flag String
flag PartDesc
desc) Input -> Maybe (String, Input)
parseF (\_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
 where
  allStrs :: [Either String String]
allStrs =
    [ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] | Char
c <- String
shorts ] [Either String String]
-> [Either String String] -> [Either String String]
forall a. [a] -> [a] -> [a]
++ [ String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l | String
l <- [String]
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 String -> Maybe Doc
forall p. Flag p -> Maybe Doc
_flag_help Flag String
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
$ String -> PartDesc
PartLiteral (String -> PartDesc)
-> (Either String String -> String)
-> Either String String
-> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id (Either String String -> PartDesc)
-> [Either String String] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String String]
allStrs
  desc2 :: PartDesc
desc2 = String -> PartDesc
PartVariable String
name
  parseF :: Input -> Maybe (String, Input)
  parseF :: Input -> Maybe (String, Input)
parseF inp :: Input
inp = case Input
inp of
    InputString str :: String
str ->
      Maybe (String, Input)
-> ((String, String) -> Maybe (String, Input))
-> Maybe (String, String)
-> Maybe (String, Input)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Flag String -> Maybe String
forall p. Flag p -> Maybe p
_flag_default Flag String
flag Maybe String
-> (String -> (String, Input)) -> Maybe (String, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \x :: String
x -> (String
x, Input
inp)) ((String, Input) -> Maybe (String, Input)
forall a. a -> Maybe a
Just ((String, Input) -> Maybe (String, Input))
-> ((String, String) -> (String, Input))
-> (String, String)
-> Maybe (String, Input)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Input) -> (String, String) -> (String, Input)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> Input
InputString)
        (Maybe (String, String) -> Maybe (String, Input))
-> Maybe (String, String) -> Maybe (String, Input)
forall a b. (a -> b) -> a -> b
$ Maybe (String, String)
parseResult
     where
      parseResult :: Maybe (String, String)
parseResult = String -> InpParseString String -> Maybe (String, String)
forall a. String -> InpParseString a -> Maybe (a, String)
runInpParseString ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
str) (InpParseString String -> Maybe (String, String))
-> InpParseString String -> Maybe (String, String)
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 String String]
allStrs [Either String String]
-> (Either String String -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption (String -> InpParseString ()
pExpect " " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> InpParseString ()
pExpect "=")
          Right s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> InpParseString ()
pExpect " " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> InpParseString ()
pExpect "=")
        StateT String Maybe String -> InpParseString String
forall a. StateT String Maybe a -> InpParseString a
InpParseString (StateT String Maybe String -> InpParseString String)
-> StateT String Maybe String -> InpParseString String
forall a b. (a -> b) -> a -> b
$ do
          String
i <- StateT String Maybe String
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
          let (x :: String
x, rest :: String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Char.isSpace (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
i
          String -> StateT String Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put String
rest
          String -> StateT String Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x
    InputArgs (arg1 :: String
arg1:argR :: [String]
argR) -> case String -> InpParseString () -> Maybe ((), String)
forall a. String -> InpParseString a -> Maybe (a, String)
runInpParseString String
arg1 InpParseString ()
parser of
      Just ((), "") -> case [String]
argR of
        []       -> Maybe (String, Input)
forall a. Maybe a
Nothing
        (x :: String
x:rest :: [String]
rest) -> (String, Input) -> Maybe (String, Input)
forall a. a -> Maybe a
Just (String
x, [String] -> Input
InputArgs [String]
rest)
      Just ((), remainingStr :: String
remainingStr) -> (String, Input) -> Maybe (String, Input)
forall a. a -> Maybe a
Just (String
remainingStr, [String] -> Input
InputArgs [String]
argR)
      Nothing                 -> Flag String -> Maybe String
forall p. Flag p -> Maybe p
_flag_default Flag String
flag Maybe String
-> (String -> (String, Input)) -> Maybe (String, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \d :: String
d -> (String
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 String String]
allStrs [Either String String]
-> (Either String String -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption (String -> InpParseString ()
pExpect "=")
          Right s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> InpParseString ()
pExpect "=" InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InpParseString ()
pExpectEof)
    InputArgs _ -> Flag String -> Maybe String
forall p. Flag p -> Maybe p
_flag_default Flag String
flag Maybe String
-> (String -> (String, Input)) -> Maybe (String, Input)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \d :: String
d -> (String
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 :: String
-> [String] -> String -> Flag Void -> CmdParser f out [String]
addFlagStringParams shorts :: String
shorts longs :: [String]
longs name :: String
name flag :: Flag Void
flag
  = String
-> [String]
-> String
-> Flag Void
-> (String -> f ())
-> CmdParser f out [String]
forall (f :: * -> *) out.
String
-> [String]
-> String
-> Flag Void
-> (String -> f ())
-> CmdParser f out [String]
addFlagStringParamsAll String
shorts [String]
longs String
name Flag Void
flag (\_ -> () -> 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 :: String
-> [String]
-> String
-> Flag Void
-> (String -> f ())
-> CmdParser f out [String]
addFlagStringParamsAll shorts :: String
shorts longs :: [String]
longs name :: String
name flag :: Flag Void
flag act :: String -> f ()
act = ManyUpperBound
-> PartDesc
-> (Input -> Maybe (String, Input))
-> (String -> f ())
-> CmdParser f out [String]
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 (String, Input)
parseF
  String -> f ()
act
 where
  allStrs :: [Either String String]
allStrs =
    [ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] | Char
c <- String
shorts ] [Either String String]
-> [Either String String] -> [Either String String]
forall a. [a] -> [a] -> [a]
++ [ String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ "--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l | String
l <- [String]
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
$ String -> PartDesc
PartLiteral (String -> PartDesc)
-> (Either String String -> String)
-> Either String String
-> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id (Either String String -> PartDesc)
-> [Either String String] -> [PartDesc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either String String]
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 (String -> PartDesc -> PartDesc
PartDefault (String -> PartDesc -> PartDesc)
-> (Void -> String) -> Void -> PartDesc -> PartDesc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Void -> String
forall a. Show a => a -> String
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
$ String -> PartDesc
PartVariable String
name
  parseF :: Input -> Maybe (String, Input)
  parseF :: Input -> Maybe (String, Input)
parseF inp :: Input
inp = case Input
inp of
    InputString str :: String
str -> ((String, String) -> (String, Input))
-> Maybe (String, String) -> Maybe (String, Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Input) -> (String, String) -> (String, Input)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> Input
InputString) (Maybe (String, String) -> Maybe (String, Input))
-> Maybe (String, String) -> Maybe (String, Input)
forall a b. (a -> b) -> a -> b
$ Maybe (String, String)
parseResult
     where
      parseResult :: Maybe (String, String)
parseResult = String -> InpParseString String -> Maybe (String, String)
forall a. String -> InpParseString a -> Maybe (a, String)
runInpParseString ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
str) (InpParseString String -> Maybe (String, String))
-> InpParseString String -> Maybe (String, String)
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 String String]
allStrs [Either String String]
-> (Either String String -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption (String -> InpParseString ()
pExpect " " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> InpParseString ()
pExpect "=")
          Right s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> InpParseString ()
pExpect " " InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> InpParseString ()
pExpect "=")
        StateT String Maybe String -> InpParseString String
forall a. StateT String Maybe a -> InpParseString a
InpParseString (StateT String Maybe String -> InpParseString String)
-> StateT String Maybe String -> InpParseString String
forall a b. (a -> b) -> a -> b
$ do
          String
i <- StateT String Maybe String
forall (m :: * -> *) s. Monad m => StateT s m s
StateS.get
          let (x :: String
x, rest :: String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Char.isSpace (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
i
          String -> StateT String Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
StateS.put String
rest
          String -> StateT String Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x
    InputArgs (arg1 :: String
arg1:argR :: [String]
argR) -> case String -> InpParseString () -> Maybe ((), String)
forall a. String -> InpParseString a -> Maybe (a, String)
runInpParseString String
arg1 InpParseString ()
parser of
      Just ((), ""          ) -> case [String]
argR of
        []       -> Maybe (String, Input)
forall a. Maybe a
Nothing
        (x :: String
x:rest :: [String]
rest) -> (String, Input) -> Maybe (String, Input)
forall a. a -> Maybe a
Just (String
x, [String] -> Input
InputArgs [String]
rest)
      Just ((), remainingStr :: String
remainingStr) -> (String, Input) -> Maybe (String, Input)
forall a. a -> Maybe a
Just (String
remainingStr, [String] -> Input
InputArgs [String]
argR)
      Nothing                 -> Maybe (String, 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 String String]
allStrs [Either String String]
-> (Either String String -> InpParseString ())
-> [InpParseString ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left  s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> InpParseString () -> InpParseString ()
pOption (String -> InpParseString ()
pExpect "=")
          Right s :: String
s -> String -> InpParseString ()
pExpect String
s InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> InpParseString ()
pExpect "=" InpParseString () -> InpParseString () -> InpParseString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InpParseString ()
pExpectEof)
    InputArgs _ -> Maybe (String, Input)
forall a. Maybe a
Nothing