{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Servant.CLI.Internal.PStruct
( OptRead (..),
Opt (..),
Arg (..),
MultiArg (..),
Captures,
Endpoint (..),
EndpointMap (..),
PStruct (..),
PStructF (..),
structParser,
structParser_,
branch,
($:>),
(%:>),
(?:>),
(#:>),
(##:>),
note,
endpoint,
rawEndpoint,
orRequired,
orOptional,
orSwitch,
)
where
import Control.Applicative.Backwards
import Control.Applicative.Free
import Data.Foldable
import Data.Function
import Data.Functor
import Data.Functor.Combinator
import Data.Functor.Combinator.Unsafe
import Data.Functor.Foldable
import Data.Functor.Foldable.TH
import Data.Kind
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Proxy
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Types as HTTP
import Options.Applicative
import qualified Options.Applicative.Help.Pretty as O
import System.FilePath
data OptRead :: Type -> Type where
ORRequired :: ReadM a -> OptRead a
OROptional :: ReadM a -> OptRead (Maybe a)
ORSwitch :: OptRead Bool
data Opt a = Opt
{ forall a. Opt a -> String
optName :: String,
forall a. Opt a -> String
optDesc :: String,
forall a. Opt a -> String
optMeta :: String,
forall a. Opt a -> Maybe (NonEmpty String)
optVals :: Maybe (NonEmpty String),
forall a. Opt a -> Coyoneda OptRead a
optRead :: Coyoneda OptRead a
}
deriving ((forall a b. (a -> b) -> Opt a -> Opt b)
-> (forall a b. a -> Opt b -> Opt a) -> Functor Opt
forall a b. a -> Opt b -> Opt a
forall a b. (a -> b) -> Opt a -> Opt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Opt a -> Opt b
fmap :: forall a b. (a -> b) -> Opt a -> Opt b
$c<$ :: forall a b. a -> Opt b -> Opt a
<$ :: forall a b. a -> Opt b -> Opt a
Functor)
data Arg a = Arg
{ forall a. Arg a -> String
argName :: String,
forall a. Arg a -> String
argDesc :: String,
forall a. Arg a -> String
argMeta :: String,
forall a. Arg a -> ReadM a
argRead :: ReadM a
}
deriving ((forall a b. (a -> b) -> Arg a -> Arg b)
-> (forall a b. a -> Arg b -> Arg a) -> Functor Arg
forall a b. a -> Arg b -> Arg a
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Arg a -> Arg b
fmap :: forall a b. (a -> b) -> Arg a -> Arg b
$c<$ :: forall a b. a -> Arg b -> Arg a
<$ :: forall a b. a -> Arg b -> Arg a
Functor)
data MultiArg :: Type -> Type where
MultiArg :: Arg a -> MultiArg [a]
data EndpointMap a = EPM
{ forall a. EndpointMap a -> Map Method (Endpoint a)
epmGiven :: Map HTTP.Method (Endpoint a),
forall a. EndpointMap a -> Maybe (Endpoint (Method -> a))
epmRaw :: Maybe (Endpoint (HTTP.Method -> a))
}
deriving ((forall a b. (a -> b) -> EndpointMap a -> EndpointMap b)
-> (forall a b. a -> EndpointMap b -> EndpointMap a)
-> Functor EndpointMap
forall a b. a -> EndpointMap b -> EndpointMap a
forall a b. (a -> b) -> EndpointMap a -> EndpointMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> EndpointMap a -> EndpointMap b
fmap :: forall a b. (a -> b) -> EndpointMap a -> EndpointMap b
$c<$ :: forall a b. a -> EndpointMap b -> EndpointMap a
<$ :: forall a b. a -> EndpointMap b -> EndpointMap a
Functor)
type Captures =
Day Arg PStruct
:+: Day MultiArg EndpointMap
newtype Endpoint a = Endpoint
{forall a. Endpoint a -> Day (Ap Opt) Parser a
epStruct :: Day (Ap Opt) Parser a}
deriving ((forall a b. (a -> b) -> Endpoint a -> Endpoint b)
-> (forall a b. a -> Endpoint b -> Endpoint a) -> Functor Endpoint
forall a b. a -> Endpoint b -> Endpoint a
forall a b. (a -> b) -> Endpoint a -> Endpoint b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Endpoint a -> Endpoint b
fmap :: forall a b. (a -> b) -> Endpoint a -> Endpoint b
$c<$ :: forall a b. a -> Endpoint b -> Endpoint a
<$ :: forall a b. a -> Endpoint b -> Endpoint a
Functor)
data PStruct a = PStruct
{ forall a. PStruct a -> [String]
psInfo :: [String],
forall a. PStruct a -> Map String (PStruct a)
psComponents :: Map String (PStruct a),
forall a. PStruct a -> Maybe (Captures a)
psCaptures :: Maybe (Captures a),
forall a. PStruct a -> EndpointMap a
psEndpoints :: EndpointMap a
}
deriving ((forall a b. (a -> b) -> PStruct a -> PStruct b)
-> (forall a b. a -> PStruct b -> PStruct a) -> Functor PStruct
forall a b. a -> PStruct b -> PStruct a
forall a b. (a -> b) -> PStruct a -> PStruct b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PStruct a -> PStruct b
fmap :: forall a b. (a -> b) -> PStruct a -> PStruct b
$c<$ :: forall a b. a -> PStruct b -> PStruct a
<$ :: forall a b. a -> PStruct b -> PStruct a
Functor)
makeBaseFunctor ''PStruct
structParser ::
PStruct a ->
InfoMod a ->
ParserInfo a
structParser :: forall a. PStruct a -> InfoMod a -> ParserInfo a
structParser = (InfoMod a -> PStruct a -> ParserInfo a)
-> PStruct a -> InfoMod a -> ParserInfo a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((InfoMod a -> PStruct a -> ParserInfo a)
-> PStruct a -> InfoMod a -> ParserInfo a)
-> (InfoMod a -> PStruct a -> ParserInfo a)
-> PStruct a
-> InfoMod a
-> ParserInfo a
forall a b. (a -> b) -> a -> b
$ \InfoMod a
im -> ((InfoMod a -> ParserInfo a) -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$ InfoMod a
im) ((InfoMod a -> ParserInfo a) -> ParserInfo a)
-> (PStruct a -> InfoMod a -> ParserInfo a)
-> PStruct a
-> ParserInfo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String] -> InfoMod a -> ParserInfo a)
-> [String] -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$ []) (([String] -> InfoMod a -> ParserInfo a)
-> InfoMod a -> ParserInfo a)
-> (PStruct a -> [String] -> InfoMod a -> ParserInfo a)
-> PStruct a
-> InfoMod a
-> ParserInfo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> [String] -> InfoMod a -> ParserInfo a)
-> Bool -> [String] -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$ Bool
True) ((Bool -> [String] -> InfoMod a -> ParserInfo a)
-> [String] -> InfoMod a -> ParserInfo a)
-> (PStruct a -> Bool -> [String] -> InfoMod a -> ParserInfo a)
-> PStruct a
-> [String]
-> InfoMod a
-> ParserInfo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PStruct a -> Bool -> [String] -> InfoMod a -> ParserInfo a
forall a.
PStruct a -> Bool -> [String] -> InfoMod a -> ParserInfo a
structParser_
structParser_ ::
PStruct a ->
Bool ->
[String] ->
InfoMod a ->
ParserInfo a
structParser_ :: forall a.
PStruct a -> Bool -> [String] -> InfoMod a -> ParserInfo a
structParser_ = (Base (PStruct a) (Bool -> [String] -> InfoMod a -> ParserInfo a)
-> Bool -> [String] -> InfoMod a -> ParserInfo a)
-> PStruct a -> Bool -> [String] -> InfoMod a -> ParserInfo a
forall t a. Recursive t => (Base t a -> a) -> t -> a
forall a. (Base (PStruct a) a -> a) -> PStruct a -> a
cata Base (PStruct a) (Bool -> [String] -> InfoMod a -> ParserInfo a)
-> Bool -> [String] -> InfoMod a -> ParserInfo a
PStructF a (Bool -> [String] -> InfoMod a -> ParserInfo a)
-> Bool -> [String] -> InfoMod a -> ParserInfo a
forall x.
PStructF x (Bool -> [String] -> InfoMod x -> ParserInfo x)
-> Bool -> [String] -> InfoMod x -> ParserInfo x
go
where
go ::
PStructF x (Bool -> [String] -> InfoMod x -> ParserInfo x) ->
Bool ->
[String] ->
InfoMod x ->
ParserInfo x
go :: forall x.
PStructF x (Bool -> [String] -> InfoMod x -> ParserInfo x)
-> Bool -> [String] -> InfoMod x -> ParserInfo x
go PStructF {[String]
Maybe ((:+:) (Day Arg PStruct) (Day MultiArg EndpointMap) x)
Map String (Bool -> [String] -> InfoMod x -> ParserInfo x)
EndpointMap x
psInfoF :: forall a r. PStructF a r -> [String]
psComponentsF :: forall a r. PStructF a r -> Map String r
psCapturesF :: forall a r. PStructF a r -> Maybe (Captures a)
psEndpointsF :: forall a r. PStructF a r -> EndpointMap a
psInfoF :: [String]
psComponentsF :: Map String (Bool -> [String] -> InfoMod x -> ParserInfo x)
psCapturesF :: Maybe ((:+:) (Day Arg PStruct) (Day MultiArg EndpointMap) x)
psEndpointsF :: EndpointMap x
..} Bool
toHelp [String]
p InfoMod x
im =
Parser x -> InfoMod x -> ParserInfo x
forall a. Parser a -> InfoMod a -> ParserInfo a
info ((Parser x
subp Parser x -> Parser x -> Parser x
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser x
cap Parser x -> Parser x -> Parser x
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser x
ep) Parser x -> Parser (x -> x) -> Parser x
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (x -> x)
mkHelp) (InfoMod x -> ParserInfo x) -> InfoMod x -> ParserInfo x
forall a b. (a -> b) -> a -> b
$
InfoMod x
forall a. InfoMod a
fullDesc
InfoMod x -> InfoMod x -> InfoMod x
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod x
forall a. String -> InfoMod a
header ([String] -> String
joinPath [String]
p)
InfoMod x -> InfoMod x -> InfoMod x
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod x
forall a. Maybe Doc -> InfoMod a
progDescDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just ([Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
O.vcat ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
O.pretty ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ [String]
ns))
InfoMod x -> InfoMod x -> InfoMod x
forall a. Semigroup a => a -> a -> a
<> InfoMod x
im
where
subs :: Mod CommandFields x
subs = (String
-> (Bool -> [String] -> InfoMod x -> ParserInfo x)
-> Mod CommandFields x)
-> Map String (Bool -> [String] -> InfoMod x -> ParserInfo x)
-> Mod CommandFields x
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey ([String]
-> String
-> (Bool -> [String] -> InfoMod x -> ParserInfo x)
-> Mod CommandFields x
forall x.
[String]
-> String
-> (Bool -> [String] -> InfoMod x -> ParserInfo x)
-> Mod CommandFields x
mkCmd [String]
p) Map String (Bool -> [String] -> InfoMod x -> ParserInfo x)
psComponentsF
subp :: Parser x
subp
| Map String (Bool -> [String] -> InfoMod x -> ParserInfo x) -> Bool
forall k a. Map k a -> Bool
M.null Map String (Bool -> [String] -> InfoMod x -> ParserInfo x)
psComponentsF = Parser x
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
| Bool
otherwise =
Mod CommandFields x -> Parser x
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields x -> Parser x)
-> Mod CommandFields x -> Parser x
forall a b. (a -> b) -> a -> b
$
Mod CommandFields x
subs
Mod CommandFields x -> Mod CommandFields x -> Mod CommandFields x
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields x
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"COMPONENT"
Mod CommandFields x -> Mod CommandFields x -> Mod CommandFields x
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields x
forall a. String -> Mod CommandFields a
commandGroup String
"Path components:"
cap :: Parser x
cap =
Proxy Parser -> (Plus Parser => Parser x) -> Parser x
forall (f :: * -> *) (proxy :: (* -> *) -> *) r.
Alternative f =>
proxy f -> (Plus f => r) -> r
unsafePlus (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Parser) ((Plus Parser => Parser x) -> Parser x)
-> (Plus Parser => Parser x) -> Parser x
forall a b. (a -> b) -> a -> b
$
((Day Arg PStruct :+: Day MultiArg EndpointMap) ~> Parser)
-> MaybeF (Day Arg PStruct :+: Day MultiArg EndpointMap) ~> Parser
forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
forall (g :: * -> *). (g ~> Parser) -> MaybeF g ~> Parser
interpret ([String] -> Day Arg PStruct x -> Parser x
forall x. [String] -> Day Arg PStruct x -> Parser x
mkArg [String]
p (forall {x}. Day Arg PStruct x -> Parser x)
-> (Day MultiArg EndpointMap ~> Parser)
-> (Day Arg PStruct :+: Day MultiArg EndpointMap) ~> Parser
forall (t :: (* -> *) -> (* -> *) -> * -> *) (h :: * -> *)
(f :: * -> *) (g :: * -> *).
SemigroupIn t h =>
(f ~> h) -> (g ~> h) -> t f g ~> h
!*! Day MultiArg EndpointMap x -> Parser x
Day MultiArg EndpointMap ~> Parser
mkArgs) (MaybeF (Day Arg PStruct :+: Day MultiArg EndpointMap) x
-> Parser x)
-> MaybeF (Day Arg PStruct :+: Day MultiArg EndpointMap) x
-> Parser x
forall a b. (a -> b) -> a -> b
$
Maybe ((:+:) (Day Arg PStruct) (Day MultiArg EndpointMap) x)
-> MaybeF (Day Arg PStruct :+: Day MultiArg EndpointMap) x
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> MaybeF f a
MaybeF Maybe ((:+:) (Day Arg PStruct) (Day MultiArg EndpointMap) x)
psCapturesF
ep :: Parser x
ep = EndpointMap x -> Parser x
forall x. EndpointMap x -> Parser x
methodPicker EndpointMap x
psEndpointsF
ns :: [String]
ns = [String]
psInfoF
mkHelp :: Parser (x -> x)
mkHelp
| Bool
toHelp = Parser (x -> x)
forall a. Parser (a -> a)
helper
| Bool
otherwise = (x -> x) -> Parser (x -> x)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x -> x
forall a. a -> a
id
mkCmd ::
[String] ->
String ->
(Bool -> [String] -> InfoMod x -> ParserInfo x) ->
Mod CommandFields x
mkCmd :: forall x.
[String]
-> String
-> (Bool -> [String] -> InfoMod x -> ParserInfo x)
-> Mod CommandFields x
mkCmd [String]
ps String
c Bool -> [String] -> InfoMod x -> ParserInfo x
p = String -> ParserInfo x -> Mod CommandFields x
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
c (Bool -> [String] -> InfoMod x -> ParserInfo x
p Bool
True ([String]
ps [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
c]) InfoMod x
forall a. Monoid a => a
mempty)
mkArg :: [String] -> Day Arg PStruct x -> Parser x
mkArg :: forall x. [String] -> Day Arg PStruct x -> Parser x
mkArg [String]
ps (Day Arg b
a PStruct c
p b -> c -> x
f) =
b -> c -> x
f
(b -> c -> x) -> Parser b -> Parser (c -> x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arg b -> Parser b
forall x. Arg x -> Parser x
argParser Arg b
a
Parser (c -> x) -> Parser c -> Parser x
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserInfo c -> Parser c
forall a. ParserInfo a -> Parser a
infoParser (PStruct c -> Bool -> [String] -> InfoMod c -> ParserInfo c
forall a.
PStruct a -> Bool -> [String] -> InfoMod a -> ParserInfo a
structParser_ PStruct c
p Bool
False ([String]
ps [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: Arg b -> String
forall a. Arg a -> String
argName Arg b
a]) InfoMod c
forall a. Monoid a => a
mempty)
mkArgs :: Day MultiArg EndpointMap x -> Parser x
mkArgs :: Day MultiArg EndpointMap ~> Parser
mkArgs =
Proxy Parser
-> (Apply Parser => Day MultiArg EndpointMap x -> Parser x)
-> Day MultiArg EndpointMap x
-> Parser x
forall (f :: * -> *) (proxy :: (* -> *) -> *) r.
Applicative f =>
proxy f -> (Apply f => r) -> r
unsafeApply (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Parser) ((Apply Parser => Day MultiArg EndpointMap x -> Parser x)
-> Day MultiArg EndpointMap x -> Parser x)
-> (Apply Parser => Day MultiArg EndpointMap x -> Parser x)
-> Day MultiArg EndpointMap x
-> Parser x
forall a b. (a -> b) -> a -> b
$
Backwards Parser x -> Parser x
forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
(Backwards Parser x -> Parser x)
-> (Day MultiArg EndpointMap x -> Backwards Parser x)
-> Day MultiArg EndpointMap x
-> Parser x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( Parser x -> Backwards Parser x
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (Parser x -> Backwards Parser x)
-> (MultiArg x -> Parser x) -> MultiArg x -> Backwards Parser x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\case MultiArg Arg a
a -> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Arg a -> Parser a
forall x. Arg x -> Parser x
argParser Arg a
a))
(forall {x}. MultiArg x -> Backwards Parser x)
-> (EndpointMap ~> Backwards Parser)
-> Day MultiArg EndpointMap ~> Backwards Parser
forall (t :: (* -> *) -> (* -> *) -> * -> *) (h :: * -> *)
(f :: * -> *) (g :: * -> *).
SemigroupIn t h =>
(f ~> h) -> (g ~> h) -> t f g ~> h
!*! Parser x -> Backwards Parser x
forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (Parser x -> Backwards Parser x)
-> (EndpointMap x -> Parser x)
-> EndpointMap x
-> Backwards Parser x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndpointMap x -> Parser x
forall x. EndpointMap x -> Parser x
methodPicker
)
argParser :: Arg x -> Parser x
argParser :: forall x. Arg x -> Parser x
argParser Arg {String
ReadM x
argName :: forall a. Arg a -> String
argDesc :: forall a. Arg a -> String
argMeta :: forall a. Arg a -> String
argRead :: forall a. Arg a -> ReadM a
argName :: String
argDesc :: String
argMeta :: String
argRead :: ReadM x
..} =
ReadM x -> Mod ArgumentFields x -> Parser x
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM x
argRead (Mod ArgumentFields x -> Parser x)
-> Mod ArgumentFields x -> Parser x
forall a b. (a -> b) -> a -> b
$
String -> Mod ArgumentFields x
forall (f :: * -> *) a. String -> Mod f a
help String
argDesc
Mod ArgumentFields x
-> Mod ArgumentFields x -> Mod ArgumentFields x
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields x
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
argMeta
mkOpt :: Opt x -> Parser x
mkOpt :: forall x. Opt x -> Parser x
mkOpt Opt {String
Maybe (NonEmpty String)
Coyoneda OptRead x
optName :: forall a. Opt a -> String
optDesc :: forall a. Opt a -> String
optMeta :: forall a. Opt a -> String
optVals :: forall a. Opt a -> Maybe (NonEmpty String)
optRead :: forall a. Opt a -> Coyoneda OptRead a
optName :: String
optDesc :: String
optMeta :: String
optVals :: Maybe (NonEmpty String)
optRead :: Coyoneda OptRead x
..} = Coyoneda OptRead x
-> (forall {x}. OptRead x -> Parser x) -> Parser x
forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *)
(a :: k).
Interpret t f =>
t g a -> (g ~> f) -> f a
forI Coyoneda OptRead x
optRead ((forall {x}. OptRead x -> Parser x) -> Parser x)
-> (forall {x}. OptRead x -> Parser x) -> Parser x
forall a b. (a -> b) -> a -> b
$ \case
ORRequired ReadM x
r -> ReadM x -> Mod OptionFields x -> Parser x
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM x
r Mod OptionFields x
forall y. Mod OptionFields y
mods
OROptional ReadM a
r -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser a -> Parser (Maybe a)) -> Parser a -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
r Mod OptionFields a
forall y. Mod OptionFields y
mods
OptRead x
ORSwitch -> Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
optName Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
optDesc
where
mods :: Mod OptionFields y
mods :: forall y. Mod OptionFields y
mods =
String -> Mod OptionFields y
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
optName
Mod OptionFields y -> Mod OptionFields y -> Mod OptionFields y
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields y
forall (f :: * -> *) a. String -> Mod f a
help String
optDesc
Mod OptionFields y -> Mod OptionFields y -> Mod OptionFields y
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields y
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
optMeta
Mod OptionFields y -> Mod OptionFields y -> Mod OptionFields y
forall a. Semigroup a => a -> a -> a
<> (NonEmpty String -> Mod OptionFields y)
-> Maybe (NonEmpty String) -> Mod OptionFields y
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([String] -> Mod OptionFields y
forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
completeWith ([String] -> Mod OptionFields y)
-> (NonEmpty String -> [String])
-> NonEmpty String
-> Mod OptionFields y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) Maybe (NonEmpty String)
optVals
methodPicker :: EndpointMap x -> Parser x
methodPicker :: forall x. EndpointMap x -> Parser x
methodPicker (EPM Map Method (Endpoint x)
eps Maybe (Endpoint (Method -> x))
rw) = case Map Method (Parser x) -> Maybe (Parser x, Map Method (Parser x))
forall k a. Map k a -> Maybe (a, Map k a)
M.minView Map Method (Parser x)
epMap of
Maybe (Parser x, Map Method (Parser x))
Nothing -> Parser x
-> (Endpoint (Method -> x) -> Parser x)
-> Maybe (Endpoint (Method -> x))
-> Parser x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser x
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty Endpoint (Method -> x) -> Parser x
forall x. Endpoint (Method -> x) -> Parser x
mkRaw Maybe (Endpoint (Method -> x))
rw
Just (Parser x
m0, Map Method (Parser x)
ms)
| Map Method (Parser x) -> Bool
forall k a. Map k a -> Bool
M.null Map Method (Parser x)
ms Bool -> Bool -> Bool
&& Maybe (Endpoint (Method -> x)) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Endpoint (Method -> x))
rw -> Parser x
m0
| Bool
otherwise ->
Mod CommandFields x -> Parser x
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields x -> Parser x)
-> Mod CommandFields x -> Parser x
forall a b. (a -> b) -> a -> b
$
(Method -> Parser x -> Mod CommandFields x)
-> Map Method (Parser x) -> Mod CommandFields x
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey Method -> Parser x -> Mod CommandFields x
forall x. Method -> Parser x -> Mod CommandFields x
pickMethod Map Method (Parser x)
epMap
Mod CommandFields x -> Mod CommandFields x -> Mod CommandFields x
forall a. Semigroup a => a -> a -> a
<> (Endpoint (Method -> x) -> Mod CommandFields x)
-> Maybe (Endpoint (Method -> x)) -> Mod CommandFields x
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Endpoint (Method -> x) -> Mod CommandFields x
forall x. Endpoint (Method -> x) -> Mod CommandFields x
mkRawCommand Maybe (Endpoint (Method -> x))
rw
Mod CommandFields x -> Mod CommandFields x -> Mod CommandFields x
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields x
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"METHOD"
Mod CommandFields x -> Mod CommandFields x -> Mod CommandFields x
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields x
forall a. String -> Mod CommandFields a
commandGroup String
"HTTP Methods:"
where
epMap :: Map Method (Parser x)
epMap = Endpoint x -> Parser x
forall x. Endpoint x -> Parser x
mkEndpoint (Endpoint x -> Parser x)
-> Map Method (Endpoint x) -> Map Method (Parser x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Method (Endpoint x)
eps
mkEndpoint :: Endpoint x -> Parser x
mkEndpoint :: forall x. Endpoint x -> Parser x
mkEndpoint =
Proxy Parser
-> (Apply Parser => Endpoint x -> Parser x)
-> Endpoint x
-> Parser x
forall (f :: * -> *) (proxy :: (* -> *) -> *) r.
Applicative f =>
proxy f -> (Apply f => r) -> r
unsafeApply (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Parser) ((Apply Parser => Endpoint x -> Parser x)
-> Endpoint x -> Parser x)
-> (Apply Parser => Endpoint x -> Parser x)
-> Endpoint x
-> Parser x
forall a b. (a -> b) -> a -> b
$
(Ap Opt ~> Parser)
-> (Parser ~> Parser) -> Day (Ap Opt) Parser ~> Parser
forall (g :: * -> *) (h :: * -> *).
(g ~> Parser) -> (h ~> Parser) -> Day g h ~> Parser
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
SemigroupIn t f =>
(g ~> f) -> (h ~> f) -> t g h ~> f
binterpret ((forall x. Opt x -> Parser x) -> Ap Opt ~> Parser
forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
forall (g :: * -> *). (g ~> Parser) -> Ap g ~> Parser
interpret Opt x -> Parser x
forall x. Opt x -> Parser x
mkOpt) Parser x -> Parser x
forall a. a -> a
Parser ~> Parser
id
(Day (Ap Opt) Parser x -> Parser x)
-> (Endpoint x -> Day (Ap Opt) Parser x) -> Endpoint x -> Parser x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoint x -> Day (Ap Opt) Parser x
forall a. Endpoint a -> Day (Ap Opt) Parser a
epStruct
pickMethod :: HTTP.Method -> Parser x -> Mod CommandFields x
pickMethod :: forall x. Method -> Parser x -> Mod CommandFields x
pickMethod Method
m Parser x
p = String -> ParserInfo x -> Mod CommandFields x
forall a. String -> ParserInfo a -> Mod CommandFields a
command (Text -> String
T.unpack (Text -> String) -> (Method -> Text) -> Method -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text
T.decodeUtf8 (Method -> String) -> Method -> String
forall a b. (a -> b) -> a -> b
$ Method
m) (ParserInfo x -> Mod CommandFields x)
-> ParserInfo x -> Mod CommandFields x
forall a b. (a -> b) -> a -> b
$ Parser x -> InfoMod x -> ParserInfo x
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser x
p Parser x -> Parser (x -> x) -> Parser x
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (x -> x)
forall a. Parser (a -> a)
helper) InfoMod x
forall a. Monoid a => a
mempty
mkRaw :: Endpoint (HTTP.Method -> x) -> Parser x
mkRaw :: forall x. Endpoint (Method -> x) -> Parser x
mkRaw Endpoint (Method -> x)
e = Endpoint (Method -> x) -> Parser (Method -> x)
forall x. Endpoint x -> Parser x
mkEndpoint Endpoint (Method -> x)
e Parser (Method -> x) -> Parser Method -> Parser x
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Method
o
where
o :: Parser Method
o =
forall s. IsString s => Mod OptionFields s -> Parser s
strOption @HTTP.Method (Mod OptionFields Method -> Parser Method)
-> Mod OptionFields Method -> Parser Method
forall a b. (a -> b) -> a -> b
$
String -> Mod OptionFields Method
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"method"
Mod OptionFields Method
-> Mod OptionFields Method -> Mod OptionFields Method
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Method
forall (f :: * -> *) a. String -> Mod f a
help String
"method for raw request (GET, POST, etc.)"
Mod OptionFields Method
-> Mod OptionFields Method -> Mod OptionFields Method
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Method
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"METHOD"
Mod OptionFields Method
-> Mod OptionFields Method -> Mod OptionFields Method
forall a. Semigroup a => a -> a -> a
<> [String] -> Mod OptionFields Method
forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
completeWith (StdMethod -> String
forall a. Show a => a -> String
show (StdMethod -> String) -> [StdMethod] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [StdMethod
HTTP.GET ..])
mkRawCommand :: Endpoint (HTTP.Method -> x) -> Mod CommandFields x
mkRawCommand :: forall x. Endpoint (Method -> x) -> Mod CommandFields x
mkRawCommand Endpoint (Method -> x)
d = String -> ParserInfo x -> Mod CommandFields x
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"RAW" (ParserInfo x -> Mod CommandFields x)
-> ParserInfo x -> Mod CommandFields x
forall a b. (a -> b) -> a -> b
$ Parser x -> InfoMod x -> ParserInfo x
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Endpoint (Method -> x) -> Parser x
forall x. Endpoint (Method -> x) -> Parser x
mkRaw Endpoint (Method -> x)
d Parser x -> Parser (x -> x) -> Parser x
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (x -> x)
forall a. Parser (a -> a)
helper) InfoMod x
forall a. Monoid a => a
mempty
instance Semigroup (EndpointMap a) where
<> :: EndpointMap a -> EndpointMap a -> EndpointMap a
(<>) = EndpointMap a -> EndpointMap a -> EndpointMap a
forall a. EndpointMap a -> EndpointMap a -> EndpointMap a
altEPM
instance Monoid (EndpointMap a) where
mempty :: EndpointMap a
mempty = Map Method (Endpoint a)
-> Maybe (Endpoint (Method -> a)) -> EndpointMap a
forall a.
Map Method (Endpoint a)
-> Maybe (Endpoint (Method -> a)) -> EndpointMap a
EPM Map Method (Endpoint a)
forall k a. Map k a
M.empty Maybe (Endpoint (Method -> a))
forall a. Maybe a
Nothing
altEPM :: EndpointMap a -> EndpointMap a -> EndpointMap a
altEPM :: forall a. EndpointMap a -> EndpointMap a -> EndpointMap a
altEPM (EPM Map Method (Endpoint a)
e1 Maybe (Endpoint (Method -> a))
r1) (EPM Map Method (Endpoint a)
e2 Maybe (Endpoint (Method -> a))
r2) = Map Method (Endpoint a)
-> Maybe (Endpoint (Method -> a)) -> EndpointMap a
forall a.
Map Method (Endpoint a)
-> Maybe (Endpoint (Method -> a)) -> EndpointMap a
EPM Map Method (Endpoint a)
e3 Maybe (Endpoint (Method -> a))
r3
where
e3 :: Map Method (Endpoint a)
e3 = case Maybe (Endpoint (Method -> a))
r1 of
Just Endpoint (Method -> a)
_ -> Map Method (Endpoint a)
e1
Maybe (Endpoint (Method -> a))
Nothing -> (Endpoint a -> Endpoint a -> Endpoint a)
-> Map Method (Endpoint a)
-> Map Method (Endpoint a)
-> Map Method (Endpoint a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Endpoint a -> Endpoint a -> Endpoint a
forall a b. a -> b -> a
const Map Method (Endpoint a)
e1 Map Method (Endpoint a)
e2
r3 :: Maybe (Endpoint (Method -> a))
r3 = Maybe (Endpoint (Method -> a))
r1 Maybe (Endpoint (Method -> a))
-> Maybe (Endpoint (Method -> a)) -> Maybe (Endpoint (Method -> a))
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Endpoint (Method -> a))
r2
altPStruct :: PStruct a -> PStruct a -> PStruct a
altPStruct :: forall a. PStruct a -> PStruct a -> PStruct a
altPStruct (PStruct [String]
ns1 Map String (PStruct a)
cs1 Maybe (Captures a)
c1 EndpointMap a
ep1) (PStruct [String]
ns2 Map String (PStruct a)
cs2 Maybe (Captures a)
c2 EndpointMap a
ep2) =
[String]
-> Map String (PStruct a)
-> Maybe (Captures a)
-> EndpointMap a
-> PStruct a
forall a.
[String]
-> Map String (PStruct a)
-> Maybe (Captures a)
-> EndpointMap a
-> PStruct a
PStruct [String]
ns3 Map String (PStruct a)
cs3 Maybe (Captures a)
c3 EndpointMap a
ep3
where
ns3 :: [String]
ns3 = [String]
ns1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ns2
cs3 :: Map String (PStruct a)
cs3 = case Maybe (Captures a)
c1 of
Just Captures a
_ -> Map String (PStruct a)
cs1
Maybe (Captures a)
Nothing -> (PStruct a -> PStruct a -> PStruct a)
-> Map String (PStruct a)
-> Map String (PStruct a)
-> Map String (PStruct a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith PStruct a -> PStruct a -> PStruct a
forall a. PStruct a -> PStruct a -> PStruct a
altPStruct Map String (PStruct a)
cs1 Map String (PStruct a)
cs2
c3 :: Maybe (Captures a)
c3 = Maybe (Captures a)
c1 Maybe (Captures a) -> Maybe (Captures a) -> Maybe (Captures a)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Captures a)
c2
ep3 :: EndpointMap a
ep3 = EndpointMap a
ep1 EndpointMap a -> EndpointMap a -> EndpointMap a
forall a. Semigroup a => a -> a -> a
<> EndpointMap a
ep2
instance Semigroup (PStruct a) where
<> :: PStruct a -> PStruct a -> PStruct a
(<>) = PStruct a -> PStruct a -> PStruct a
forall a. PStruct a -> PStruct a -> PStruct a
altPStruct
instance Monoid (PStruct a) where
mempty :: PStruct a
mempty = [String]
-> Map String (PStruct a)
-> Maybe (Captures a)
-> EndpointMap a
-> PStruct a
forall a.
[String]
-> Map String (PStruct a)
-> Maybe (Captures a)
-> EndpointMap a
-> PStruct a
PStruct [] Map String (PStruct a)
forall k a. Map k a
M.empty Maybe (Captures a)
forall a. Maybe a
Nothing EndpointMap a
forall a. Monoid a => a
mempty
branch :: PStruct a -> PStruct b -> PStruct (Either a b)
branch :: forall a b. PStruct a -> PStruct b -> PStruct (Either a b)
branch PStruct a
x PStruct b
y = (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> PStruct a -> PStruct (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PStruct a
x) PStruct (Either a b)
-> PStruct (Either a b) -> PStruct (Either a b)
forall a. PStruct a -> PStruct a -> PStruct a
`altPStruct` (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> PStruct b -> PStruct (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PStruct b
y)
infixr 3 `branch`
($:>) :: String -> PStruct a -> PStruct a
String
c $:> :: forall a. String -> PStruct a -> PStruct a
$:> PStruct a
p = PStruct a
forall a. Monoid a => a
mempty {psComponents = M.singleton c p}
infixr 4 $:>
(?:>) :: Opt a -> PStruct (a -> b) -> PStruct b
Opt a
o ?:> :: forall a b. Opt a -> PStruct (a -> b) -> PStruct b
?:> PStruct [String]
ns Map String (PStruct (a -> b))
cs Maybe (Captures (a -> b))
c EndpointMap (a -> b)
ep = [String]
-> Map String (PStruct b)
-> Maybe (Captures b)
-> EndpointMap b
-> PStruct b
forall a.
[String]
-> Map String (PStruct a)
-> Maybe (Captures a)
-> EndpointMap a
-> PStruct a
PStruct [String]
ns Map String (PStruct b)
cs' Maybe (Captures b)
c' EndpointMap b
ep'
where
cs' :: Map String (PStruct b)
cs' = (Opt a
o Opt a -> PStruct (a -> b) -> PStruct b
forall a b. Opt a -> PStruct (a -> b) -> PStruct b
?:>) (PStruct (a -> b) -> PStruct b)
-> Map String (PStruct (a -> b)) -> Map String (PStruct b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (PStruct (a -> b))
cs
c' :: Maybe (Captures b)
c' =
Maybe (Captures (a -> b))
c Maybe (Captures (a -> b))
-> (Captures (a -> b) -> Captures b) -> Maybe (Captures b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
L1 (Day Arg b
a PStruct c
p b -> c -> a -> b
f) ->
let f' :: c -> a -> b -> b
f' c
x a
y b
z = b -> c -> a -> b
f b
z c
x a
y
in Day Arg PStruct b -> Captures b
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Day Arg PStruct b -> Captures b)
-> Day Arg PStruct b -> Captures b
forall a b. (a -> b) -> a -> b
$ Arg b
-> PStruct (b -> b) -> (b -> (b -> b) -> b) -> Day Arg PStruct b
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day Arg b
a (Opt a
o Opt a -> PStruct (a -> b -> b) -> PStruct (b -> b)
forall a b. Opt a -> PStruct (a -> b) -> PStruct b
?:> (c -> a -> b -> b
f' (c -> a -> b -> b) -> PStruct c -> PStruct (a -> b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PStruct c
p)) b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
(&)
R1 (Day MultiArg b
a EndpointMap c
p b -> c -> a -> b
f) ->
let f' :: c -> a -> b -> b
f' c
x a
y b
z = b -> c -> a -> b
f b
z c
x a
y
in Day MultiArg EndpointMap b -> Captures b
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Day MultiArg EndpointMap b -> Captures b)
-> Day MultiArg EndpointMap b -> Captures b
forall a b. (a -> b) -> a -> b
$ MultiArg b
-> EndpointMap (b -> b)
-> (b -> (b -> b) -> b)
-> Day MultiArg EndpointMap b
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day MultiArg b
a (Opt a -> EndpointMap (a -> b -> b) -> EndpointMap (b -> b)
forall a b. Opt a -> EndpointMap (a -> b) -> EndpointMap b
addEPMOpt Opt a
o (c -> a -> b -> b
f' (c -> a -> b -> b) -> EndpointMap c -> EndpointMap (a -> b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EndpointMap c
p)) b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
(&)
ep' :: EndpointMap b
ep' = Opt a -> EndpointMap (a -> b) -> EndpointMap b
forall a b. Opt a -> EndpointMap (a -> b) -> EndpointMap b
addEPMOpt Opt a
o EndpointMap (a -> b)
ep
infixr 4 ?:>
addEndpointOpt :: Opt a -> Endpoint (a -> b) -> Endpoint b
addEndpointOpt :: forall a b. Opt a -> Endpoint (a -> b) -> Endpoint b
addEndpointOpt Opt a
o (Endpoint (Day Ap Opt b
eo Parser c
eb b -> c -> a -> b
ef)) =
Day (Ap Opt) Parser b -> Endpoint b
forall a. Day (Ap Opt) Parser a -> Endpoint a
Endpoint (Ap Opt (a, b)
-> Parser c -> ((a, b) -> c -> b) -> Day (Ap Opt) Parser b
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day ((,) (a -> b -> (a, b)) -> Ap Opt a -> Ap Opt (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Opt a -> Ap Opt a
forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
forall (f :: * -> *). f ~> Ap f
inject Opt a
o Ap Opt (b -> (a, b)) -> Ap Opt b -> Ap Opt (a, b)
forall a b. Ap Opt (a -> b) -> Ap Opt a -> Ap Opt b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ap Opt b
eo) Parser c
eb (((a, b) -> c -> b) -> Day (Ap Opt) Parser b)
-> ((a, b) -> c -> b) -> Day (Ap Opt) Parser b
forall a b. (a -> b) -> a -> b
$ \(a
x, b
y) c
z -> b -> c -> a -> b
ef b
y c
z a
x)
addEPMOpt :: Opt a -> EndpointMap (a -> b) -> EndpointMap b
addEPMOpt :: forall a b. Opt a -> EndpointMap (a -> b) -> EndpointMap b
addEPMOpt Opt a
o (EPM Map Method (Endpoint (a -> b))
e Maybe (Endpoint (Method -> a -> b))
r) = Map Method (Endpoint b)
-> Maybe (Endpoint (Method -> b)) -> EndpointMap b
forall a.
Map Method (Endpoint a)
-> Maybe (Endpoint (Method -> a)) -> EndpointMap a
EPM Map Method (Endpoint b)
e' Maybe (Endpoint (Method -> b))
r'
where
e' :: Map Method (Endpoint b)
e' = Opt a -> Endpoint (a -> b) -> Endpoint b
forall a b. Opt a -> Endpoint (a -> b) -> Endpoint b
addEndpointOpt Opt a
o (Endpoint (a -> b) -> Endpoint b)
-> Map Method (Endpoint (a -> b)) -> Map Method (Endpoint b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Method (Endpoint (a -> b))
e
r' :: Maybe (Endpoint (Method -> b))
r' = Opt a -> Endpoint (a -> Method -> b) -> Endpoint (Method -> b)
forall a b. Opt a -> Endpoint (a -> b) -> Endpoint b
addEndpointOpt Opt a
o (Endpoint (a -> Method -> b) -> Endpoint (Method -> b))
-> (Endpoint (Method -> a -> b) -> Endpoint (a -> Method -> b))
-> Endpoint (Method -> a -> b)
-> Endpoint (Method -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Method -> a -> b) -> a -> Method -> b)
-> Endpoint (Method -> a -> b) -> Endpoint (a -> Method -> b)
forall a b. (a -> b) -> Endpoint a -> Endpoint b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Method -> a -> b) -> a -> Method -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Endpoint (Method -> a -> b) -> Endpoint (Method -> b))
-> Maybe (Endpoint (Method -> a -> b))
-> Maybe (Endpoint (Method -> b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Endpoint (Method -> a -> b))
r
note :: [String] -> PStruct a -> PStruct a
note :: forall a. [String] -> PStruct a -> PStruct a
note [String]
ns (PStruct [String]
ms Map String (PStruct a)
cs Maybe (Captures a)
c EndpointMap a
ep) = [String]
-> Map String (PStruct a)
-> Maybe (Captures a)
-> EndpointMap a
-> PStruct a
forall a.
[String]
-> Map String (PStruct a)
-> Maybe (Captures a)
-> EndpointMap a
-> PStruct a
PStruct ([String]
ns [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ms) Map String (PStruct a)
cs Maybe (Captures a)
c EndpointMap a
ep
infixr 4 `note`
(#:>) :: Arg a -> PStruct (a -> b) -> PStruct b
Arg a
a #:> :: forall a b. Arg a -> PStruct (a -> b) -> PStruct b
#:> PStruct (a -> b)
p = PStruct b
forall a. Monoid a => a
mempty {psCaptures = Just (L1 (Day a p (&)))}
infixr 4 #:>
(##:>) :: Arg a -> PStruct ([a] -> b) -> PStruct b
Arg a
a ##:> :: forall a b. Arg a -> PStruct ([a] -> b) -> PStruct b
##:> PStruct ([a] -> b)
p =
PStruct b
forall a. Monoid a => a
mempty
{ psCaptures = Just (R1 (Day (MultiArg a) (psEndpoints p) (&)))
}
infixr 4 ##:>
(%:>) :: Parser a -> PStruct (a -> b) -> PStruct b
Parser a
b %:> :: forall a b. Parser a -> PStruct (a -> b) -> PStruct b
%:> PStruct [String]
ns Map String (PStruct (a -> b))
cs Maybe (Captures (a -> b))
c EndpointMap (a -> b)
ep = [String]
-> Map String (PStruct b)
-> Maybe (Captures b)
-> EndpointMap b
-> PStruct b
forall a.
[String]
-> Map String (PStruct a)
-> Maybe (Captures a)
-> EndpointMap a
-> PStruct a
PStruct [String]
ns Map String (PStruct b)
cs' Maybe (Captures b)
c' EndpointMap b
ep'
where
cs' :: Map String (PStruct b)
cs' = (Parser a
b Parser a -> PStruct (a -> b) -> PStruct b
forall a b. Parser a -> PStruct (a -> b) -> PStruct b
%:>) (PStruct (a -> b) -> PStruct b)
-> Map String (PStruct (a -> b)) -> Map String (PStruct b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (PStruct (a -> b))
cs
c' :: Maybe (Captures b)
c' =
Maybe (Captures (a -> b))
c Maybe (Captures (a -> b))
-> (Captures (a -> b) -> Captures b) -> Maybe (Captures b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
L1 (Day Arg b
a PStruct c
p b -> c -> a -> b
f) ->
let f' :: c -> a -> b -> b
f' c
x a
y b
z = b -> c -> a -> b
f b
z c
x a
y
in Day Arg PStruct b -> Captures b
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Day Arg PStruct b -> Captures b)
-> Day Arg PStruct b -> Captures b
forall a b. (a -> b) -> a -> b
$ Arg b
-> PStruct (b -> b) -> (b -> (b -> b) -> b) -> Day Arg PStruct b
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day Arg b
a (Parser a
b Parser a -> PStruct (a -> b -> b) -> PStruct (b -> b)
forall a b. Parser a -> PStruct (a -> b) -> PStruct b
%:> (c -> a -> b -> b
f' (c -> a -> b -> b) -> PStruct c -> PStruct (a -> b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PStruct c
p)) b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
(&)
R1 (Day MultiArg b
a EndpointMap c
p b -> c -> a -> b
f) ->
let f' :: c -> a -> b -> b
f' c
x a
y b
z = b -> c -> a -> b
f b
z c
x a
y
in Day MultiArg EndpointMap b -> Captures b
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Day MultiArg EndpointMap b -> Captures b)
-> Day MultiArg EndpointMap b -> Captures b
forall a b. (a -> b) -> a -> b
$ MultiArg b
-> EndpointMap (b -> b)
-> (b -> (b -> b) -> b)
-> Day MultiArg EndpointMap b
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day MultiArg b
a (Parser a -> EndpointMap (a -> b -> b) -> EndpointMap (b -> b)
forall a b. Parser a -> EndpointMap (a -> b) -> EndpointMap b
addEPMBody Parser a
b (c -> a -> b -> b
f' (c -> a -> b -> b) -> EndpointMap c -> EndpointMap (a -> b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EndpointMap c
p)) b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
(&)
ep' :: EndpointMap b
ep' = Parser a -> EndpointMap (a -> b) -> EndpointMap b
forall a b. Parser a -> EndpointMap (a -> b) -> EndpointMap b
addEPMBody Parser a
b EndpointMap (a -> b)
ep
infixr 4 %:>
addEndpointBody :: Parser a -> Endpoint (a -> b) -> Endpoint b
addEndpointBody :: forall a b. Parser a -> Endpoint (a -> b) -> Endpoint b
addEndpointBody Parser a
b (Endpoint Day (Ap Opt) Parser (a -> b)
d) =
Day (Ap Opt) Parser b -> Endpoint b
forall a. Day (Ap Opt) Parser a -> Endpoint a
Endpoint (Parser a -> Day (Ap Opt) Parser a
Parser ~> Day (Ap Opt) Parser
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *) (g :: * -> *).
MonoidIn t i f =>
g ~> t f g
inR Parser a
b Day (Ap Opt) Parser a
-> Day (Ap Opt) Parser (a -> b) -> Day (Ap Opt) Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Day (Ap Opt) Parser (a -> b)
d)
addEPMBody :: Parser a -> EndpointMap (a -> b) -> EndpointMap b
addEPMBody :: forall a b. Parser a -> EndpointMap (a -> b) -> EndpointMap b
addEPMBody Parser a
b (EPM Map Method (Endpoint (a -> b))
e Maybe (Endpoint (Method -> a -> b))
r) = Map Method (Endpoint b)
-> Maybe (Endpoint (Method -> b)) -> EndpointMap b
forall a.
Map Method (Endpoint a)
-> Maybe (Endpoint (Method -> a)) -> EndpointMap a
EPM Map Method (Endpoint b)
e' Maybe (Endpoint (Method -> b))
r'
where
e' :: Map Method (Endpoint b)
e' = Parser a -> Endpoint (a -> b) -> Endpoint b
forall a b. Parser a -> Endpoint (a -> b) -> Endpoint b
addEndpointBody Parser a
b (Endpoint (a -> b) -> Endpoint b)
-> Map Method (Endpoint (a -> b)) -> Map Method (Endpoint b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Method (Endpoint (a -> b))
e
r' :: Maybe (Endpoint (Method -> b))
r' = Parser a -> Endpoint (a -> Method -> b) -> Endpoint (Method -> b)
forall a b. Parser a -> Endpoint (a -> b) -> Endpoint b
addEndpointBody Parser a
b (Endpoint (a -> Method -> b) -> Endpoint (Method -> b))
-> (Endpoint (Method -> a -> b) -> Endpoint (a -> Method -> b))
-> Endpoint (Method -> a -> b)
-> Endpoint (Method -> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Method -> a -> b) -> a -> Method -> b)
-> Endpoint (Method -> a -> b) -> Endpoint (a -> Method -> b)
forall a b. (a -> b) -> Endpoint a -> Endpoint b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Method -> a -> b) -> a -> Method -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Endpoint (Method -> a -> b) -> Endpoint (Method -> b))
-> Maybe (Endpoint (Method -> a -> b))
-> Maybe (Endpoint (Method -> b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Endpoint (Method -> a -> b))
r
endpoint :: HTTP.Method -> a -> PStruct a
endpoint :: forall a. Method -> a -> PStruct a
endpoint Method
m a
x =
PStruct a
forall a. Monoid a => a
mempty
{ psEndpoints = EPM (M.singleton m (Endpoint (pure x))) Nothing
}
rawEndpoint :: (HTTP.Method -> a) -> PStruct a
rawEndpoint :: forall a. (Method -> a) -> PStruct a
rawEndpoint Method -> a
f =
PStruct a
forall a. Monoid a => a
mempty
{ psEndpoints = EPM M.empty (Just (Endpoint (pure f)))
}
orRequired :: ReadM a -> Coyoneda OptRead a
orRequired :: forall a. ReadM a -> Coyoneda OptRead a
orRequired = OptRead a -> Coyoneda OptRead a
forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
forall (f :: * -> *). f ~> Coyoneda f
inject (OptRead a -> Coyoneda OptRead a)
-> (ReadM a -> OptRead a) -> ReadM a -> Coyoneda OptRead a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM a -> OptRead a
forall a. ReadM a -> OptRead a
ORRequired
orOptional :: ReadM a -> Coyoneda OptRead (Maybe a)
orOptional :: forall a. ReadM a -> Coyoneda OptRead (Maybe a)
orOptional = OptRead (Maybe a) -> Coyoneda OptRead (Maybe a)
forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
forall (f :: * -> *). f ~> Coyoneda f
inject (OptRead (Maybe a) -> Coyoneda OptRead (Maybe a))
-> (ReadM a -> OptRead (Maybe a))
-> ReadM a
-> Coyoneda OptRead (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM a -> OptRead (Maybe a)
forall a. ReadM a -> OptRead (Maybe a)
OROptional
orSwitch :: Coyoneda OptRead Bool
orSwitch :: Coyoneda OptRead Bool
orSwitch = OptRead Bool -> Coyoneda OptRead Bool
forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
forall (f :: * -> *). f ~> Coyoneda f
inject OptRead Bool
ORSwitch