{-# 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 [Char] -> Maybe a
forall a. Argument a => [Char] -> Maybe a
parseArgument [Char]
s of
  Just a
x -> a -> Result a
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  Maybe a
Nothing -> [Char] -> Maybe [Char] -> [Char] -> Result a
forall a. [Char] -> Maybe [Char] -> [Char] -> Result a
parseError (Proxy a -> [Char]
forall a. Argument a => Proxy a -> [Char]
argumentType (Proxy a
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 = [Char] -> Result a
forall a. [Char] -> Result a
Errors ([Char] -> Result a) -> [Char] -> Result a
forall a b. (a -> b) -> a -> b
$
  [Char]
"cannot parse as " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
typ [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\ [Char]
msg -> [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")") Maybe [Char]
mMsg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
  [Char]
": " [Char] -> [Char] -> [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 = Result (Parser Unnormalized a)
-> Maybe [Char] -> Result (Parser Unnormalized a)
forall a b. a -> b -> a
const (Result (Parser Unnormalized a)
 -> Maybe [Char] -> Result (Parser Unnormalized a))
-> (Modifiers -> Result (Parser Unnormalized a))
-> Modifiers
-> Maybe [Char]
-> 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

-- * atomic HasArguments

instance HasArguments Int where
  argumentsParser :: Modifiers -> Maybe [Char] -> Result (Parser Unnormalized Int)
argumentsParser = Modifiers -> Maybe [Char] -> Result (Parser Unnormalized Int)
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 = [Char]
-> (Modifiers -> Maybe [Char] -> Result (Parser Unnormalized Bool))
-> Modifiers
-> Maybe [Char]
-> Result (Parser Unnormalized Bool)
forall a.
[Char]
-> (Modifiers -> Maybe [Char] -> Result a)
-> Modifiers
-> Maybe [Char]
-> Result a
wrapForPositionalArguments [Char]
"Bool" ((Maybe [Char] -> Result (Parser Unnormalized Bool))
-> Modifiers -> Maybe [Char] -> Result (Parser Unnormalized 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 = Modifiers -> Maybe [Char] -> Result (Parser Unnormalized [Char])
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 = Modifiers -> Maybe [Char] -> Result (Parser Unnormalized Float)
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 = Modifiers -> Maybe [Char] -> Result (Parser Unnormalized Double)
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 [Char] -> Result a
forall a. [Char] -> Result a
Errors ([Char]
"UseForPositionalArguments can only be used for fields of type [String] not " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
typ)
    else Modifiers -> Maybe [Char] -> Result a
wrapped Modifiers
modifiers ([Char] -> Maybe [Char]
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 Maybe [Char]
forall a. Maybe a
Nothing

instance Argument a => HasArguments (Maybe a) where
  argumentsParser :: Modifiers -> Maybe [Char] -> Result (Parser Unnormalized (Maybe a))
argumentsParser Modifiers
_ = Maybe [Char] -> Result (Parser Unnormalized (Maybe a))
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) =
    Parser Unnormalized [a] -> Result (Parser Unnormalized [a])
forall a. a -> Result 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 -> [Char] -> Bool
isPositionalArgumentsField Modifiers
modifiers [Char]
field
      then Parser Unnormalized [a]
forall a. Argument a => Parser Unnormalized [a]
positionalArgumentsParser
      else Maybe [Char] -> Parser Unnormalized [a]
forall a. Argument a => Maybe [Char] -> Parser Unnormalized [a]
listParser ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
field)
  argumentsParser Modifiers
_ Maybe [Char]
Nothing =
    Parser Unnormalized [a] -> Result (Parser Unnormalized [a])
forall a. a -> Result 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 [Char] -> Parser Unnormalized [a]
forall a. Argument a => Maybe [Char] -> Parser Unnormalized [a]
listParser Maybe [Char]
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 =
  [Char]
-> (Modifiers -> Maybe [Char] -> Result (Parser Unnormalized a))
-> Modifiers
-> Maybe [Char]
-> Result (Parser Unnormalized a)
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 = Proxy a -> [Char]
forall a. Argument a => Proxy a -> [Char]
argumentType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

    inner :: Modifiers -> Maybe [Char] -> Result (Parser Unnormalized a)
inner Modifiers
modifiers Maybe [Char]
mLong = Parser Unnormalized a -> Result (Parser Unnormalized a)
forall a. a -> Result 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 [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 = Maybe a
forall a. Maybe a
Nothing,
      parserOptions :: [OptDescr (Result (Maybe a -> Maybe a))]
parserOptions = [],
      parserNonOptions :: [NonOptionsParser (Maybe a)]
parserNonOptions =
        [[Char]
-> Bool
-> ([[Char]] -> Result (Maybe a -> Maybe a, [[Char]]))
-> NonOptionsParser (Maybe a)
forall uninitialized.
[Char]
-> Bool
-> ([[Char]] -> Result (uninitialized -> uninitialized, [[Char]]))
-> NonOptionsParser uninitialized
NonOptionsParser [Char]
typ Bool
False (\ ([Char]
s : [[Char]]
r) -> (a -> (Maybe a -> Maybe a, [[Char]]))
-> Result a -> Result (Maybe a -> Maybe a, [[Char]])
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((, [[Char]]
r) ((Maybe a -> Maybe a) -> (Maybe a -> Maybe a, [[Char]]))
-> (a -> Maybe a -> Maybe a) -> a -> (Maybe a -> Maybe a, [[Char]])
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, [[Char]]))
-> Result a -> Result (Maybe a -> Maybe a, [[Char]])
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [Char] -> Result a
forall a. Argument a => Maybe [Char] -> [Char] -> Result a
parseArgumentResult Maybe [Char]
forall a. Maybe a
Nothing [Char]
s)],
      parserConvert :: Maybe a -> Result a
parserConvert = \ case
        Just a
a -> a -> Result a
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        Maybe a
Nothing -> [Char] -> Result a
forall a. [Char] -> Result a
Errors ([Char] -> Result a) -> [Char] -> Result a
forall a b. (a -> b) -> a -> b
$
          [Char]
"missing argument of type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
typ
    }

    withLongOption :: Modifiers -> [Char] -> Parser Unnormalized a
withLongOption Modifiers
modifiers [Char]
long = 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 a. a -> [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
$
        [Char]
-> [[Char]]
-> ArgDescr (Result (Either () a -> Either () a))
-> [Char]
-> OptDescr (Result (Either () a -> Either () a))
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
long]
          ((Result a -> Result (Either () a -> Either () a))
-> ArgDescr (Result a)
-> ArgDescr (Result (Either () a -> Either () a))
forall a b. (a -> b) -> ArgDescr a -> ArgDescr b
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 a b. (a -> b) -> Result a -> Result b
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
$
            ([Char] -> Result a) -> [Char] -> ArgDescr (Result a)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (Maybe [Char] -> [Char] -> Result a
forall a. Argument a => Maybe [Char] -> [Char] -> Result a
parseArgumentResult Maybe [Char]
forall a. Maybe a
Nothing) [Char]
typ)
          [Char]
"",
      parserNonOptions :: [NonOptionsParser (Either () a)]
parserNonOptions = [],
      parserConvert :: Either () a -> Result a
parserConvert = \ case
        Right a
a -> a -> Result a
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        Left () -> [Char] -> Result a
forall a. [Char] -> Result a
Errors ([Char] -> Result a) -> [Char] -> Result a
forall a b. (a -> b) -> a -> b
$
          [Char]
"missing option: --" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
normalize (Modifiers -> [Char] -> [Char]
applyModifiersLong Modifiers
modifiers [Char]
long) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"=" [Char] -> [Char] -> [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 -> Parser Unnormalized [a]
forall a. Argument a => Parser Unnormalized [a]
positionalArgumentsParser
  Just [Char]
long -> Parser {
    parserDefault :: [a]
parserDefault = [],
    parserOptions :: [OptDescr (Result ([a] -> [a]))]
parserOptions = OptDescr (Result ([a] -> [a])) -> [OptDescr (Result ([a] -> [a]))]
forall a. 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
$
      [Char]
-> [[Char]]
-> ArgDescr (Result ([a] -> [a]))
-> [Char]
-> OptDescr (Result ([a] -> [a]))
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
long]
        (([Char] -> Result ([a] -> [a]))
-> [Char] -> ArgDescr (Result ([a] -> [a]))
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
          (\ [Char]
s -> (a -> [a] -> [a]) -> Result a -> Result ([a] -> [a])
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ a
a -> ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
a])) (Maybe [Char] -> [Char] -> Result a
forall a. Argument a => Maybe [Char] -> [Char] -> Result a
parseArgumentResult ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"multiple possible") [Char]
s))
          (Proxy a -> [Char]
forall a. Argument a => Proxy a -> [Char]
argumentType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (multiple possible)"))
        [Char]
"",
    parserNonOptions :: [NonOptionsParser [a]]
parserNonOptions = [],
    parserConvert :: [a] -> Result [a]
parserConvert = [a] -> Result [a]
forall a. a -> Result a
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 = [[Char]
-> Bool
-> ([[Char]] -> Result ([a] -> [a], [[Char]]))
-> NonOptionsParser [a]
forall uninitialized.
[Char]
-> Bool
-> ([[Char]] -> Result (uninitialized -> uninitialized, [[Char]]))
-> NonOptionsParser uninitialized
NonOptionsParser (Proxy a -> [Char]
forall a. Argument a => Proxy a -> [Char]
argumentType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) Bool
True [[Char]] -> Result ([a] -> [a], [[Char]])
parse],
  parserConvert :: [a] -> Result [a]
parserConvert = [a] -> Result [a]
forall a. a -> Result a
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 <- [[Char]] -> ([Char] -> Result ([a] -> [a])) -> Result [[a] -> [a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Char]]
args (([Char] -> Result ([a] -> [a])) -> Result [[a] -> [a]])
-> ([Char] -> Result ([a] -> [a])) -> Result [[a] -> [a]]
forall a b. (a -> b) -> a -> b
$ \ [Char]
arg ->
        case [Char] -> Maybe a
forall a. Argument a => [Char] -> Maybe a
parseArgument [Char]
arg of
          Just a
a -> ([a] -> [a]) -> Result ([a] -> [a])
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
          Maybe a
Nothing -> [Char] -> Maybe [Char] -> [Char] -> Result ([a] -> [a])
forall a. [Char] -> Maybe [Char] -> [Char] -> Result a
parseError (Proxy a -> [Char]
forall a. Argument a => Proxy a -> [Char]
argumentType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) Maybe [Char]
forall a. Maybe a
Nothing [Char]
arg
      ([a] -> [a], [[Char]]) -> Result ([a] -> [a], [[Char]])
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return ((([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> ([a] -> [a]) -> [[a] -> [a]] -> [a] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> b
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 :: forall a.
Argument a =>
Maybe [Char] -> Result (Parser Unnormalized (Maybe a))
maybeParser Maybe [Char]
mLong = case Maybe [Char]
mLong of
  Maybe [Char]
Nothing -> Parser Unnormalized (Maybe a)
-> Result (Parser Unnormalized (Maybe a))
forall a. a -> Result 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
$ 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 :: [[Char]] -> Result (Maybe a -> Maybe a, [[Char]])
parse ([Char]
a : [[Char]]
r) = do
            a
v <- Maybe [Char] -> [Char] -> Result a
forall a. Argument a => Maybe [Char] -> [Char] -> Result a
parseArgumentResult ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"optional") [Char]
a
            (Maybe a -> Maybe a, [[Char]])
-> Result (Maybe a -> Maybe a, [[Char]])
forall a. a -> Result a
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), [[Char]]
r)
          parse [] = (Maybe a -> Maybe a, [[Char]])
-> Result (Maybe a -> Maybe a, [[Char]])
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Maybe a
forall a. a -> a
id, [])
      in [[Char]
-> Bool
-> ([[Char]] -> Result (Maybe a -> Maybe a, [[Char]]))
-> NonOptionsParser (Maybe a)
forall uninitialized.
[Char]
-> Bool
-> ([[Char]] -> Result (uninitialized -> uninitialized, [[Char]]))
-> NonOptionsParser uninitialized
NonOptionsParser (Proxy a -> [Char]
forall a. Argument a => Proxy a -> [Char]
argumentType (Proxy a
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 = Maybe a -> Result (Maybe a)
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return
  }
  Just [Char]
long -> Parser Unnormalized (Maybe a)
-> Result (Parser Unnormalized (Maybe a))
forall a. a -> Result 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
$ 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 a. a -> [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
$
      [Char]
-> [[Char]]
-> ArgDescr (Result (Maybe a -> Maybe a))
-> [Char]
-> OptDescr (Result (Maybe a -> Maybe a))
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
long]
        (([Char] -> Result (Maybe a -> Maybe a))
-> [Char] -> ArgDescr (Result (Maybe a -> Maybe a))
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
          (\ [Char]
s -> (a -> Maybe a -> Maybe a)
-> Result a -> Result (Maybe a -> Maybe a)
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ 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 [Char] -> [Char] -> Result a
forall a. Argument a => Maybe [Char] -> [Char] -> Result a
parseArgumentResult ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"optional") [Char]
s))
          (Proxy a -> [Char]
forall a. Argument a => Proxy a -> [Char]
argumentType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (optional)"))
        [Char]
"",
    parserNonOptions :: [NonOptionsParser (Maybe a)]
parserNonOptions = [],
    parserConvert :: Maybe a -> Result (Maybe a)
parserConvert = Maybe a -> Result (Maybe a)
forall a. a -> Result a
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 = Parser Unnormalized Bool -> Result (Parser Unnormalized Bool)
forall a. a -> Result a
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 [Char]
mLong of
  Maybe [Char]
Nothing -> 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 a. a -> [a]
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
$
      ([Char]
-> Bool
-> ([[Char]] -> Result (Maybe Bool -> Maybe Bool, [[Char]]))
-> NonOptionsParser (Maybe Bool)
forall uninitialized.
[Char]
-> Bool
-> ([[Char]] -> Result (uninitialized -> uninitialized, [[Char]]))
-> NonOptionsParser uninitialized
NonOptionsParser [Char]
"BOOL" Bool
False (\ ([Char]
s : [[Char]]
r) -> (, [[Char]]
r) ((Maybe Bool -> Maybe Bool)
 -> (Maybe Bool -> Maybe Bool, [[Char]]))
-> Result (Maybe Bool -> Maybe Bool)
-> Result (Maybe Bool -> Maybe Bool, [[Char]])
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 ([Char]
-> Maybe [Char] -> [Char] -> Result (Maybe Bool -> Maybe Bool)
forall a. [Char] -> Maybe [Char] -> [Char] -> Result a
parseError [Char]
"BOOL" Maybe [Char]
forall a. Maybe a
Nothing [Char]
s) ((Maybe Bool -> Maybe Bool) -> Result (Maybe Bool -> Maybe Bool)
forall a. a -> Result a
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) ([Char] -> Maybe Bool
parseBool [Char]
s))),
    parserConvert :: Maybe Bool -> Result Bool
parserConvert = \ case
      Just Bool
x -> Bool -> Result Bool
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x
      Maybe Bool
Nothing -> [Char] -> Result Bool
forall a. [Char] -> Result a
Errors ([Char] -> Result Bool) -> [Char] -> Result Bool
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 = OptDescr (Result (Bool -> Bool))
-> [OptDescr (Result (Bool -> Bool))]
forall a. a -> [a]
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
$
      [Char]
-> [[Char]]
-> ArgDescr (Result (Bool -> Bool))
-> [Char]
-> OptDescr (Result (Bool -> Bool))
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
long]
        (Result (Bool -> Bool) -> ArgDescr (Result (Bool -> Bool))
forall a. a -> ArgDescr a
NoArg ((Bool -> Bool) -> Result (Bool -> Bool)
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True)))
        [Char]
"",
    parserNonOptions :: [NonOptionsParser Bool]
parserNonOptions = [],
    parserConvert :: Bool -> Result Bool
parserConvert = Bool -> Result Bool
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return
  }

parseBool :: String -> Maybe Bool
parseBool :: [Char] -> Maybe Bool
parseBool [Char]
s
  | (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
s [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"true", [Char]
"yes", [Char]
"on"] = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  | (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
s [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"false", [Char]
"no", [Char]
"off"] = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  | Bool
otherwise = case [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
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
> Integer
0)
    Maybe Integer
Nothing -> Maybe Bool
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 = (Parser Unnormalized (SOP I (GCode a)) -> Parser Unnormalized a)
-> Result (Parser Unnormalized (SOP I (GCode a)))
-> Result (Parser Unnormalized a)
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SOP I (GCode a) -> a)
-> Parser Unnormalized (SOP I (GCode a)) -> Parser Unnormalized a
forall a b.
(a -> b) -> Parser Unnormalized a -> Parser Unnormalized b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SOP I (GCode a) -> a
forall a. (GTo a, Generic a) => SOP I (GCode a) -> a
gto) (Result (Parser Unnormalized (SOP I (GCode a)))
 -> Result (Parser Unnormalized a))
-> Result (Parser Unnormalized (SOP I (GCode a)))
-> Result (Parser Unnormalized a)
forall a b. (a -> b) -> a -> b
$
  let datatypeInfo :: DatatypeInfo (GCode a)
datatypeInfo = Proxy a -> DatatypeInfo (GCode 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 :: forall a. [Char] -> Result a
err [Char]
message = [Char] -> Result a
forall a. [Char] -> Result a
Errors ([Char] -> Result a) -> [Char] -> Result a
forall a b. (a -> b) -> a -> b
$
        [Char]
"getopt-generics doesn't support " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
message [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
        [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DatatypeInfo (GCode a) -> [Char]
forall (xss :: [[*]]). DatatypeInfo xss -> [Char]
datatypeName DatatypeInfo (GCode a)
datatypeInfo [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")."
  in case DatatypeInfo (GCode a) -> NP ConstructorInfo (GCode a)
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 ->
          (Parser Unnormalized (NP I x)
 -> Parser Unnormalized (SOP I (GCode a)))
-> Result (Parser Unnormalized (NP I x))
-> Result (Parser Unnormalized (SOP I (GCode a)))
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NP I x -> SOP I (GCode a))
-> Parser Unnormalized (NP I x)
-> Parser Unnormalized (SOP I (GCode a))
forall a b.
(a -> b) -> Parser Unnormalized a -> Parser Unnormalized b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NS (NP I) '[x] -> SOP I '[x]
NS (NP I) '[x] -> SOP I (GCode a)
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (NS (NP I) '[x] -> SOP I (GCode a))
-> (NP I x -> NS (NP I) '[x]) -> NP I x -> SOP I (GCode a)
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 (GCode a)))
-> Result (Parser Unnormalized (NP I x))
-> Result (Parser Unnormalized (SOP I (GCode a)))
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NP I x -> SOP I (GCode a))
-> Parser Unnormalized (NP I x)
-> Parser Unnormalized (SOP I (GCode a))
forall a b.
(a -> b) -> Parser Unnormalized a -> Parser Unnormalized b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NS (NP I) '[x] -> SOP I '[x]
NS (NP I) '[x] -> SOP I (GCode a)
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (NS (NP I) '[x] -> SOP I (GCode a))
-> (NP I x -> NS (NP I) '[x]) -> NP I x -> SOP I (GCode a)
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{} -> [Char] -> Result (Parser Unnormalized (SOP I (GCode a)))
forall a. [Char] -> Result a
err [Char]
"infix constructors"
    NP ConstructorInfo (GCode a)
Nil -> [Char] -> Result (Parser Unnormalized (SOP I (GCode a)))
forall a. [Char] -> Result a
err [Char]
"empty data types"
    ConstructorInfo x
_ :* ConstructorInfo x
_ :* NP ConstructorInfo xs
_ -> [Char] -> Result (Parser Unnormalized (SOP I (GCode a)))
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 -> Parser Unnormalized (NP I xs)
-> Result (Parser Unnormalized (NP I xs))
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized (NP I xs)
 -> Result (Parser Unnormalized (NP I xs)))
-> Parser Unnormalized (NP I xs)
-> Result (Parser Unnormalized (NP I xs))
forall a b. (a -> b) -> a -> b
$ NP I xs -> Parser Unnormalized (NP I xs)
forall a phase. a -> Parser phase a
emptyParser NP I xs
NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil
  FieldInfo [Char]
fieldName :* NP FieldInfo xs
rest ->
    (Parser Unnormalized (I x, NP I xs)
 -> Parser Unnormalized (NP I xs))
-> Result (Parser Unnormalized (I x, NP I xs))
-> Result (Parser Unnormalized (NP I xs))
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((I x, NP I xs) -> NP I xs)
-> Parser Unnormalized (I x, NP I xs)
-> Parser Unnormalized (NP I xs)
forall a b.
(a -> b) -> Parser Unnormalized a -> Parser Unnormalized b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (I x
a, 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 a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> I x) -> Parser Unnormalized x -> Parser Unnormalized (I x)
forall a b.
(a -> b) -> Parser Unnormalized a -> Parser Unnormalized b
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 [Char] -> Result (Parser Unnormalized x)
forall a.
HasArguments a =>
Modifiers -> Maybe [Char] -> Result (Parser Unnormalized a)
argumentsParser Modifiers
modifiers ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
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 :: forall (xs :: [*]).
All HasArguments xs =>
Modifiers -> Shape xs -> Result (Parser Unnormalized (NP I xs))
noSelectorsParser Modifiers
modifiers = \ case
  Shape xs
ShapeNil -> Parser Unnormalized (NP I xs)
-> Result (Parser Unnormalized (NP I xs))
forall a. a -> Result a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parser Unnormalized (NP I xs)
 -> Result (Parser Unnormalized (NP I xs)))
-> Parser Unnormalized (NP I xs)
-> Result (Parser Unnormalized (NP I xs))
forall a b. (a -> b) -> a -> b
$ NP I xs -> Parser Unnormalized (NP I xs)
forall a phase. a -> Parser phase a
emptyParser NP I xs
NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil
  ShapeCons Shape xs
rest ->
    (Parser Unnormalized (I x, NP I xs)
 -> Parser Unnormalized (NP I xs))
-> Result (Parser Unnormalized (I x, NP I xs))
-> Result (Parser Unnormalized (NP I xs))
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((I x, NP I xs) -> NP I xs)
-> Parser Unnormalized (I x, NP I xs)
-> Parser Unnormalized (NP I xs)
forall a b.
(a -> b) -> Parser Unnormalized a -> Parser Unnormalized b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (I x
a, 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 a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> I x) -> Parser Unnormalized x -> Parser Unnormalized (I x)
forall a b.
(a -> b) -> Parser Unnormalized a -> Parser Unnormalized b
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 [Char] -> Result (Parser Unnormalized x)
forall a.
HasArguments a =>
Modifiers -> Maybe [Char] -> Result (Parser Unnormalized a)
argumentsParser Modifiers
modifiers Maybe [Char]
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)