{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ViewPatterns #-}
module UI.Butcher.Monadic.Flag
( Flag(..)
, flagHelp
, flagHelpStr
, flagDefault
, flagHidden
, addSimpleBoolFlag
, addSimpleCountFlag
, addSimpleFlagA
, addFlagReadParam
, addFlagReadParams
, addFlagStringParam
, addFlagStringParams
)
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 )
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
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 ()
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
(<>)
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 }
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 }
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 }
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
addSimpleBoolFlag
:: Applicative f
=> String
-> [String]
-> Flag Void
-> 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 ())
addSimpleFlagA
:: String
-> [String]
-> Flag Void
-> f ()
-> 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
)
addSimpleCountFlag :: Applicative f
=> String
-> [String]
-> Flag Void
-> 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
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
)
addFlagReadParam
:: forall f p out
. (Applicative f, Typeable p, Text.Read.Read p, Show p)
=> String
-> [String]
-> String
-> Flag p
-> 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)
addFlagReadParams
:: forall f p out
. (Applicative f, Typeable p, Text.Read.Read p, Show p)
=> String
-> [String]
-> String
-> Flag p
-> 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 ())
addFlagReadParamsAll
:: forall f p out . (Typeable p, Text.Read.Read p, Show p) => String
-> [String]
-> String
-> Flag p
-> (p -> f ())
-> 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
addFlagStringParam
:: forall f out . (Applicative f) => String
-> [String]
-> String
-> Flag String
-> 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)
addFlagStringParams
:: forall f out
. (Applicative f)
=> String
-> [String]
-> String
-> Flag Void
-> 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 ())
addFlagStringParamsAll
:: forall f out . String
-> [String]
-> String
-> Flag Void
-> (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