{-# 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

-- | Everything that can be used as an argument to your @main@ function
--   (see 'withCli') needs to have a 'HasArguments' instance.
--
--   'HasArguments' also allows to conjure up instances for record types
--   to create more complex command line interfaces. Here's an example:

-- ### Start "docs/RecordType.hs" "module RecordType where\n\n" Haddock ###

-- |
-- >  {-# LANGUAGE DeriveAnyClass #-}
-- >  {-# LANGUAGE DeriveGeneric #-}
-- >
-- >  import WithCli
-- >
-- >  data Options
-- >    = Options {
-- >      port :: Int,
-- >      daemonize :: Bool,
-- >      config :: Maybe FilePath
-- >    }
-- >    deriving (Show, Generic, HasArguments)
-- >
-- >  main :: IO ()
-- >  main = withCli run
-- >
-- >  run :: Options -> IO ()
-- >  run = print

-- ### End ###

-- | In a shell this program behaves like this:

-- ### Start "docs/RecordType.shell-protocol" "" Haddock ###

-- |
-- >  $ program --port 8080 --config some/path
-- >  Options {port = 8080, daemonize = False, config = Just "some/path"}
-- >  $ program  --port 8080 --daemonize
-- >  Options {port = 8080, daemonize = True, config = Nothing}
-- >  $ program --port foo
-- >  cannot parse as INTEGER: foo
-- >  # exit-code 1
-- >  $ program
-- >  missing option: --port=INTEGER
-- >  # exit-code 1
-- >  $ program --help
-- >  program [OPTIONS]
-- >        --port=INTEGER
-- >        --daemonize
-- >        --config=STRING (optional)
-- >    -h  --help                      show help and exit

-- ### End ###

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

-- * atomic HasArguments

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

-- | Useful for implementing your own instances of 'HasArguments' on top
--   of a custom 'Argument' instance.
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

-- * generic HasArguments

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)