{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-deprecated-flags #-}
module WithCli.HasArguments where
import Data.Orphans ()
import Prelude ()
import Prelude.Compat
import Data.Char
import Data.List.Compat
import Data.Proxy
import Data.Traversable
import qualified GHC.Generics as GHC
import Generics.SOP as SOP
import Generics.SOP.GGP as SOP
import System.Console.GetOpt
import Text.Read
import WithCli.Argument
import WithCli.Modifier
import WithCli.Normalize
import WithCli.Parser
import WithCli.Result
parseArgumentResult :: forall a . Argument a => Maybe String -> String -> Result a
parseArgumentResult :: Maybe String -> String -> Result a
parseArgumentResult mMsg :: Maybe String
mMsg s :: String
s = case String -> Maybe a
forall a. Argument a => String -> Maybe a
parseArgument String
s of
Just x :: a
x -> a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Nothing -> String -> Maybe String -> String -> Result a
forall a. String -> Maybe String -> String -> Result a
parseError (Proxy a -> String
forall a. Argument a => Proxy a -> String
argumentType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Maybe String
mMsg String
s
parseError :: String -> Maybe String -> String -> Result a
parseError :: String -> Maybe String -> String -> Result a
parseError typ :: String
typ mMsg :: Maybe String
mMsg s :: String
s = String -> Result a
forall a. String -> Result a
Errors (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$
"cannot parse as " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++
String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\ msg :: String
msg -> " (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")") Maybe String
mMsg String -> String -> String
forall a. [a] -> [a] -> [a]
++
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
class HasArguments a where
argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized a)
default argumentsParser ::
(GHC.Generic a, GTo a, SOP.GDatatypeInfo a, All2 HasArguments (GCode a)) =>
Modifiers ->
Maybe String -> Result (Parser Unnormalized a)
argumentsParser = Result (Parser Unnormalized a)
-> Maybe String -> Result (Parser Unnormalized a)
forall a b. a -> b -> a
const (Result (Parser Unnormalized a)
-> Maybe String -> Result (Parser Unnormalized a))
-> (Modifiers -> Result (Parser Unnormalized a))
-> Modifiers
-> Maybe String
-> Result (Parser Unnormalized a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifiers -> Result (Parser Unnormalized a)
forall a.
(Generic a, GTo a, GDatatypeInfo a, All2 HasArguments (GCode a)) =>
Modifiers -> Result (Parser Unnormalized a)
genericParser
instance HasArguments Int where
argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized Int)
argumentsParser = Modifiers -> Maybe String -> Result (Parser Unnormalized Int)
forall a.
Argument a =>
Modifiers -> Maybe String -> Result (Parser Unnormalized a)
atomicArgumentsParser
instance HasArguments Bool where
argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized Bool)
argumentsParser = String
-> (Modifiers -> Maybe String -> Result (Parser Unnormalized Bool))
-> Modifiers
-> Maybe String
-> Result (Parser Unnormalized Bool)
forall a.
String
-> (Modifiers -> Maybe String -> Result a)
-> Modifiers
-> Maybe String
-> Result a
wrapForPositionalArguments "Bool" ((Maybe String -> Result (Parser Unnormalized Bool))
-> Modifiers -> Maybe String -> Result (Parser Unnormalized Bool)
forall a b. a -> b -> a
const Maybe String -> Result (Parser Unnormalized Bool)
boolParser)
instance HasArguments String where
argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized String)
argumentsParser = Modifiers -> Maybe String -> Result (Parser Unnormalized String)
forall a.
Argument a =>
Modifiers -> Maybe String -> Result (Parser Unnormalized a)
atomicArgumentsParser
instance HasArguments Float where
argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized Float)
argumentsParser = Modifiers -> Maybe String -> Result (Parser Unnormalized Float)
forall a.
Argument a =>
Modifiers -> Maybe String -> Result (Parser Unnormalized a)
atomicArgumentsParser
instance HasArguments Double where
argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized Double)
argumentsParser = Modifiers -> Maybe String -> Result (Parser Unnormalized Double)
forall a.
Argument a =>
Modifiers -> Maybe String -> Result (Parser Unnormalized a)
atomicArgumentsParser
instance (HasArguments a, HasArguments b) => HasArguments (a, b)
instance (HasArguments a, HasArguments b, HasArguments c) => HasArguments (a, b, c)
wrapForPositionalArguments :: String -> (Modifiers -> Maybe String -> Result a) -> (Modifiers -> Maybe String -> Result a)
wrapForPositionalArguments :: String
-> (Modifiers -> Maybe String -> Result a)
-> Modifiers
-> Maybe String
-> Result a
wrapForPositionalArguments typ :: String
typ wrapped :: Modifiers -> Maybe String -> Result a
wrapped modifiers :: Modifiers
modifiers (Just field :: String
field) =
if Modifiers -> String -> Bool
isPositionalArgumentsField Modifiers
modifiers String
field
then String -> Result a
forall a. String -> Result a
Errors ("UseForPositionalArguments can only be used for fields of type [String] not " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ)
else Modifiers -> Maybe String -> Result a
wrapped Modifiers
modifiers (String -> Maybe String
forall a. a -> Maybe a
Just String
field)
wrapForPositionalArguments _ wrapped :: Modifiers -> Maybe String -> Result a
wrapped modifiers :: Modifiers
modifiers Nothing = Modifiers -> Maybe String -> Result a
wrapped Modifiers
modifiers Maybe String
forall a. Maybe a
Nothing
instance Argument a => HasArguments (Maybe a) where
argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized (Maybe a))
argumentsParser _ = Maybe String -> Result (Parser Unnormalized (Maybe a))
forall a.
Argument a =>
Maybe String -> Result (Parser Unnormalized (Maybe a))
maybeParser
instance Argument a => HasArguments [a] where
argumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized [a])
argumentsParser modifiers :: Modifiers
modifiers (Just field :: String
field) =
Parser Unnormalized [a] -> Result (Parser Unnormalized [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized [a] -> Result (Parser Unnormalized [a]))
-> Parser Unnormalized [a] -> Result (Parser Unnormalized [a])
forall a b. (a -> b) -> a -> b
$ if Modifiers -> String -> Bool
isPositionalArgumentsField Modifiers
modifiers String
field
then Parser Unnormalized [a]
forall a. Argument a => Parser Unnormalized [a]
positionalArgumentsParser
else Maybe String -> Parser Unnormalized [a]
forall a. Argument a => Maybe String -> Parser Unnormalized [a]
listParser (String -> Maybe String
forall a. a -> Maybe a
Just String
field)
argumentsParser _ Nothing =
Parser Unnormalized [a] -> Result (Parser Unnormalized [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized [a] -> Result (Parser Unnormalized [a]))
-> Parser Unnormalized [a] -> Result (Parser Unnormalized [a])
forall a b. (a -> b) -> a -> b
$ Maybe String -> Parser Unnormalized [a]
forall a. Argument a => Maybe String -> Parser Unnormalized [a]
listParser Maybe String
forall a. Maybe a
Nothing
atomicArgumentsParser :: forall a . Argument a =>
Modifiers ->
Maybe String -> Result (Parser Unnormalized a)
atomicArgumentsParser :: Modifiers -> Maybe String -> Result (Parser Unnormalized a)
atomicArgumentsParser =
String
-> (Modifiers -> Maybe String -> Result (Parser Unnormalized a))
-> Modifiers
-> Maybe String
-> Result (Parser Unnormalized a)
forall a.
String
-> (Modifiers -> Maybe String -> Result a)
-> Modifiers
-> Maybe String
-> Result a
wrapForPositionalArguments String
typ Modifiers -> Maybe String -> Result (Parser Unnormalized a)
inner
where
typ :: String
typ = Proxy a -> String
forall a. Argument a => Proxy a -> String
argumentType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
inner :: Modifiers -> Maybe String -> Result (Parser Unnormalized a)
inner modifiers :: Modifiers
modifiers mLong :: Maybe String
mLong = Parser Unnormalized a -> Result (Parser Unnormalized a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized a -> Result (Parser Unnormalized a))
-> Parser Unnormalized a -> Result (Parser Unnormalized a)
forall a b. (a -> b) -> a -> b
$ case Maybe String
mLong of
Nothing -> Parser Unnormalized a
withoutLongOption
Just long :: String
long -> Modifiers -> String -> Parser Unnormalized a
withLongOption Modifiers
modifiers String
long
withoutLongOption :: Parser Unnormalized a
withoutLongOption = $WParser :: forall uninitialized a phase.
uninitialized
-> [OptDescr (Result (uninitialized -> uninitialized))]
-> [NonOptionsParser uninitialized]
-> (uninitialized -> Result a)
-> Parser phase a
Parser {
parserDefault :: Maybe a
parserDefault = Maybe a
forall a. Maybe a
Nothing,
parserOptions :: [OptDescr (Result (Maybe a -> Maybe a))]
parserOptions = [],
parserNonOptions :: [NonOptionsParser (Maybe a)]
parserNonOptions =
[String
-> Bool
-> ([String] -> Result (Maybe a -> Maybe a, [String]))
-> NonOptionsParser (Maybe a)
forall uninitialized.
String
-> Bool
-> ([String] -> Result (uninitialized -> uninitialized, [String]))
-> NonOptionsParser uninitialized
NonOptionsParser String
typ Bool
False (\ (s :: String
s : r :: [String]
r) -> (a -> (Maybe a -> Maybe a, [String]))
-> Result a -> Result (Maybe a -> Maybe a, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((, [String]
r) ((Maybe a -> Maybe a) -> (Maybe a -> Maybe a, [String]))
-> (a -> Maybe a -> Maybe a) -> a -> (Maybe a -> Maybe a, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Maybe a -> Maybe a
forall a b. a -> b -> a
const (Maybe a -> Maybe a -> Maybe a)
-> (a -> Maybe a) -> a -> Maybe a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) (Result a -> Result (Maybe a -> Maybe a, [String]))
-> Result a -> Result (Maybe a -> Maybe a, [String])
forall a b. (a -> b) -> a -> b
$ Maybe String -> String -> Result a
forall a. Argument a => Maybe String -> String -> Result a
parseArgumentResult Maybe String
forall a. Maybe a
Nothing String
s)],
parserConvert :: Maybe a -> Result a
parserConvert = \ case
Just a :: a
a -> a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Nothing -> String -> Result a
forall a. String -> Result a
Errors (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$
"missing argument of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ
}
withLongOption :: Modifiers -> String -> Parser Unnormalized a
withLongOption modifiers :: Modifiers
modifiers long :: String
long = $WParser :: forall uninitialized a phase.
uninitialized
-> [OptDescr (Result (uninitialized -> uninitialized))]
-> [NonOptionsParser uninitialized]
-> (uninitialized -> Result a)
-> Parser phase a
Parser {
parserDefault :: Either () a
parserDefault = () -> Either () a
forall a b. a -> Either a b
Left (),
parserOptions :: [OptDescr (Result (Either () a -> Either () a))]
parserOptions = OptDescr (Result (Either () a -> Either () a))
-> [OptDescr (Result (Either () a -> Either () a))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptDescr (Result (Either () a -> Either () a))
-> [OptDescr (Result (Either () a -> Either () a))])
-> OptDescr (Result (Either () a -> Either () a))
-> [OptDescr (Result (Either () a -> Either () a))]
forall a b. (a -> b) -> a -> b
$
String
-> [String]
-> ArgDescr (Result (Either () a -> Either () a))
-> String
-> OptDescr (Result (Either () a -> Either () a))
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
long]
((Result a -> Result (Either () a -> Either () a))
-> ArgDescr (Result a)
-> ArgDescr (Result (Either () a -> Either () a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Either () a -> Either () a)
-> Result a -> Result (Either () a -> Either () a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either () a -> Either () a -> Either () a
forall a b. a -> b -> a
const (Either () a -> Either () a -> Either () a)
-> (a -> Either () a) -> a -> Either () a -> Either () a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either () a
forall a b. b -> Either a b
Right)) (ArgDescr (Result a)
-> ArgDescr (Result (Either () a -> Either () a)))
-> ArgDescr (Result a)
-> ArgDescr (Result (Either () a -> Either () a))
forall a b. (a -> b) -> a -> b
$
(String -> Result a) -> String -> ArgDescr (Result a)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (Maybe String -> String -> Result a
forall a. Argument a => Maybe String -> String -> Result a
parseArgumentResult Maybe String
forall a. Maybe a
Nothing) String
typ)
"",
parserNonOptions :: [NonOptionsParser (Either () a)]
parserNonOptions = [],
parserConvert :: Either () a -> Result a
parserConvert = \ case
Right a :: a
a -> a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Left () -> String -> Result a
forall a. String -> Result a
Errors (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$
"missing option: --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
normalize (Modifiers -> String -> String
applyModifiersLong Modifiers
modifiers String
long) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ
}
listParser :: forall a . Argument a =>
Maybe String -> Parser Unnormalized [a]
listParser :: Maybe String -> Parser Unnormalized [a]
listParser mLong :: Maybe String
mLong = case Maybe String
mLong of
Nothing -> Parser Unnormalized [a]
forall a. Argument a => Parser Unnormalized [a]
positionalArgumentsParser
Just long :: String
long -> $WParser :: forall uninitialized a phase.
uninitialized
-> [OptDescr (Result (uninitialized -> uninitialized))]
-> [NonOptionsParser uninitialized]
-> (uninitialized -> Result a)
-> Parser phase a
Parser {
parserDefault :: [a]
parserDefault = [],
parserOptions :: [OptDescr (Result ([a] -> [a]))]
parserOptions = OptDescr (Result ([a] -> [a])) -> [OptDescr (Result ([a] -> [a]))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptDescr (Result ([a] -> [a]))
-> [OptDescr (Result ([a] -> [a]))])
-> OptDescr (Result ([a] -> [a]))
-> [OptDescr (Result ([a] -> [a]))]
forall a b. (a -> b) -> a -> b
$
String
-> [String]
-> ArgDescr (Result ([a] -> [a]))
-> String
-> OptDescr (Result ([a] -> [a]))
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
long]
((String -> Result ([a] -> [a]))
-> String -> ArgDescr (Result ([a] -> [a]))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\ s :: String
s -> (a -> [a] -> [a]) -> Result a -> Result ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ a :: a
a -> ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
a])) (Maybe String -> String -> Result a
forall a. Argument a => Maybe String -> String -> Result a
parseArgumentResult (String -> Maybe String
forall a. a -> Maybe a
Just "multiple possible") String
s))
(Proxy a -> String
forall a. Argument a => Proxy a -> String
argumentType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (multiple possible)"))
"",
parserNonOptions :: [NonOptionsParser [a]]
parserNonOptions = [],
parserConvert :: [a] -> Result [a]
parserConvert = [a] -> Result [a]
forall (m :: * -> *) a. Monad m => a -> m a
return
}
positionalArgumentsParser :: forall a . Argument a =>
Parser Unnormalized [a]
positionalArgumentsParser :: Parser Unnormalized [a]
positionalArgumentsParser = $WParser :: forall uninitialized a phase.
uninitialized
-> [OptDescr (Result (uninitialized -> uninitialized))]
-> [NonOptionsParser uninitialized]
-> (uninitialized -> Result a)
-> Parser phase a
Parser {
parserDefault :: [a]
parserDefault = [],
parserOptions :: [OptDescr (Result ([a] -> [a]))]
parserOptions = [],
parserNonOptions :: [NonOptionsParser [a]]
parserNonOptions = [String
-> Bool
-> ([String] -> Result ([a] -> [a], [String]))
-> NonOptionsParser [a]
forall uninitialized.
String
-> Bool
-> ([String] -> Result (uninitialized -> uninitialized, [String]))
-> NonOptionsParser uninitialized
NonOptionsParser (Proxy a -> String
forall a. Argument a => Proxy a -> String
argumentType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Bool
True [String] -> Result ([a] -> [a], [String])
parse],
parserConvert :: [a] -> Result [a]
parserConvert = [a] -> Result [a]
forall (m :: * -> *) a. Monad m => a -> m a
return
}
where
parse :: [String] -> Result ([a] -> [a], [String])
parse :: [String] -> Result ([a] -> [a], [String])
parse args :: [String]
args = do
[[a] -> [a]]
mods <- [String] -> (String -> Result ([a] -> [a])) -> Result [[a] -> [a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
args ((String -> Result ([a] -> [a])) -> Result [[a] -> [a]])
-> (String -> Result ([a] -> [a])) -> Result [[a] -> [a]]
forall a b. (a -> b) -> a -> b
$ \ arg :: String
arg ->
case String -> Maybe a
forall a. Argument a => String -> Maybe a
parseArgument String
arg of
Just a :: a
a -> ([a] -> [a]) -> Result ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
Nothing -> String -> Maybe String -> String -> Result ([a] -> [a])
forall a. String -> Maybe String -> String -> Result a
parseError (Proxy a -> String
forall a. Argument a => Proxy a -> String
argumentType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Maybe String
forall a. Maybe a
Nothing String
arg
([a] -> [a], [String]) -> Result ([a] -> [a], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ((([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> ([a] -> [a]) -> [[a] -> [a]] -> [a] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [a] -> [a]
forall a. a -> a
id [[a] -> [a]]
mods, [])
maybeParser :: forall a . Argument a =>
Maybe String -> Result (Parser Unnormalized (Maybe a))
maybeParser :: Maybe String -> Result (Parser Unnormalized (Maybe a))
maybeParser mLong :: Maybe String
mLong = case Maybe String
mLong of
Nothing -> Parser Unnormalized (Maybe a)
-> Result (Parser Unnormalized (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized (Maybe a)
-> Result (Parser Unnormalized (Maybe a)))
-> Parser Unnormalized (Maybe a)
-> Result (Parser Unnormalized (Maybe a))
forall a b. (a -> b) -> a -> b
$ $WParser :: forall uninitialized a phase.
uninitialized
-> [OptDescr (Result (uninitialized -> uninitialized))]
-> [NonOptionsParser uninitialized]
-> (uninitialized -> Result a)
-> Parser phase a
Parser {
parserDefault :: Maybe a
parserDefault = Maybe a
forall a. Maybe a
Nothing,
parserOptions :: [OptDescr (Result (Maybe a -> Maybe a))]
parserOptions = [],
parserNonOptions :: [NonOptionsParser (Maybe a)]
parserNonOptions =
let parse :: [String] -> Result (Maybe a -> Maybe a, [String])
parse :: [String] -> Result (Maybe a -> Maybe a, [String])
parse (a :: String
a : r :: [String]
r) = do
a
v <- Maybe String -> String -> Result a
forall a. Argument a => Maybe String -> String -> Result a
parseArgumentResult (String -> Maybe String
forall a. a -> Maybe a
Just "optional") String
a
(Maybe a -> Maybe a, [String])
-> Result (Maybe a -> Maybe a, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Maybe a -> Maybe a
forall a b. a -> b -> a
const (a -> Maybe a
forall a. a -> Maybe a
Just a
v), [String]
r)
parse [] = (Maybe a -> Maybe a, [String])
-> Result (Maybe a -> Maybe a, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Maybe a
forall a. a -> a
id, [])
in [String
-> Bool
-> ([String] -> Result (Maybe a -> Maybe a, [String]))
-> NonOptionsParser (Maybe a)
forall uninitialized.
String
-> Bool
-> ([String] -> Result (uninitialized -> uninitialized, [String]))
-> NonOptionsParser uninitialized
NonOptionsParser (Proxy a -> String
forall a. Argument a => Proxy a -> String
argumentType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Bool
True [String] -> Result (Maybe a -> Maybe a, [String])
parse],
parserConvert :: Maybe a -> Result (Maybe a)
parserConvert = Maybe a -> Result (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return
}
Just long :: String
long -> Parser Unnormalized (Maybe a)
-> Result (Parser Unnormalized (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized (Maybe a)
-> Result (Parser Unnormalized (Maybe a)))
-> Parser Unnormalized (Maybe a)
-> Result (Parser Unnormalized (Maybe a))
forall a b. (a -> b) -> a -> b
$ $WParser :: forall uninitialized a phase.
uninitialized
-> [OptDescr (Result (uninitialized -> uninitialized))]
-> [NonOptionsParser uninitialized]
-> (uninitialized -> Result a)
-> Parser phase a
Parser {
parserDefault :: Maybe a
parserDefault = Maybe a
forall a. Maybe a
Nothing,
parserOptions :: [OptDescr (Result (Maybe a -> Maybe a))]
parserOptions = OptDescr (Result (Maybe a -> Maybe a))
-> [OptDescr (Result (Maybe a -> Maybe a))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptDescr (Result (Maybe a -> Maybe a))
-> [OptDescr (Result (Maybe a -> Maybe a))])
-> OptDescr (Result (Maybe a -> Maybe a))
-> [OptDescr (Result (Maybe a -> Maybe a))]
forall a b. (a -> b) -> a -> b
$
String
-> [String]
-> ArgDescr (Result (Maybe a -> Maybe a))
-> String
-> OptDescr (Result (Maybe a -> Maybe a))
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
long]
((String -> Result (Maybe a -> Maybe a))
-> String -> ArgDescr (Result (Maybe a -> Maybe a))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\ s :: String
s -> (a -> Maybe a -> Maybe a)
-> Result a -> Result (Maybe a -> Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ a :: a
a -> (Maybe a -> Maybe a -> Maybe a
forall a b. a -> b -> a
const (a -> Maybe a
forall a. a -> Maybe a
Just a
a))) (Maybe String -> String -> Result a
forall a. Argument a => Maybe String -> String -> Result a
parseArgumentResult (String -> Maybe String
forall a. a -> Maybe a
Just "optional") String
s))
(Proxy a -> String
forall a. Argument a => Proxy a -> String
argumentType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (optional)"))
"",
parserNonOptions :: [NonOptionsParser (Maybe a)]
parserNonOptions = [],
parserConvert :: Maybe a -> Result (Maybe a)
parserConvert = Maybe a -> Result (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return
}
boolParser :: Maybe String -> Result (Parser Unnormalized Bool)
boolParser :: Maybe String -> Result (Parser Unnormalized Bool)
boolParser mLong :: Maybe String
mLong = Parser Unnormalized Bool -> Result (Parser Unnormalized Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized Bool -> Result (Parser Unnormalized Bool))
-> Parser Unnormalized Bool -> Result (Parser Unnormalized Bool)
forall a b. (a -> b) -> a -> b
$ case Maybe String
mLong of
Nothing -> $WParser :: forall uninitialized a phase.
uninitialized
-> [OptDescr (Result (uninitialized -> uninitialized))]
-> [NonOptionsParser uninitialized]
-> (uninitialized -> Result a)
-> Parser phase a
Parser {
parserDefault :: Maybe Bool
parserDefault = Maybe Bool
forall a. Maybe a
Nothing,
parserOptions :: [OptDescr (Result (Maybe Bool -> Maybe Bool))]
parserOptions = [],
parserNonOptions :: [NonOptionsParser (Maybe Bool)]
parserNonOptions = NonOptionsParser (Maybe Bool) -> [NonOptionsParser (Maybe Bool)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonOptionsParser (Maybe Bool) -> [NonOptionsParser (Maybe Bool)])
-> NonOptionsParser (Maybe Bool) -> [NonOptionsParser (Maybe Bool)]
forall a b. (a -> b) -> a -> b
$
(String
-> Bool
-> ([String] -> Result (Maybe Bool -> Maybe Bool, [String]))
-> NonOptionsParser (Maybe Bool)
forall uninitialized.
String
-> Bool
-> ([String] -> Result (uninitialized -> uninitialized, [String]))
-> NonOptionsParser uninitialized
NonOptionsParser "BOOL" Bool
False (\ (s :: String
s : r :: [String]
r) -> (, [String]
r) ((Maybe Bool -> Maybe Bool)
-> (Maybe Bool -> Maybe Bool, [String]))
-> Result (Maybe Bool -> Maybe Bool)
-> Result (Maybe Bool -> Maybe Bool, [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result (Maybe Bool -> Maybe Bool)
-> (Bool -> Result (Maybe Bool -> Maybe Bool))
-> Maybe Bool
-> Result (Maybe Bool -> Maybe Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
-> Maybe String -> String -> Result (Maybe Bool -> Maybe Bool)
forall a. String -> Maybe String -> String -> Result a
parseError "BOOL" Maybe String
forall a. Maybe a
Nothing String
s) ((Maybe Bool -> Maybe Bool) -> Result (Maybe Bool -> Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Bool -> Maybe Bool) -> Result (Maybe Bool -> Maybe Bool))
-> (Bool -> Maybe Bool -> Maybe Bool)
-> Bool
-> Result (Maybe Bool -> Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> Maybe Bool -> Maybe Bool
forall a b. a -> b -> a
const (Maybe Bool -> Maybe Bool -> Maybe Bool)
-> (Bool -> Maybe Bool) -> Bool -> Maybe Bool -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Bool
forall a. a -> Maybe a
Just) (String -> Maybe Bool
parseBool String
s))),
parserConvert :: Maybe Bool -> Result Bool
parserConvert = \ case
Just x :: Bool
x -> Bool -> Result Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x
Nothing -> String -> Result Bool
forall a. String -> Result a
Errors (String -> Result Bool) -> String -> Result Bool
forall a b. (a -> b) -> a -> b
$
"missing argument of type BOOL"
}
Just long :: String
long -> $WParser :: forall uninitialized a phase.
uninitialized
-> [OptDescr (Result (uninitialized -> uninitialized))]
-> [NonOptionsParser uninitialized]
-> (uninitialized -> Result a)
-> Parser phase a
Parser {
parserDefault :: Bool
parserDefault = Bool
False,
parserOptions :: [OptDescr (Result (Bool -> Bool))]
parserOptions = OptDescr (Result (Bool -> Bool))
-> [OptDescr (Result (Bool -> Bool))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OptDescr (Result (Bool -> Bool))
-> [OptDescr (Result (Bool -> Bool))])
-> OptDescr (Result (Bool -> Bool))
-> [OptDescr (Result (Bool -> Bool))]
forall a b. (a -> b) -> a -> b
$
String
-> [String]
-> ArgDescr (Result (Bool -> Bool))
-> String
-> OptDescr (Result (Bool -> Bool))
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
long]
(Result (Bool -> Bool) -> ArgDescr (Result (Bool -> Bool))
forall a. a -> ArgDescr a
NoArg ((Bool -> Bool) -> Result (Bool -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True)))
"",
parserNonOptions :: [NonOptionsParser Bool]
parserNonOptions = [],
parserConvert :: Bool -> Result Bool
parserConvert = Bool -> Result Bool
forall (m :: * -> *) a. Monad m => a -> m a
return
}
parseBool :: String -> Maybe Bool
parseBool :: String -> Maybe Bool
parseBool s :: String
s
| (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["true", "yes", "on"] = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
| (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["false", "no", "off"] = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
| Bool
otherwise = case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe String
s of
Just (Integer
n :: Integer) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
Nothing -> Maybe Bool
forall a. Maybe a
Nothing
genericParser :: forall a .
(GHC.Generic a, GTo a, GDatatypeInfo a, All2 HasArguments (GCode a)) =>
Modifiers ->
Result (Parser Unnormalized a)
genericParser :: Modifiers -> Result (Parser Unnormalized a)
genericParser modifiers :: Modifiers
modifiers = (Parser Unnormalized (SOP I (ToSumCode (Rep a) '[]))
-> Parser Unnormalized a)
-> Result (Parser Unnormalized (SOP I (ToSumCode (Rep a) '[])))
-> Result (Parser Unnormalized a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SOP I (ToSumCode (Rep a) '[]) -> a)
-> Parser Unnormalized (SOP I (ToSumCode (Rep a) '[]))
-> Parser Unnormalized a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SOP I (ToSumCode (Rep a) '[]) -> a
forall a. (GTo a, Generic a) => SOP I (GCode a) -> a
gto) (Result (Parser Unnormalized (SOP I (ToSumCode (Rep a) '[])))
-> Result (Parser Unnormalized a))
-> Result (Parser Unnormalized (SOP I (ToSumCode (Rep a) '[])))
-> Result (Parser Unnormalized a)
forall a b. (a -> b) -> a -> b
$
let datatypeInfo :: DatatypeInfo (ToSumCode (Rep a) '[])
datatypeInfo = Proxy a -> DatatypeInfo (ToSumCode (Rep a) '[])
forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
err :: forall a . String -> Result a
err :: String -> Result a
err message :: String
message = String -> Result a
forall a. String -> Result a
Errors (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$
"getopt-generics doesn't support " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
message String -> String -> String
forall a. [a] -> [a] -> [a]
++
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DatatypeInfo (ToSumCode (Rep a) '[]) -> String
forall (xss :: [[*]]). DatatypeInfo xss -> String
datatypeName DatatypeInfo (ToSumCode (Rep a) '[])
datatypeInfo String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")."
in case DatatypeInfo (ToSumCode (Rep a) '[])
-> NP ConstructorInfo (ToSumCode (Rep a) '[])
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo DatatypeInfo (ToSumCode (Rep a) '[])
datatypeInfo of
firstConstructor :: ConstructorInfo x
firstConstructor :* Nil ->
case ConstructorInfo x
firstConstructor of
Record _ fields :: NP FieldInfo x
fields ->
(Parser Unnormalized (NP I x) -> Parser Unnormalized (SOP I '[x]))
-> Result (Parser Unnormalized (NP I x))
-> Result (Parser Unnormalized (SOP I '[x]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NP I x -> SOP I '[x])
-> Parser Unnormalized (NP I x) -> Parser Unnormalized (SOP I '[x])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NS (NP I) '[x] -> SOP I '[x]
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (NS (NP I) '[x] -> SOP I '[x])
-> (NP I x -> NS (NP I) '[x]) -> NP I x -> SOP I '[x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP I x -> NS (NP I) '[x]
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z)) (Modifiers
-> NP FieldInfo x -> Result (Parser Unnormalized (NP I x))
forall (xs :: [*]).
All HasArguments xs =>
Modifiers
-> NP FieldInfo xs -> Result (Parser Unnormalized (NP I xs))
fieldsParser Modifiers
modifiers NP FieldInfo x
fields)
Constructor{} ->
(Parser Unnormalized (NP I x) -> Parser Unnormalized (SOP I '[x]))
-> Result (Parser Unnormalized (NP I x))
-> Result (Parser Unnormalized (SOP I '[x]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NP I x -> SOP I '[x])
-> Parser Unnormalized (NP I x) -> Parser Unnormalized (SOP I '[x])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NS (NP I) '[x] -> SOP I '[x]
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (NS (NP I) '[x] -> SOP I '[x])
-> (NP I x -> NS (NP I) '[x]) -> NP I x -> SOP I '[x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP I x -> NS (NP I) '[x]
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z)) (Modifiers -> Shape x -> Result (Parser Unnormalized (NP I x))
forall (xs :: [*]).
All HasArguments xs =>
Modifiers -> Shape xs -> Result (Parser Unnormalized (NP I xs))
noSelectorsParser Modifiers
modifiers Shape x
forall k (xs :: [k]). SListI xs => Shape xs
shape)
Infix{} -> String
-> Result (Parser Unnormalized (SOP I (ToSumCode (Rep a) '[])))
forall a. String -> Result a
err "infix constructors"
Nil -> String
-> Result (Parser Unnormalized (SOP I (ToSumCode (Rep a) '[])))
forall a. String -> Result a
err "empty data types"
_ :* _ :* _ -> String
-> Result (Parser Unnormalized (SOP I (ToSumCode (Rep a) '[])))
forall a. String -> Result a
err "sum types"
fieldsParser :: All HasArguments xs =>
Modifiers -> NP FieldInfo xs -> Result (Parser Unnormalized (NP I xs))
fieldsParser :: Modifiers
-> NP FieldInfo xs -> Result (Parser Unnormalized (NP I xs))
fieldsParser modifiers :: Modifiers
modifiers = \ case
Nil -> Parser Unnormalized (NP I '[])
-> Result (Parser Unnormalized (NP I xs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized (NP I '[])
-> Result (Parser Unnormalized (NP I xs)))
-> Parser Unnormalized (NP I '[])
-> Result (Parser Unnormalized (NP I xs))
forall a b. (a -> b) -> a -> b
$ NP I '[] -> Parser Unnormalized (NP I '[])
forall a phase. a -> Parser phase a
emptyParser NP I '[]
forall k (a :: k -> *). NP a '[]
Nil
FieldInfo fieldName :: String
fieldName :* rest :: NP FieldInfo xs
rest ->
(Parser Unnormalized (I x, NP I xs)
-> Parser Unnormalized (NP I (x : xs)))
-> Result (Parser Unnormalized (I x, NP I xs))
-> Result (Parser Unnormalized (NP I (x : xs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((I x, NP I xs) -> NP I (x : xs))
-> Parser Unnormalized (I x, NP I xs)
-> Parser Unnormalized (NP I (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (a :: I x
a, r :: NP I xs
r) -> I x
a I x -> NP I xs -> NP I (x : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I xs
r)) (Result (Parser Unnormalized (I x, NP I xs))
-> Result (Parser Unnormalized (NP I xs)))
-> Result (Parser Unnormalized (I x, NP I xs))
-> Result (Parser Unnormalized (NP I xs))
forall a b. (a -> b) -> a -> b
$
Result (Parser Unnormalized (I x))
-> Result (Parser Unnormalized (NP I xs))
-> Result (Parser Unnormalized (I x, NP I xs))
forall a b phase.
Result (Parser phase a)
-> Result (Parser phase b) -> Result (Parser phase (a, b))
combine ((Parser Unnormalized x -> Parser Unnormalized (I x))
-> Result (Parser Unnormalized x)
-> Result (Parser Unnormalized (I x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> I x) -> Parser Unnormalized x -> Parser Unnormalized (I x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> I x
forall a. a -> I a
I) (Result (Parser Unnormalized x)
-> Result (Parser Unnormalized (I x)))
-> Result (Parser Unnormalized x)
-> Result (Parser Unnormalized (I x))
forall a b. (a -> b) -> a -> b
$ (Modifiers -> Maybe String -> Result (Parser Unnormalized x)
forall a.
HasArguments a =>
Modifiers -> Maybe String -> Result (Parser Unnormalized a)
argumentsParser Modifiers
modifiers (String -> Maybe String
forall a. a -> Maybe a
Just String
fieldName))) (Modifiers
-> NP FieldInfo xs -> Result (Parser Unnormalized (NP I xs))
forall (xs :: [*]).
All HasArguments xs =>
Modifiers
-> NP FieldInfo xs -> Result (Parser Unnormalized (NP I xs))
fieldsParser Modifiers
modifiers NP FieldInfo xs
rest)
noSelectorsParser :: All HasArguments xs =>
Modifiers -> Shape xs -> Result (Parser Unnormalized (NP I xs))
noSelectorsParser :: Modifiers -> Shape xs -> Result (Parser Unnormalized (NP I xs))
noSelectorsParser modifiers :: Modifiers
modifiers = \ case
ShapeNil -> Parser Unnormalized (NP I '[])
-> Result (Parser Unnormalized (NP I xs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized (NP I '[])
-> Result (Parser Unnormalized (NP I xs)))
-> Parser Unnormalized (NP I '[])
-> Result (Parser Unnormalized (NP I xs))
forall a b. (a -> b) -> a -> b
$ NP I '[] -> Parser Unnormalized (NP I '[])
forall a phase. a -> Parser phase a
emptyParser NP I '[]
forall k (a :: k -> *). NP a '[]
Nil
ShapeCons rest :: Shape xs
rest ->
(Parser Unnormalized (I x, NP I xs)
-> Parser Unnormalized (NP I (x : xs)))
-> Result (Parser Unnormalized (I x, NP I xs))
-> Result (Parser Unnormalized (NP I (x : xs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((I x, NP I xs) -> NP I (x : xs))
-> Parser Unnormalized (I x, NP I xs)
-> Parser Unnormalized (NP I (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (a :: I x
a, r :: NP I xs
r) -> I x
a I x -> NP I xs -> NP I (x : xs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I xs
r)) (Result (Parser Unnormalized (I x, NP I xs))
-> Result (Parser Unnormalized (NP I xs)))
-> Result (Parser Unnormalized (I x, NP I xs))
-> Result (Parser Unnormalized (NP I xs))
forall a b. (a -> b) -> a -> b
$
Result (Parser Unnormalized (I x))
-> Result (Parser Unnormalized (NP I xs))
-> Result (Parser Unnormalized (I x, NP I xs))
forall a b phase.
Result (Parser phase a)
-> Result (Parser phase b) -> Result (Parser phase (a, b))
combine ((Parser Unnormalized x -> Parser Unnormalized (I x))
-> Result (Parser Unnormalized x)
-> Result (Parser Unnormalized (I x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> I x) -> Parser Unnormalized x -> Parser Unnormalized (I x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> I x
forall a. a -> I a
I) (Result (Parser Unnormalized x)
-> Result (Parser Unnormalized (I x)))
-> Result (Parser Unnormalized x)
-> Result (Parser Unnormalized (I x))
forall a b. (a -> b) -> a -> b
$ (Modifiers -> Maybe String -> Result (Parser Unnormalized x)
forall a.
HasArguments a =>
Modifiers -> Maybe String -> Result (Parser Unnormalized a)
argumentsParser Modifiers
modifiers Maybe String
forall a. Maybe a
Nothing)) (Modifiers -> Shape xs -> Result (Parser Unnormalized (NP I xs))
forall (xs :: [*]).
All HasArguments xs =>
Modifiers -> Shape xs -> Result (Parser Unnormalized (NP I xs))
noSelectorsParser Modifiers
modifiers Shape xs
rest)