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