{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}

-- | Generalizes all the data needed to make code generation work with
-- arbitrary programming languages.
module Servant.Foreign.Internal where

import           Prelude ()
import           Prelude.Compat

import           Control.Lens
                 (Getter, makeLenses, makePrisms, (%~), (&), (.~), (<>~))
import           Data.Data
                 (Data)
import           Data.Proxy
import           Data.Semigroup
                 (Semigroup)
import           Data.String
import           Data.Text
import           Data.Text.Encoding
                 (decodeUtf8)
import           Data.Typeable
                 (Typeable)
import           GHC.TypeLits
import qualified Network.HTTP.Types    as HTTP
import           Servant.API
import           Servant.API.Modifiers
                 (RequiredArgument)
import           Servant.API.TypeLevel

newtype FunctionName = FunctionName { FunctionName -> [Text]
unFunctionName :: [Text] }
  deriving (Typeable FunctionName
DataType
Constr
Typeable FunctionName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FunctionName -> c FunctionName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FunctionName)
-> (FunctionName -> Constr)
-> (FunctionName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FunctionName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FunctionName))
-> ((forall b. Data b => b -> b) -> FunctionName -> FunctionName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FunctionName -> r)
-> (forall u. (forall d. Data d => d -> u) -> FunctionName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FunctionName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName)
-> Data FunctionName
FunctionName -> DataType
FunctionName -> Constr
(forall b. Data b => b -> b) -> FunctionName -> FunctionName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
$cFunctionName :: Constr
$tFunctionName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapMp :: (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapM :: (forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FunctionName -> m FunctionName
gmapQi :: Int -> (forall d. Data d => d -> u) -> FunctionName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
gmapQ :: (forall d. Data d => d -> u) -> FunctionName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionName -> r
gmapT :: (forall b. Data b => b -> b) -> FunctionName -> FunctionName
$cgmapT :: (forall b. Data b => b -> b) -> FunctionName -> FunctionName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FunctionName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionName)
dataTypeOf :: FunctionName -> DataType
$cdataTypeOf :: FunctionName -> DataType
toConstr :: FunctionName -> Constr
$ctoConstr :: FunctionName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionName -> c FunctionName
$cp1Data :: Typeable FunctionName
Data, Int -> FunctionName -> ShowS
[FunctionName] -> ShowS
FunctionName -> String
(Int -> FunctionName -> ShowS)
-> (FunctionName -> String)
-> ([FunctionName] -> ShowS)
-> Show FunctionName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionName] -> ShowS
$cshowList :: [FunctionName] -> ShowS
show :: FunctionName -> String
$cshow :: FunctionName -> String
showsPrec :: Int -> FunctionName -> ShowS
$cshowsPrec :: Int -> FunctionName -> ShowS
Show, FunctionName -> FunctionName -> Bool
(FunctionName -> FunctionName -> Bool)
-> (FunctionName -> FunctionName -> Bool) -> Eq FunctionName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionName -> FunctionName -> Bool
$c/= :: FunctionName -> FunctionName -> Bool
== :: FunctionName -> FunctionName -> Bool
$c== :: FunctionName -> FunctionName -> Bool
Eq, b -> FunctionName -> FunctionName
NonEmpty FunctionName -> FunctionName
FunctionName -> FunctionName -> FunctionName
(FunctionName -> FunctionName -> FunctionName)
-> (NonEmpty FunctionName -> FunctionName)
-> (forall b. Integral b => b -> FunctionName -> FunctionName)
-> Semigroup FunctionName
forall b. Integral b => b -> FunctionName -> FunctionName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FunctionName -> FunctionName
$cstimes :: forall b. Integral b => b -> FunctionName -> FunctionName
sconcat :: NonEmpty FunctionName -> FunctionName
$csconcat :: NonEmpty FunctionName -> FunctionName
<> :: FunctionName -> FunctionName -> FunctionName
$c<> :: FunctionName -> FunctionName -> FunctionName
Semigroup, Semigroup FunctionName
FunctionName
Semigroup FunctionName
-> FunctionName
-> (FunctionName -> FunctionName -> FunctionName)
-> ([FunctionName] -> FunctionName)
-> Monoid FunctionName
[FunctionName] -> FunctionName
FunctionName -> FunctionName -> FunctionName
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [FunctionName] -> FunctionName
$cmconcat :: [FunctionName] -> FunctionName
mappend :: FunctionName -> FunctionName -> FunctionName
$cmappend :: FunctionName -> FunctionName -> FunctionName
mempty :: FunctionName
$cmempty :: FunctionName
$cp1Monoid :: Semigroup FunctionName
Monoid, Typeable)

makePrisms ''FunctionName

newtype PathSegment = PathSegment { PathSegment -> Text
unPathSegment :: Text }
  deriving (Typeable PathSegment
DataType
Constr
Typeable PathSegment
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PathSegment -> c PathSegment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PathSegment)
-> (PathSegment -> Constr)
-> (PathSegment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PathSegment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PathSegment))
-> ((forall b. Data b => b -> b) -> PathSegment -> PathSegment)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PathSegment -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PathSegment -> r)
-> (forall u. (forall d. Data d => d -> u) -> PathSegment -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PathSegment -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PathSegment -> m PathSegment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PathSegment -> m PathSegment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PathSegment -> m PathSegment)
-> Data PathSegment
PathSegment -> DataType
PathSegment -> Constr
(forall b. Data b => b -> b) -> PathSegment -> PathSegment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathSegment -> c PathSegment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathSegment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PathSegment -> u
forall u. (forall d. Data d => d -> u) -> PathSegment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathSegment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathSegment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathSegment -> m PathSegment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathSegment -> m PathSegment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathSegment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathSegment -> c PathSegment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathSegment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathSegment)
$cPathSegment :: Constr
$tPathSegment :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PathSegment -> m PathSegment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathSegment -> m PathSegment
gmapMp :: (forall d. Data d => d -> m d) -> PathSegment -> m PathSegment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathSegment -> m PathSegment
gmapM :: (forall d. Data d => d -> m d) -> PathSegment -> m PathSegment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathSegment -> m PathSegment
gmapQi :: Int -> (forall d. Data d => d -> u) -> PathSegment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PathSegment -> u
gmapQ :: (forall d. Data d => d -> u) -> PathSegment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PathSegment -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathSegment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathSegment -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathSegment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathSegment -> r
gmapT :: (forall b. Data b => b -> b) -> PathSegment -> PathSegment
$cgmapT :: (forall b. Data b => b -> b) -> PathSegment -> PathSegment
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathSegment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathSegment)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PathSegment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathSegment)
dataTypeOf :: PathSegment -> DataType
$cdataTypeOf :: PathSegment -> DataType
toConstr :: PathSegment -> Constr
$ctoConstr :: PathSegment -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathSegment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathSegment
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathSegment -> c PathSegment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathSegment -> c PathSegment
$cp1Data :: Typeable PathSegment
Data, Int -> PathSegment -> ShowS
[PathSegment] -> ShowS
PathSegment -> String
(Int -> PathSegment -> ShowS)
-> (PathSegment -> String)
-> ([PathSegment] -> ShowS)
-> Show PathSegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathSegment] -> ShowS
$cshowList :: [PathSegment] -> ShowS
show :: PathSegment -> String
$cshow :: PathSegment -> String
showsPrec :: Int -> PathSegment -> ShowS
$cshowsPrec :: Int -> PathSegment -> ShowS
Show, PathSegment -> PathSegment -> Bool
(PathSegment -> PathSegment -> Bool)
-> (PathSegment -> PathSegment -> Bool) -> Eq PathSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathSegment -> PathSegment -> Bool
$c/= :: PathSegment -> PathSegment -> Bool
== :: PathSegment -> PathSegment -> Bool
$c== :: PathSegment -> PathSegment -> Bool
Eq, String -> PathSegment
(String -> PathSegment) -> IsString PathSegment
forall a. (String -> a) -> IsString a
fromString :: String -> PathSegment
$cfromString :: String -> PathSegment
IsString, b -> PathSegment -> PathSegment
NonEmpty PathSegment -> PathSegment
PathSegment -> PathSegment -> PathSegment
(PathSegment -> PathSegment -> PathSegment)
-> (NonEmpty PathSegment -> PathSegment)
-> (forall b. Integral b => b -> PathSegment -> PathSegment)
-> Semigroup PathSegment
forall b. Integral b => b -> PathSegment -> PathSegment
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PathSegment -> PathSegment
$cstimes :: forall b. Integral b => b -> PathSegment -> PathSegment
sconcat :: NonEmpty PathSegment -> PathSegment
$csconcat :: NonEmpty PathSegment -> PathSegment
<> :: PathSegment -> PathSegment -> PathSegment
$c<> :: PathSegment -> PathSegment -> PathSegment
Semigroup, Semigroup PathSegment
PathSegment
Semigroup PathSegment
-> PathSegment
-> (PathSegment -> PathSegment -> PathSegment)
-> ([PathSegment] -> PathSegment)
-> Monoid PathSegment
[PathSegment] -> PathSegment
PathSegment -> PathSegment -> PathSegment
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PathSegment] -> PathSegment
$cmconcat :: [PathSegment] -> PathSegment
mappend :: PathSegment -> PathSegment -> PathSegment
$cmappend :: PathSegment -> PathSegment -> PathSegment
mempty :: PathSegment
$cmempty :: PathSegment
$cp1Monoid :: Semigroup PathSegment
Monoid, Typeable)

makePrisms ''PathSegment

data Arg f = Arg
  { Arg f -> PathSegment
_argName :: PathSegment
  , Arg f -> f
_argType :: f }
  deriving (Typeable (Arg f)
DataType
Constr
Typeable (Arg f)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Arg f -> c (Arg f))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Arg f))
-> (Arg f -> Constr)
-> (Arg f -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Arg f)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg f)))
-> ((forall b. Data b => b -> b) -> Arg f -> Arg f)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r)
-> (forall u. (forall d. Data d => d -> u) -> Arg f -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Arg f -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Arg f -> m (Arg f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Arg f -> m (Arg f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Arg f -> m (Arg f))
-> Data (Arg f)
Arg f -> DataType
Arg f -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Arg f))
(forall b. Data b => b -> b) -> Arg f -> Arg f
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg f -> c (Arg f)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg f)
forall f. Data f => Typeable (Arg f)
forall f. Data f => Arg f -> DataType
forall f. Data f => Arg f -> Constr
forall f. Data f => (forall b. Data b => b -> b) -> Arg f -> Arg f
forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Arg f -> u
forall f u. Data f => (forall d. Data d => d -> u) -> Arg f -> [u]
forall f r r'.
Data f =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r
forall f r r'.
Data f =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r
forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg f)
forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg f -> c (Arg f)
forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg f))
forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg f))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Arg f -> u
forall u. (forall d. Data d => d -> u) -> Arg f -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg f)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg f -> c (Arg f)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg f))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg f))
$cArg :: Constr
$tArg :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
$cgmapMo :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
gmapMp :: (forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
$cgmapMp :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
gmapM :: (forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
$cgmapM :: forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Arg f -> m (Arg f)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Arg f -> u
$cgmapQi :: forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Arg f -> u
gmapQ :: (forall d. Data d => d -> u) -> Arg f -> [u]
$cgmapQ :: forall f u. Data f => (forall d. Data d => d -> u) -> Arg f -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r
$cgmapQr :: forall f r r'.
Data f =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r
$cgmapQl :: forall f r r'.
Data f =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Arg f -> r
gmapT :: (forall b. Data b => b -> b) -> Arg f -> Arg f
$cgmapT :: forall f. Data f => (forall b. Data b => b -> b) -> Arg f -> Arg f
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg f))
$cdataCast2 :: forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Arg f))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Arg f))
$cdataCast1 :: forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg f))
dataTypeOf :: Arg f -> DataType
$cdataTypeOf :: forall f. Data f => Arg f -> DataType
toConstr :: Arg f -> Constr
$ctoConstr :: forall f. Data f => Arg f -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg f)
$cgunfold :: forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg f)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg f -> c (Arg f)
$cgfoldl :: forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg f -> c (Arg f)
$cp1Data :: forall f. Data f => Typeable (Arg f)
Data, Arg f -> Arg f -> Bool
(Arg f -> Arg f -> Bool) -> (Arg f -> Arg f -> Bool) -> Eq (Arg f)
forall f. Eq f => Arg f -> Arg f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arg f -> Arg f -> Bool
$c/= :: forall f. Eq f => Arg f -> Arg f -> Bool
== :: Arg f -> Arg f -> Bool
$c== :: forall f. Eq f => Arg f -> Arg f -> Bool
Eq, Int -> Arg f -> ShowS
[Arg f] -> ShowS
Arg f -> String
(Int -> Arg f -> ShowS)
-> (Arg f -> String) -> ([Arg f] -> ShowS) -> Show (Arg f)
forall f. Show f => Int -> Arg f -> ShowS
forall f. Show f => [Arg f] -> ShowS
forall f. Show f => Arg f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arg f] -> ShowS
$cshowList :: forall f. Show f => [Arg f] -> ShowS
show :: Arg f -> String
$cshow :: forall f. Show f => Arg f -> String
showsPrec :: Int -> Arg f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Arg f -> ShowS
Show, Typeable)

makeLenses ''Arg

argPath :: Getter (Arg f) Text
argPath :: (Text -> f Text) -> Arg f -> f (Arg f)
argPath = (PathSegment -> f PathSegment) -> Arg f -> f (Arg f)
forall f. Lens' (Arg f) PathSegment
argName ((PathSegment -> f PathSegment) -> Arg f -> f (Arg f))
-> ((Text -> f Text) -> PathSegment -> f PathSegment)
-> (Text -> f Text)
-> Arg f
-> f (Arg f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> PathSegment -> f PathSegment
Iso' PathSegment Text
_PathSegment

data SegmentType f
  = Static PathSegment
    -- ^ a static path segment. like "/foo"
  | Cap (Arg f)
    -- ^ a capture. like "/:userid"
  deriving (Typeable (SegmentType f)
DataType
Constr
Typeable (SegmentType f)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SegmentType f -> c (SegmentType f))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (SegmentType f))
-> (SegmentType f -> Constr)
-> (SegmentType f -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (SegmentType f)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (SegmentType f)))
-> ((forall b. Data b => b -> b) -> SegmentType f -> SegmentType f)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SegmentType f -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SegmentType f -> r)
-> (forall u. (forall d. Data d => d -> u) -> SegmentType f -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SegmentType f -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SegmentType f -> m (SegmentType f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SegmentType f -> m (SegmentType f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SegmentType f -> m (SegmentType f))
-> Data (SegmentType f)
SegmentType f -> DataType
SegmentType f -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (SegmentType f))
(forall b. Data b => b -> b) -> SegmentType f -> SegmentType f
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentType f -> c (SegmentType f)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType f)
forall f. Data f => Typeable (SegmentType f)
forall f. Data f => SegmentType f -> DataType
forall f. Data f => SegmentType f -> Constr
forall f.
Data f =>
(forall b. Data b => b -> b) -> SegmentType f -> SegmentType f
forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> SegmentType f -> u
forall f u.
Data f =>
(forall d. Data d => d -> u) -> SegmentType f -> [u]
forall f r r'.
Data f =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType f -> r
forall f r r'.
Data f =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType f -> r
forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType f)
forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentType f -> c (SegmentType f)
forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SegmentType f))
forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SegmentType f))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SegmentType f -> u
forall u. (forall d. Data d => d -> u) -> SegmentType f -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType f -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType f -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType f)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentType f -> c (SegmentType f)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SegmentType f))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SegmentType f))
$cCap :: Constr
$cStatic :: Constr
$tSegmentType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
$cgmapMo :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
gmapMp :: (forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
$cgmapMp :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
gmapM :: (forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
$cgmapM :: forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d)
-> SegmentType f -> m (SegmentType f)
gmapQi :: Int -> (forall d. Data d => d -> u) -> SegmentType f -> u
$cgmapQi :: forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> SegmentType f -> u
gmapQ :: (forall d. Data d => d -> u) -> SegmentType f -> [u]
$cgmapQ :: forall f u.
Data f =>
(forall d. Data d => d -> u) -> SegmentType f -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType f -> r
$cgmapQr :: forall f r r'.
Data f =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType f -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType f -> r
$cgmapQl :: forall f r r'.
Data f =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType f -> r
gmapT :: (forall b. Data b => b -> b) -> SegmentType f -> SegmentType f
$cgmapT :: forall f.
Data f =>
(forall b. Data b => b -> b) -> SegmentType f -> SegmentType f
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SegmentType f))
$cdataCast2 :: forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SegmentType f))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (SegmentType f))
$cdataCast1 :: forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SegmentType f))
dataTypeOf :: SegmentType f -> DataType
$cdataTypeOf :: forall f. Data f => SegmentType f -> DataType
toConstr :: SegmentType f -> Constr
$ctoConstr :: forall f. Data f => SegmentType f -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType f)
$cgunfold :: forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType f)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentType f -> c (SegmentType f)
$cgfoldl :: forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentType f -> c (SegmentType f)
$cp1Data :: forall f. Data f => Typeable (SegmentType f)
Data, SegmentType f -> SegmentType f -> Bool
(SegmentType f -> SegmentType f -> Bool)
-> (SegmentType f -> SegmentType f -> Bool) -> Eq (SegmentType f)
forall f. Eq f => SegmentType f -> SegmentType f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentType f -> SegmentType f -> Bool
$c/= :: forall f. Eq f => SegmentType f -> SegmentType f -> Bool
== :: SegmentType f -> SegmentType f -> Bool
$c== :: forall f. Eq f => SegmentType f -> SegmentType f -> Bool
Eq, Int -> SegmentType f -> ShowS
[SegmentType f] -> ShowS
SegmentType f -> String
(Int -> SegmentType f -> ShowS)
-> (SegmentType f -> String)
-> ([SegmentType f] -> ShowS)
-> Show (SegmentType f)
forall f. Show f => Int -> SegmentType f -> ShowS
forall f. Show f => [SegmentType f] -> ShowS
forall f. Show f => SegmentType f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentType f] -> ShowS
$cshowList :: forall f. Show f => [SegmentType f] -> ShowS
show :: SegmentType f -> String
$cshow :: forall f. Show f => SegmentType f -> String
showsPrec :: Int -> SegmentType f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> SegmentType f -> ShowS
Show, Typeable)

makePrisms ''SegmentType

newtype Segment f = Segment { Segment f -> SegmentType f
unSegment :: SegmentType f }
  deriving (Typeable (Segment f)
DataType
Constr
Typeable (Segment f)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Segment f -> c (Segment f))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Segment f))
-> (Segment f -> Constr)
-> (Segment f -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Segment f)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Segment f)))
-> ((forall b. Data b => b -> b) -> Segment f -> Segment f)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Segment f -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Segment f -> r)
-> (forall u. (forall d. Data d => d -> u) -> Segment f -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Segment f -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Segment f -> m (Segment f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Segment f -> m (Segment f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Segment f -> m (Segment f))
-> Data (Segment f)
Segment f -> DataType
Segment f -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Segment f))
(forall b. Data b => b -> b) -> Segment f -> Segment f
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment f -> c (Segment f)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Segment f)
forall f. Data f => Typeable (Segment f)
forall f. Data f => Segment f -> DataType
forall f. Data f => Segment f -> Constr
forall f.
Data f =>
(forall b. Data b => b -> b) -> Segment f -> Segment f
forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Segment f -> u
forall f u.
Data f =>
(forall d. Data d => d -> u) -> Segment f -> [u]
forall f r r'.
Data f =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Segment f -> r
forall f r r'.
Data f =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Segment f -> r
forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Segment f)
forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment f -> c (Segment f)
forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Segment f))
forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Segment f))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Segment f -> u
forall u. (forall d. Data d => d -> u) -> Segment f -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Segment f -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Segment f -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Segment f)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment f -> c (Segment f)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Segment f))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Segment f))
$cSegment :: Constr
$tSegment :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
$cgmapMo :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
gmapMp :: (forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
$cgmapMp :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
gmapM :: (forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
$cgmapM :: forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Segment f -> m (Segment f)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Segment f -> u
$cgmapQi :: forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Segment f -> u
gmapQ :: (forall d. Data d => d -> u) -> Segment f -> [u]
$cgmapQ :: forall f u.
Data f =>
(forall d. Data d => d -> u) -> Segment f -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Segment f -> r
$cgmapQr :: forall f r r'.
Data f =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Segment f -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Segment f -> r
$cgmapQl :: forall f r r'.
Data f =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Segment f -> r
gmapT :: (forall b. Data b => b -> b) -> Segment f -> Segment f
$cgmapT :: forall f.
Data f =>
(forall b. Data b => b -> b) -> Segment f -> Segment f
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Segment f))
$cdataCast2 :: forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Segment f))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Segment f))
$cdataCast1 :: forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Segment f))
dataTypeOf :: Segment f -> DataType
$cdataTypeOf :: forall f. Data f => Segment f -> DataType
toConstr :: Segment f -> Constr
$ctoConstr :: forall f. Data f => Segment f -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Segment f)
$cgunfold :: forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Segment f)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment f -> c (Segment f)
$cgfoldl :: forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment f -> c (Segment f)
$cp1Data :: forall f. Data f => Typeable (Segment f)
Data, Segment f -> Segment f -> Bool
(Segment f -> Segment f -> Bool)
-> (Segment f -> Segment f -> Bool) -> Eq (Segment f)
forall f. Eq f => Segment f -> Segment f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment f -> Segment f -> Bool
$c/= :: forall f. Eq f => Segment f -> Segment f -> Bool
== :: Segment f -> Segment f -> Bool
$c== :: forall f. Eq f => Segment f -> Segment f -> Bool
Eq, Int -> Segment f -> ShowS
[Segment f] -> ShowS
Segment f -> String
(Int -> Segment f -> ShowS)
-> (Segment f -> String)
-> ([Segment f] -> ShowS)
-> Show (Segment f)
forall f. Show f => Int -> Segment f -> ShowS
forall f. Show f => [Segment f] -> ShowS
forall f. Show f => Segment f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Segment f] -> ShowS
$cshowList :: forall f. Show f => [Segment f] -> ShowS
show :: Segment f -> String
$cshow :: forall f. Show f => Segment f -> String
showsPrec :: Int -> Segment f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Segment f -> ShowS
Show, Typeable)

makePrisms ''Segment

isCapture :: Segment f -> Bool
isCapture :: Segment f -> Bool
isCapture (Segment (Cap Arg f
_)) = Bool
True
isCapture                Segment f
_  = Bool
False

captureArg :: Segment f -> Arg f
captureArg :: Segment f -> Arg f
captureArg (Segment (Cap Arg f
s)) = Arg f
s
captureArg                 Segment f
_ = String -> Arg f
forall a. HasCallStack => String -> a
error String
"captureArg called on non capture"

type Path f = [Segment f]

newtype Frag f = Frag { Frag f -> Arg f
unFragment :: Arg f }
  deriving (Typeable (Frag f)
DataType
Constr
Typeable (Frag f)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Frag f -> c (Frag f))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Frag f))
-> (Frag f -> Constr)
-> (Frag f -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Frag f)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Frag f)))
-> ((forall b. Data b => b -> b) -> Frag f -> Frag f)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Frag f -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Frag f -> r)
-> (forall u. (forall d. Data d => d -> u) -> Frag f -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Frag f -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Frag f -> m (Frag f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Frag f -> m (Frag f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Frag f -> m (Frag f))
-> Data (Frag f)
Frag f -> DataType
Frag f -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Frag f))
(forall b. Data b => b -> b) -> Frag f -> Frag f
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Frag f -> c (Frag f)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Frag f)
forall f. Data f => Typeable (Frag f)
forall f. Data f => Frag f -> DataType
forall f. Data f => Frag f -> Constr
forall f.
Data f =>
(forall b. Data b => b -> b) -> Frag f -> Frag f
forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Frag f -> u
forall f u. Data f => (forall d. Data d => d -> u) -> Frag f -> [u]
forall f r r'.
Data f =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Frag f -> r
forall f r r'.
Data f =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Frag f -> r
forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Frag f)
forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Frag f -> c (Frag f)
forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Frag f))
forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Frag f))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Frag f -> u
forall u. (forall d. Data d => d -> u) -> Frag f -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Frag f -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Frag f -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Frag f)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Frag f -> c (Frag f)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Frag f))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Frag f))
$cFrag :: Constr
$tFrag :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
$cgmapMo :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
gmapMp :: (forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
$cgmapMp :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
gmapM :: (forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
$cgmapM :: forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Frag f -> m (Frag f)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Frag f -> u
$cgmapQi :: forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Frag f -> u
gmapQ :: (forall d. Data d => d -> u) -> Frag f -> [u]
$cgmapQ :: forall f u. Data f => (forall d. Data d => d -> u) -> Frag f -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Frag f -> r
$cgmapQr :: forall f r r'.
Data f =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Frag f -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Frag f -> r
$cgmapQl :: forall f r r'.
Data f =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Frag f -> r
gmapT :: (forall b. Data b => b -> b) -> Frag f -> Frag f
$cgmapT :: forall f.
Data f =>
(forall b. Data b => b -> b) -> Frag f -> Frag f
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Frag f))
$cdataCast2 :: forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Frag f))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Frag f))
$cdataCast1 :: forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Frag f))
dataTypeOf :: Frag f -> DataType
$cdataTypeOf :: forall f. Data f => Frag f -> DataType
toConstr :: Frag f -> Constr
$ctoConstr :: forall f. Data f => Frag f -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Frag f)
$cgunfold :: forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Frag f)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Frag f -> c (Frag f)
$cgfoldl :: forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Frag f -> c (Frag f)
$cp1Data :: forall f. Data f => Typeable (Frag f)
Data, Frag f -> Frag f -> Bool
(Frag f -> Frag f -> Bool)
-> (Frag f -> Frag f -> Bool) -> Eq (Frag f)
forall f. Eq f => Frag f -> Frag f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frag f -> Frag f -> Bool
$c/= :: forall f. Eq f => Frag f -> Frag f -> Bool
== :: Frag f -> Frag f -> Bool
$c== :: forall f. Eq f => Frag f -> Frag f -> Bool
Eq, Int -> Frag f -> ShowS
[Frag f] -> ShowS
Frag f -> String
(Int -> Frag f -> ShowS)
-> (Frag f -> String) -> ([Frag f] -> ShowS) -> Show (Frag f)
forall f. Show f => Int -> Frag f -> ShowS
forall f. Show f => [Frag f] -> ShowS
forall f. Show f => Frag f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frag f] -> ShowS
$cshowList :: forall f. Show f => [Frag f] -> ShowS
show :: Frag f -> String
$cshow :: forall f. Show f => Frag f -> String
showsPrec :: Int -> Frag f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Frag f -> ShowS
Show, Typeable)

makePrisms ''Frag

data ArgType
  = Normal
  | Flag
  | List
  deriving (Typeable ArgType
DataType
Constr
Typeable ArgType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ArgType -> c ArgType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ArgType)
-> (ArgType -> Constr)
-> (ArgType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ArgType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgType))
-> ((forall b. Data b => b -> b) -> ArgType -> ArgType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ArgType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ArgType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ArgType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ArgType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ArgType -> m ArgType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ArgType -> m ArgType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ArgType -> m ArgType)
-> Data ArgType
ArgType -> DataType
ArgType -> Constr
(forall b. Data b => b -> b) -> ArgType -> ArgType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArgType -> c ArgType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArgType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ArgType -> u
forall u. (forall d. Data d => d -> u) -> ArgType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArgType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArgType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArgType -> m ArgType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArgType -> m ArgType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArgType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArgType -> c ArgType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArgType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgType)
$cList :: Constr
$cFlag :: Constr
$cNormal :: Constr
$tArgType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ArgType -> m ArgType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArgType -> m ArgType
gmapMp :: (forall d. Data d => d -> m d) -> ArgType -> m ArgType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArgType -> m ArgType
gmapM :: (forall d. Data d => d -> m d) -> ArgType -> m ArgType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArgType -> m ArgType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ArgType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ArgType -> u
gmapQ :: (forall d. Data d => d -> u) -> ArgType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArgType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArgType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArgType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArgType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArgType -> r
gmapT :: (forall b. Data b => b -> b) -> ArgType -> ArgType
$cgmapT :: (forall b. Data b => b -> b) -> ArgType -> ArgType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ArgType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ArgType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArgType)
dataTypeOf :: ArgType -> DataType
$cdataTypeOf :: ArgType -> DataType
toConstr :: ArgType -> Constr
$ctoConstr :: ArgType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArgType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArgType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArgType -> c ArgType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArgType -> c ArgType
$cp1Data :: Typeable ArgType
Data, ArgType -> ArgType -> Bool
(ArgType -> ArgType -> Bool)
-> (ArgType -> ArgType -> Bool) -> Eq ArgType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgType -> ArgType -> Bool
$c/= :: ArgType -> ArgType -> Bool
== :: ArgType -> ArgType -> Bool
$c== :: ArgType -> ArgType -> Bool
Eq, Int -> ArgType -> ShowS
[ArgType] -> ShowS
ArgType -> String
(Int -> ArgType -> ShowS)
-> (ArgType -> String) -> ([ArgType] -> ShowS) -> Show ArgType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgType] -> ShowS
$cshowList :: [ArgType] -> ShowS
show :: ArgType -> String
$cshow :: ArgType -> String
showsPrec :: Int -> ArgType -> ShowS
$cshowsPrec :: Int -> ArgType -> ShowS
Show, Typeable)

makePrisms ''ArgType

data QueryArg f = QueryArg
  { QueryArg f -> Arg f
_queryArgName :: Arg f
  , QueryArg f -> ArgType
_queryArgType :: ArgType
  }
  deriving (Typeable (QueryArg f)
DataType
Constr
Typeable (QueryArg f)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> QueryArg f -> c (QueryArg f))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (QueryArg f))
-> (QueryArg f -> Constr)
-> (QueryArg f -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (QueryArg f)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (QueryArg f)))
-> ((forall b. Data b => b -> b) -> QueryArg f -> QueryArg f)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> QueryArg f -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> QueryArg f -> r)
-> (forall u. (forall d. Data d => d -> u) -> QueryArg f -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> QueryArg f -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f))
-> Data (QueryArg f)
QueryArg f -> DataType
QueryArg f -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (QueryArg f))
(forall b. Data b => b -> b) -> QueryArg f -> QueryArg f
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg f -> c (QueryArg f)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg f)
forall f. Data f => Typeable (QueryArg f)
forall f. Data f => QueryArg f -> DataType
forall f. Data f => QueryArg f -> Constr
forall f.
Data f =>
(forall b. Data b => b -> b) -> QueryArg f -> QueryArg f
forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> QueryArg f -> u
forall f u.
Data f =>
(forall d. Data d => d -> u) -> QueryArg f -> [u]
forall f r r'.
Data f =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg f -> r
forall f r r'.
Data f =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg f -> r
forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg f)
forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg f -> c (QueryArg f)
forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (QueryArg f))
forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QueryArg f))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> QueryArg f -> u
forall u. (forall d. Data d => d -> u) -> QueryArg f -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg f -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg f -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg f)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg f -> c (QueryArg f)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (QueryArg f))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QueryArg f))
$cQueryArg :: Constr
$tQueryArg :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
$cgmapMo :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
gmapMp :: (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
$cgmapMp :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
gmapM :: (forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
$cgmapM :: forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> QueryArg f -> m (QueryArg f)
gmapQi :: Int -> (forall d. Data d => d -> u) -> QueryArg f -> u
$cgmapQi :: forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> QueryArg f -> u
gmapQ :: (forall d. Data d => d -> u) -> QueryArg f -> [u]
$cgmapQ :: forall f u.
Data f =>
(forall d. Data d => d -> u) -> QueryArg f -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg f -> r
$cgmapQr :: forall f r r'.
Data f =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg f -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg f -> r
$cgmapQl :: forall f r r'.
Data f =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg f -> r
gmapT :: (forall b. Data b => b -> b) -> QueryArg f -> QueryArg f
$cgmapT :: forall f.
Data f =>
(forall b. Data b => b -> b) -> QueryArg f -> QueryArg f
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QueryArg f))
$cdataCast2 :: forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QueryArg f))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (QueryArg f))
$cdataCast1 :: forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (QueryArg f))
dataTypeOf :: QueryArg f -> DataType
$cdataTypeOf :: forall f. Data f => QueryArg f -> DataType
toConstr :: QueryArg f -> Constr
$ctoConstr :: forall f. Data f => QueryArg f -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg f)
$cgunfold :: forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg f)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg f -> c (QueryArg f)
$cgfoldl :: forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg f -> c (QueryArg f)
$cp1Data :: forall f. Data f => Typeable (QueryArg f)
Data, QueryArg f -> QueryArg f -> Bool
(QueryArg f -> QueryArg f -> Bool)
-> (QueryArg f -> QueryArg f -> Bool) -> Eq (QueryArg f)
forall f. Eq f => QueryArg f -> QueryArg f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryArg f -> QueryArg f -> Bool
$c/= :: forall f. Eq f => QueryArg f -> QueryArg f -> Bool
== :: QueryArg f -> QueryArg f -> Bool
$c== :: forall f. Eq f => QueryArg f -> QueryArg f -> Bool
Eq, Int -> QueryArg f -> ShowS
[QueryArg f] -> ShowS
QueryArg f -> String
(Int -> QueryArg f -> ShowS)
-> (QueryArg f -> String)
-> ([QueryArg f] -> ShowS)
-> Show (QueryArg f)
forall f. Show f => Int -> QueryArg f -> ShowS
forall f. Show f => [QueryArg f] -> ShowS
forall f. Show f => QueryArg f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryArg f] -> ShowS
$cshowList :: forall f. Show f => [QueryArg f] -> ShowS
show :: QueryArg f -> String
$cshow :: forall f. Show f => QueryArg f -> String
showsPrec :: Int -> QueryArg f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> QueryArg f -> ShowS
Show, Typeable)

makeLenses ''QueryArg

data HeaderArg f = HeaderArg
  { HeaderArg f -> Arg f
_headerArg :: Arg f }
  | ReplaceHeaderArg
  { _headerArg     :: Arg f
  , HeaderArg f -> Text
_headerPattern :: Text
  }
  deriving (Typeable (HeaderArg f)
DataType
Constr
Typeable (HeaderArg f)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> HeaderArg f -> c (HeaderArg f))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (HeaderArg f))
-> (HeaderArg f -> Constr)
-> (HeaderArg f -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (HeaderArg f)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (HeaderArg f)))
-> ((forall b. Data b => b -> b) -> HeaderArg f -> HeaderArg f)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r)
-> (forall u. (forall d. Data d => d -> u) -> HeaderArg f -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> HeaderArg f -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f))
-> Data (HeaderArg f)
HeaderArg f -> DataType
HeaderArg f -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (HeaderArg f))
(forall b. Data b => b -> b) -> HeaderArg f -> HeaderArg f
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg f -> c (HeaderArg f)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg f)
forall f. Data f => Typeable (HeaderArg f)
forall f. Data f => HeaderArg f -> DataType
forall f. Data f => HeaderArg f -> Constr
forall f.
Data f =>
(forall b. Data b => b -> b) -> HeaderArg f -> HeaderArg f
forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> HeaderArg f -> u
forall f u.
Data f =>
(forall d. Data d => d -> u) -> HeaderArg f -> [u]
forall f r r'.
Data f =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r
forall f r r'.
Data f =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r
forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg f)
forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg f -> c (HeaderArg f)
forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HeaderArg f))
forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HeaderArg f))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HeaderArg f -> u
forall u. (forall d. Data d => d -> u) -> HeaderArg f -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg f)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg f -> c (HeaderArg f)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HeaderArg f))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HeaderArg f))
$cReplaceHeaderArg :: Constr
$cHeaderArg :: Constr
$tHeaderArg :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
$cgmapMo :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
gmapMp :: (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
$cgmapMp :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
gmapM :: (forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
$cgmapM :: forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> HeaderArg f -> m (HeaderArg f)
gmapQi :: Int -> (forall d. Data d => d -> u) -> HeaderArg f -> u
$cgmapQi :: forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> HeaderArg f -> u
gmapQ :: (forall d. Data d => d -> u) -> HeaderArg f -> [u]
$cgmapQ :: forall f u.
Data f =>
(forall d. Data d => d -> u) -> HeaderArg f -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r
$cgmapQr :: forall f r r'.
Data f =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r
$cgmapQl :: forall f r r'.
Data f =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg f -> r
gmapT :: (forall b. Data b => b -> b) -> HeaderArg f -> HeaderArg f
$cgmapT :: forall f.
Data f =>
(forall b. Data b => b -> b) -> HeaderArg f -> HeaderArg f
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HeaderArg f))
$cdataCast2 :: forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HeaderArg f))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (HeaderArg f))
$cdataCast1 :: forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HeaderArg f))
dataTypeOf :: HeaderArg f -> DataType
$cdataTypeOf :: forall f. Data f => HeaderArg f -> DataType
toConstr :: HeaderArg f -> Constr
$ctoConstr :: forall f. Data f => HeaderArg f -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg f)
$cgunfold :: forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg f)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg f -> c (HeaderArg f)
$cgfoldl :: forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg f -> c (HeaderArg f)
$cp1Data :: forall f. Data f => Typeable (HeaderArg f)
Data, HeaderArg f -> HeaderArg f -> Bool
(HeaderArg f -> HeaderArg f -> Bool)
-> (HeaderArg f -> HeaderArg f -> Bool) -> Eq (HeaderArg f)
forall f. Eq f => HeaderArg f -> HeaderArg f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderArg f -> HeaderArg f -> Bool
$c/= :: forall f. Eq f => HeaderArg f -> HeaderArg f -> Bool
== :: HeaderArg f -> HeaderArg f -> Bool
$c== :: forall f. Eq f => HeaderArg f -> HeaderArg f -> Bool
Eq, Int -> HeaderArg f -> ShowS
[HeaderArg f] -> ShowS
HeaderArg f -> String
(Int -> HeaderArg f -> ShowS)
-> (HeaderArg f -> String)
-> ([HeaderArg f] -> ShowS)
-> Show (HeaderArg f)
forall f. Show f => Int -> HeaderArg f -> ShowS
forall f. Show f => [HeaderArg f] -> ShowS
forall f. Show f => HeaderArg f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderArg f] -> ShowS
$cshowList :: forall f. Show f => [HeaderArg f] -> ShowS
show :: HeaderArg f -> String
$cshow :: forall f. Show f => HeaderArg f -> String
showsPrec :: Int -> HeaderArg f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> HeaderArg f -> ShowS
Show, Typeable)

makeLenses ''HeaderArg

makePrisms ''HeaderArg

data Url f = Url
  { Url f -> Path f
_path     :: Path f
  , Url f -> [QueryArg f]
_queryStr :: [QueryArg f]
  , Url f -> Maybe f
_frag     :: Maybe f
  }
  deriving (Typeable (Url f)
DataType
Constr
Typeable (Url f)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Url f -> c (Url f))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Url f))
-> (Url f -> Constr)
-> (Url f -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Url f)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Url f)))
-> ((forall b. Data b => b -> b) -> Url f -> Url f)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r)
-> (forall u. (forall d. Data d => d -> u) -> Url f -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Url f -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Url f -> m (Url f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Url f -> m (Url f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Url f -> m (Url f))
-> Data (Url f)
Url f -> DataType
Url f -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Url f))
(forall b. Data b => b -> b) -> Url f -> Url f
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url f -> c (Url f)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url f)
forall f. Data f => Typeable (Url f)
forall f. Data f => Url f -> DataType
forall f. Data f => Url f -> Constr
forall f. Data f => (forall b. Data b => b -> b) -> Url f -> Url f
forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Url f -> u
forall f u. Data f => (forall d. Data d => d -> u) -> Url f -> [u]
forall f r r'.
Data f =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r
forall f r r'.
Data f =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r
forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Url f -> m (Url f)
forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url f -> m (Url f)
forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url f)
forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url f -> c (Url f)
forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url f))
forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Url f))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Url f -> u
forall u. (forall d. Data d => d -> u) -> Url f -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Url f -> m (Url f)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Url f -> m (Url f)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url f)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url f -> c (Url f)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Url f))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Url f))
$cUrl :: Constr
$tUrl :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Url f -> m (Url f)
$cgmapMo :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url f -> m (Url f)
gmapMp :: (forall d. Data d => d -> m d) -> Url f -> m (Url f)
$cgmapMp :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url f -> m (Url f)
gmapM :: (forall d. Data d => d -> m d) -> Url f -> m (Url f)
$cgmapM :: forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Url f -> m (Url f)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Url f -> u
$cgmapQi :: forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Url f -> u
gmapQ :: (forall d. Data d => d -> u) -> Url f -> [u]
$cgmapQ :: forall f u. Data f => (forall d. Data d => d -> u) -> Url f -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r
$cgmapQr :: forall f r r'.
Data f =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r
$cgmapQl :: forall f r r'.
Data f =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Url f -> r
gmapT :: (forall b. Data b => b -> b) -> Url f -> Url f
$cgmapT :: forall f. Data f => (forall b. Data b => b -> b) -> Url f -> Url f
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Url f))
$cdataCast2 :: forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Url f))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Url f))
$cdataCast1 :: forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url f))
dataTypeOf :: Url f -> DataType
$cdataTypeOf :: forall f. Data f => Url f -> DataType
toConstr :: Url f -> Constr
$ctoConstr :: forall f. Data f => Url f -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url f)
$cgunfold :: forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url f)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url f -> c (Url f)
$cgfoldl :: forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url f -> c (Url f)
$cp1Data :: forall f. Data f => Typeable (Url f)
Data, Url f -> Url f -> Bool
(Url f -> Url f -> Bool) -> (Url f -> Url f -> Bool) -> Eq (Url f)
forall f. Eq f => Url f -> Url f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Url f -> Url f -> Bool
$c/= :: forall f. Eq f => Url f -> Url f -> Bool
== :: Url f -> Url f -> Bool
$c== :: forall f. Eq f => Url f -> Url f -> Bool
Eq, Int -> Url f -> ShowS
[Url f] -> ShowS
Url f -> String
(Int -> Url f -> ShowS)
-> (Url f -> String) -> ([Url f] -> ShowS) -> Show (Url f)
forall f. Show f => Int -> Url f -> ShowS
forall f. Show f => [Url f] -> ShowS
forall f. Show f => Url f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Url f] -> ShowS
$cshowList :: forall f. Show f => [Url f] -> ShowS
show :: Url f -> String
$cshow :: forall f. Show f => Url f -> String
showsPrec :: Int -> Url f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Url f -> ShowS
Show, Typeable)

defUrl :: Url f
defUrl :: Url f
defUrl = Path f -> [QueryArg f] -> Maybe f -> Url f
forall f. Path f -> [QueryArg f] -> Maybe f -> Url f
Url [] [] Maybe f
forall a. Maybe a
Nothing

makeLenses ''Url

data ReqBodyContentType = ReqBodyJSON | ReqBodyMultipart
  deriving (Typeable ReqBodyContentType
DataType
Constr
Typeable ReqBodyContentType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ReqBodyContentType
    -> c ReqBodyContentType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ReqBodyContentType)
-> (ReqBodyContentType -> Constr)
-> (ReqBodyContentType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ReqBodyContentType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ReqBodyContentType))
-> ((forall b. Data b => b -> b)
    -> ReqBodyContentType -> ReqBodyContentType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ReqBodyContentType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ReqBodyContentType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ReqBodyContentType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ReqBodyContentType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ReqBodyContentType -> m ReqBodyContentType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ReqBodyContentType -> m ReqBodyContentType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ReqBodyContentType -> m ReqBodyContentType)
-> Data ReqBodyContentType
ReqBodyContentType -> DataType
ReqBodyContentType -> Constr
(forall b. Data b => b -> b)
-> ReqBodyContentType -> ReqBodyContentType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ReqBodyContentType
-> c ReqBodyContentType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReqBodyContentType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ReqBodyContentType -> u
forall u. (forall d. Data d => d -> u) -> ReqBodyContentType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReqBodyContentType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReqBodyContentType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ReqBodyContentType -> m ReqBodyContentType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReqBodyContentType -> m ReqBodyContentType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReqBodyContentType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ReqBodyContentType
-> c ReqBodyContentType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReqBodyContentType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReqBodyContentType)
$cReqBodyMultipart :: Constr
$cReqBodyJSON :: Constr
$tReqBodyContentType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ReqBodyContentType -> m ReqBodyContentType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReqBodyContentType -> m ReqBodyContentType
gmapMp :: (forall d. Data d => d -> m d)
-> ReqBodyContentType -> m ReqBodyContentType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ReqBodyContentType -> m ReqBodyContentType
gmapM :: (forall d. Data d => d -> m d)
-> ReqBodyContentType -> m ReqBodyContentType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ReqBodyContentType -> m ReqBodyContentType
gmapQi :: Int -> (forall d. Data d => d -> u) -> ReqBodyContentType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ReqBodyContentType -> u
gmapQ :: (forall d. Data d => d -> u) -> ReqBodyContentType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ReqBodyContentType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReqBodyContentType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ReqBodyContentType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReqBodyContentType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ReqBodyContentType -> r
gmapT :: (forall b. Data b => b -> b)
-> ReqBodyContentType -> ReqBodyContentType
$cgmapT :: (forall b. Data b => b -> b)
-> ReqBodyContentType -> ReqBodyContentType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReqBodyContentType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ReqBodyContentType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ReqBodyContentType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ReqBodyContentType)
dataTypeOf :: ReqBodyContentType -> DataType
$cdataTypeOf :: ReqBodyContentType -> DataType
toConstr :: ReqBodyContentType -> Constr
$ctoConstr :: ReqBodyContentType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReqBodyContentType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ReqBodyContentType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ReqBodyContentType
-> c ReqBodyContentType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ReqBodyContentType
-> c ReqBodyContentType
$cp1Data :: Typeable ReqBodyContentType
Data, ReqBodyContentType -> ReqBodyContentType -> Bool
(ReqBodyContentType -> ReqBodyContentType -> Bool)
-> (ReqBodyContentType -> ReqBodyContentType -> Bool)
-> Eq ReqBodyContentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReqBodyContentType -> ReqBodyContentType -> Bool
$c/= :: ReqBodyContentType -> ReqBodyContentType -> Bool
== :: ReqBodyContentType -> ReqBodyContentType -> Bool
$c== :: ReqBodyContentType -> ReqBodyContentType -> Bool
Eq, Int -> ReqBodyContentType -> ShowS
[ReqBodyContentType] -> ShowS
ReqBodyContentType -> String
(Int -> ReqBodyContentType -> ShowS)
-> (ReqBodyContentType -> String)
-> ([ReqBodyContentType] -> ShowS)
-> Show ReqBodyContentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReqBodyContentType] -> ShowS
$cshowList :: [ReqBodyContentType] -> ShowS
show :: ReqBodyContentType -> String
$cshow :: ReqBodyContentType -> String
showsPrec :: Int -> ReqBodyContentType -> ShowS
$cshowsPrec :: Int -> ReqBodyContentType -> ShowS
Show, ReadPrec [ReqBodyContentType]
ReadPrec ReqBodyContentType
Int -> ReadS ReqBodyContentType
ReadS [ReqBodyContentType]
(Int -> ReadS ReqBodyContentType)
-> ReadS [ReqBodyContentType]
-> ReadPrec ReqBodyContentType
-> ReadPrec [ReqBodyContentType]
-> Read ReqBodyContentType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReqBodyContentType]
$creadListPrec :: ReadPrec [ReqBodyContentType]
readPrec :: ReadPrec ReqBodyContentType
$creadPrec :: ReadPrec ReqBodyContentType
readList :: ReadS [ReqBodyContentType]
$creadList :: ReadS [ReqBodyContentType]
readsPrec :: Int -> ReadS ReqBodyContentType
$creadsPrec :: Int -> ReadS ReqBodyContentType
Read)

data Req f = Req
  { Req f -> Url f
_reqUrl             :: Url f
  , Req f -> Method
_reqMethod          :: HTTP.Method
  , Req f -> [HeaderArg f]
_reqHeaders         :: [HeaderArg f]
  , Req f -> Maybe f
_reqBody            :: Maybe f
  , Req f -> Maybe f
_reqReturnType      :: Maybe f
  , Req f -> FunctionName
_reqFuncName        :: FunctionName
  , Req f -> ReqBodyContentType
_reqBodyContentType :: ReqBodyContentType
  }
  deriving (Typeable (Req f)
DataType
Constr
Typeable (Req f)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Req f -> c (Req f))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Req f))
-> (Req f -> Constr)
-> (Req f -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Req f)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Req f)))
-> ((forall b. Data b => b -> b) -> Req f -> Req f)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r)
-> (forall u. (forall d. Data d => d -> u) -> Req f -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Req f -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Req f -> m (Req f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Req f -> m (Req f))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Req f -> m (Req f))
-> Data (Req f)
Req f -> DataType
Req f -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Req f))
(forall b. Data b => b -> b) -> Req f -> Req f
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req f -> c (Req f)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req f)
forall f. Data f => Typeable (Req f)
forall f. Data f => Req f -> DataType
forall f. Data f => Req f -> Constr
forall f. Data f => (forall b. Data b => b -> b) -> Req f -> Req f
forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Req f -> u
forall f u. Data f => (forall d. Data d => d -> u) -> Req f -> [u]
forall f r r'.
Data f =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r
forall f r r'.
Data f =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r
forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Req f -> m (Req f)
forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Req f -> m (Req f)
forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req f)
forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req f -> c (Req f)
forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Req f))
forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Req f))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Req f -> u
forall u. (forall d. Data d => d -> u) -> Req f -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Req f -> m (Req f)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Req f -> m (Req f)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req f)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req f -> c (Req f)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Req f))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Req f))
$cReq :: Constr
$tReq :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Req f -> m (Req f)
$cgmapMo :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Req f -> m (Req f)
gmapMp :: (forall d. Data d => d -> m d) -> Req f -> m (Req f)
$cgmapMp :: forall f (m :: * -> *).
(Data f, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Req f -> m (Req f)
gmapM :: (forall d. Data d => d -> m d) -> Req f -> m (Req f)
$cgmapM :: forall f (m :: * -> *).
(Data f, Monad m) =>
(forall d. Data d => d -> m d) -> Req f -> m (Req f)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Req f -> u
$cgmapQi :: forall f u.
Data f =>
Int -> (forall d. Data d => d -> u) -> Req f -> u
gmapQ :: (forall d. Data d => d -> u) -> Req f -> [u]
$cgmapQ :: forall f u. Data f => (forall d. Data d => d -> u) -> Req f -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r
$cgmapQr :: forall f r r'.
Data f =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r
$cgmapQl :: forall f r r'.
Data f =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Req f -> r
gmapT :: (forall b. Data b => b -> b) -> Req f -> Req f
$cgmapT :: forall f. Data f => (forall b. Data b => b -> b) -> Req f -> Req f
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Req f))
$cdataCast2 :: forall f (t :: * -> * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Req f))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Req f))
$cdataCast1 :: forall f (t :: * -> *) (c :: * -> *).
(Data f, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Req f))
dataTypeOf :: Req f -> DataType
$cdataTypeOf :: forall f. Data f => Req f -> DataType
toConstr :: Req f -> Constr
$ctoConstr :: forall f. Data f => Req f -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req f)
$cgunfold :: forall f (c :: * -> *).
Data f =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req f)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req f -> c (Req f)
$cgfoldl :: forall f (c :: * -> *).
Data f =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req f -> c (Req f)
$cp1Data :: forall f. Data f => Typeable (Req f)
Data, Req f -> Req f -> Bool
(Req f -> Req f -> Bool) -> (Req f -> Req f -> Bool) -> Eq (Req f)
forall f. Eq f => Req f -> Req f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Req f -> Req f -> Bool
$c/= :: forall f. Eq f => Req f -> Req f -> Bool
== :: Req f -> Req f -> Bool
$c== :: forall f. Eq f => Req f -> Req f -> Bool
Eq, Int -> Req f -> ShowS
[Req f] -> ShowS
Req f -> String
(Int -> Req f -> ShowS)
-> (Req f -> String) -> ([Req f] -> ShowS) -> Show (Req f)
forall f. Show f => Int -> Req f -> ShowS
forall f. Show f => [Req f] -> ShowS
forall f. Show f => Req f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Req f] -> ShowS
$cshowList :: forall f. Show f => [Req f] -> ShowS
show :: Req f -> String
$cshow :: forall f. Show f => Req f -> String
showsPrec :: Int -> Req f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Req f -> ShowS
Show, Typeable)

makeLenses ''Req

defReq :: Req ftype
defReq :: Req ftype
defReq = Url ftype
-> Method
-> [HeaderArg ftype]
-> Maybe ftype
-> Maybe ftype
-> FunctionName
-> ReqBodyContentType
-> Req ftype
forall f.
Url f
-> Method
-> [HeaderArg f]
-> Maybe f
-> Maybe f
-> FunctionName
-> ReqBodyContentType
-> Req f
Req Url ftype
forall f. Url f
defUrl Method
"GET" [] Maybe ftype
forall a. Maybe a
Nothing Maybe ftype
forall a. Maybe a
Nothing ([Text] -> FunctionName
FunctionName []) ReqBodyContentType
ReqBodyJSON

-- | 'HasForeignType' maps Haskell types with types in the target
-- language of your backend. For example, let's say you're
-- implementing a backend to some language __X__, and you want
-- a Text representation of each input/output type mentioned in the API:
--
-- > -- First you need to create a dummy type to parametrize your
-- > -- instances.
-- > data LangX
-- >
-- > -- Otherwise you define instances for the types you need
-- > instance HasForeignType LangX Text Int where
-- >    typeFor _ _ _ = "intX"
-- >
-- > -- Or for example in case of lists
-- > instance HasForeignType LangX Text a => HasForeignType LangX Text [a] where
-- >    typeFor lang type _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
--
-- Finally to generate list of information about all the endpoints for
-- an API you create a function of a form:
--
-- > getEndpoints :: (HasForeign LangX Text api, GenerateList Text (Foreign Text api))
-- >              => Proxy api -> [Req Text]
-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy Text) api
--
-- > -- If language __X__ is dynamically typed then you can use
-- > -- a predefined NoTypes parameter with the NoContent output type:
--
-- > getEndpoints :: (HasForeign NoTypes NoContent api, GenerateList Text (Foreign NoContent api))
-- >              => Proxy api -> [Req NoContent]
-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) api
-- >
--
class HasForeignType lang ftype a where
  typeFor :: Proxy lang -> Proxy ftype -> Proxy a -> ftype

data NoTypes

instance HasForeignType NoTypes NoContent ftype where
  typeFor :: Proxy NoTypes -> Proxy NoContent -> Proxy ftype -> NoContent
typeFor Proxy NoTypes
_ Proxy NoContent
_ Proxy ftype
_ = NoContent
NoContent

class HasForeign lang ftype (api :: *) where
  type Foreign ftype api :: *
  foreignFor :: Proxy lang -> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api

instance (HasForeign lang ftype a, HasForeign lang ftype b)
  => HasForeign lang ftype (a :<|> b) where
  type Foreign ftype (a :<|> b) = Foreign ftype a :<|> Foreign ftype b

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (a :<|> b)
-> Req ftype
-> Foreign ftype (a :<|> b)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (a :<|> b)
Proxy Req ftype
req =
         Proxy lang
-> Proxy ftype -> Proxy a -> Req ftype -> Foreign ftype a
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Req ftype
req
    Foreign ftype a
-> Foreign ftype b -> Foreign ftype a :<|> Foreign ftype b
forall a b. a -> b -> a :<|> b
:<|> Proxy lang
-> Proxy ftype -> Proxy b -> Req ftype -> Foreign ftype b
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) Req ftype
req

data EmptyForeignAPI = EmptyForeignAPI

instance HasForeign lang ftype EmptyAPI where
  type Foreign ftype EmptyAPI = EmptyForeignAPI

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy EmptyAPI
-> Req ftype
-> Foreign ftype EmptyAPI
foreignFor Proxy lang
Proxy Proxy ftype
Proxy Proxy EmptyAPI
Proxy Req ftype
_ = EmptyForeignAPI
Foreign ftype EmptyAPI
EmptyForeignAPI

instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)
  => HasForeign lang ftype (Capture' mods sym t :> api) where
  type Foreign ftype (Capture' mods sym t :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (Capture' mods sym t :> api)
-> Req ftype
-> Foreign ftype (Capture' mods sym t :> api)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (Capture' mods sym t :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
forall k (t :: k). Proxy t
Proxy (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Req ftype -> Foreign ftype api) -> Req ftype -> Foreign ftype api
forall a b. (a -> b) -> a -> b
$
      Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Url ftype -> Identity (Url ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Url f)
reqUrl ((Url ftype -> Identity (Url ftype))
 -> Req ftype -> Identity (Req ftype))
-> ((Path ftype -> Identity (Path ftype))
    -> Url ftype -> Identity (Url ftype))
-> (Path ftype -> Identity (Path ftype))
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path ftype -> Identity (Path ftype))
-> Url ftype -> Identity (Url ftype)
forall f. Lens' (Url f) (Path f)
path ((Path ftype -> Identity (Path ftype))
 -> Req ftype -> Identity (Req ftype))
-> Path ftype -> Req ftype -> Req ftype
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [SegmentType ftype -> Segment ftype
forall f. SegmentType f -> Segment f
Segment (Arg ftype -> SegmentType ftype
forall f. Arg f -> SegmentType f
Cap Arg ftype
arg)]
          Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (FunctionName -> Identity FunctionName)
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) FunctionName
reqFuncName ((FunctionName -> Identity FunctionName)
 -> Req ftype -> Identity (Req ftype))
-> (([Text] -> Identity [Text])
    -> FunctionName -> Identity FunctionName)
-> ([Text] -> Identity [Text])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Identity [Text])
-> FunctionName -> Identity FunctionName
Iso' FunctionName [Text]
_FunctionName (([Text] -> Identity [Text]) -> Req ftype -> Identity (Req ftype))
-> ([Text] -> [Text]) -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"by", Text
str])
    where
      str :: Text
str   = String -> Text
pack (String -> Text) -> (Proxy sym -> String) -> Proxy sym -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym -> Text) -> Proxy sym -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
      ftype :: ftype
ftype = Proxy lang -> Proxy ftype -> Proxy t -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t)
      arg :: Arg ftype
arg   = Arg :: forall f. PathSegment -> f -> Arg f
Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
str
        , _argType :: ftype
_argType = ftype
ftype }

instance (KnownSymbol sym, HasForeignType lang ftype [t], HasForeign lang ftype sublayout)
  => HasForeign lang ftype (CaptureAll sym t :> sublayout) where
  type Foreign ftype (CaptureAll sym t :> sublayout) = Foreign ftype sublayout

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (CaptureAll sym t :> sublayout)
-> Req ftype
-> Foreign ftype (CaptureAll sym t :> sublayout)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (CaptureAll sym t :> sublayout)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype
-> Proxy sublayout
-> Req ftype
-> Foreign ftype sublayout
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
forall k (t :: k). Proxy t
Proxy (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) (Req ftype -> Foreign ftype sublayout)
-> Req ftype -> Foreign ftype sublayout
forall a b. (a -> b) -> a -> b
$
      Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Url ftype -> Identity (Url ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Url f)
reqUrl ((Url ftype -> Identity (Url ftype))
 -> Req ftype -> Identity (Req ftype))
-> ((Path ftype -> Identity (Path ftype))
    -> Url ftype -> Identity (Url ftype))
-> (Path ftype -> Identity (Path ftype))
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path ftype -> Identity (Path ftype))
-> Url ftype -> Identity (Url ftype)
forall f. Lens' (Url f) (Path f)
path ((Path ftype -> Identity (Path ftype))
 -> Req ftype -> Identity (Req ftype))
-> Path ftype -> Req ftype -> Req ftype
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [SegmentType ftype -> Segment ftype
forall f. SegmentType f -> Segment f
Segment (Arg ftype -> SegmentType ftype
forall f. Arg f -> SegmentType f
Cap Arg ftype
arg)]
          Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (FunctionName -> Identity FunctionName)
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) FunctionName
reqFuncName ((FunctionName -> Identity FunctionName)
 -> Req ftype -> Identity (Req ftype))
-> (([Text] -> Identity [Text])
    -> FunctionName -> Identity FunctionName)
-> ([Text] -> Identity [Text])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Identity [Text])
-> FunctionName -> Identity FunctionName
Iso' FunctionName [Text]
_FunctionName (([Text] -> Identity [Text]) -> Req ftype -> Identity (Req ftype))
-> ([Text] -> [Text]) -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"by", Text
str])
    where
      str :: Text
str   = String -> Text
pack (String -> Text) -> (Proxy sym -> String) -> Proxy sym -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym -> Text) -> Proxy sym -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
      ftype :: ftype
ftype = Proxy lang -> Proxy ftype -> Proxy [t] -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy [t]
forall k (t :: k). Proxy t
Proxy :: Proxy [t])
      arg :: Arg ftype
arg   = Arg :: forall f. PathSegment -> f -> Arg f
Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
str
        , _argType :: ftype
_argType = ftype
ftype }

instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
  => HasForeign lang ftype (Verb method status list a) where
  type Foreign ftype (Verb method status list a) = Req ftype

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (Verb method status list a)
-> Req ftype
-> Foreign ftype (Verb method status list a)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (Verb method status list a)
Proxy Req ftype
req =
    Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (FunctionName -> Identity FunctionName)
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) FunctionName
reqFuncName ((FunctionName -> Identity FunctionName)
 -> Req ftype -> Identity (Req ftype))
-> (([Text] -> Identity [Text])
    -> FunctionName -> Identity FunctionName)
-> ([Text] -> Identity [Text])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Identity [Text])
-> FunctionName -> Identity FunctionName
Iso' FunctionName [Text]
_FunctionName (([Text] -> Identity [Text]) -> Req ftype -> Identity (Req ftype))
-> ([Text] -> [Text]) -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
methodLC Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
        Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Method -> Identity Method) -> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) Method
reqMethod ((Method -> Identity Method) -> Req ftype -> Identity (Req ftype))
-> Method -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Method
method
        Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Maybe ftype -> Identity (Maybe ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Maybe f)
reqReturnType ((Maybe ftype -> Identity (Maybe ftype))
 -> Req ftype -> Identity (Req ftype))
-> Maybe ftype -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ftype -> Maybe ftype
forall a. a -> Maybe a
Just ftype
retType
    where
      retType :: ftype
retType  = Proxy lang -> Proxy ftype -> Proxy a -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
      method :: Method
method   = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
      methodLC :: Text
methodLC = Text -> Text
toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Method -> Text
decodeUtf8 Method
method

instance (HasForeignType lang ftype NoContent, ReflectMethod method)
  => HasForeign lang ftype (NoContentVerb method) where
  type Foreign ftype (NoContentVerb method) = Req ftype

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (NoContentVerb method)
-> Req ftype
-> Foreign ftype (NoContentVerb method)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (NoContentVerb method)
Proxy Req ftype
req =
    Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (FunctionName -> Identity FunctionName)
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) FunctionName
reqFuncName ((FunctionName -> Identity FunctionName)
 -> Req ftype -> Identity (Req ftype))
-> (([Text] -> Identity [Text])
    -> FunctionName -> Identity FunctionName)
-> ([Text] -> Identity [Text])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Identity [Text])
-> FunctionName -> Identity FunctionName
Iso' FunctionName [Text]
_FunctionName (([Text] -> Identity [Text]) -> Req ftype -> Identity (Req ftype))
-> ([Text] -> [Text]) -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
methodLC Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
        Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Method -> Identity Method) -> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) Method
reqMethod ((Method -> Identity Method) -> Req ftype -> Identity (Req ftype))
-> Method -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Method
method
        Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Maybe ftype -> Identity (Maybe ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Maybe f)
reqReturnType ((Maybe ftype -> Identity (Maybe ftype))
 -> Req ftype -> Identity (Req ftype))
-> Maybe ftype -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ftype -> Maybe ftype
forall a. a -> Maybe a
Just ftype
retType
    where
      retType :: ftype
retType  = Proxy lang -> Proxy ftype -> Proxy NoContent -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy NoContent
forall k (t :: k). Proxy t
Proxy :: Proxy NoContent)
      method :: Method
method   = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
      methodLC :: Text
methodLC = Text -> Text
toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Method -> Text
decodeUtf8 Method
method

-- | TODO: doesn't taking framing into account.
instance (ct ~ JSON, HasForeignType lang ftype a, ReflectMethod method)
  => HasForeign lang ftype (Stream method status framing ct a) where
  type Foreign ftype (Stream method status framing ct a) = Req ftype

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (Stream method status framing ct a)
-> Req ftype
-> Foreign ftype (Stream method status framing ct a)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (Stream method status framing ct a)
Proxy Req ftype
req =
    Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (FunctionName -> Identity FunctionName)
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) FunctionName
reqFuncName ((FunctionName -> Identity FunctionName)
 -> Req ftype -> Identity (Req ftype))
-> (([Text] -> Identity [Text])
    -> FunctionName -> Identity FunctionName)
-> ([Text] -> Identity [Text])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Identity [Text])
-> FunctionName -> Identity FunctionName
Iso' FunctionName [Text]
_FunctionName (([Text] -> Identity [Text]) -> Req ftype -> Identity (Req ftype))
-> ([Text] -> [Text]) -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
methodLC Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
        Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Method -> Identity Method) -> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) Method
reqMethod ((Method -> Identity Method) -> Req ftype -> Identity (Req ftype))
-> Method -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Method
method
        Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Maybe ftype -> Identity (Maybe ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Maybe f)
reqReturnType ((Maybe ftype -> Identity (Maybe ftype))
 -> Req ftype -> Identity (Req ftype))
-> Maybe ftype -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ftype -> Maybe ftype
forall a. a -> Maybe a
Just ftype
retType
    where
      retType :: ftype
retType  = Proxy lang -> Proxy ftype -> Proxy a -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
      method :: Method
method   = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
      methodLC :: Text
methodLC = Text -> Text
toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Method -> Text
decodeUtf8 Method
method

instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
  => HasForeign lang ftype (Header' mods sym a :> api) where
  type Foreign ftype (Header' mods sym a :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (Header' mods sym a :> api)
-> Req ftype
-> Foreign ftype (Header' mods sym a :> api)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (Header' mods sym a :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
forall k (t :: k). Proxy t
Proxy Proxy api
subP (Req ftype -> Foreign ftype api) -> Req ftype -> Foreign ftype api
forall a b. (a -> b) -> a -> b
$ Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& ([HeaderArg ftype] -> Identity [HeaderArg ftype])
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) [HeaderArg f]
reqHeaders (([HeaderArg ftype] -> Identity [HeaderArg ftype])
 -> Req ftype -> Identity (Req ftype))
-> [HeaderArg ftype] -> Req ftype -> Req ftype
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Arg ftype -> HeaderArg ftype
forall f. Arg f -> HeaderArg f
HeaderArg Arg ftype
arg]
    where
      hname :: Text
hname = String -> Text
pack (String -> Text) -> (Proxy sym -> String) -> Proxy sym -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym -> Text) -> Proxy sym -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
      arg :: Arg ftype
arg   = Arg :: forall f. PathSegment -> f -> Arg f
Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
hname
        , _argType :: ftype
_argType  = Proxy lang
-> Proxy ftype -> Proxy (RequiredArgument mods a) -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy (RequiredArgument mods a)
forall k (t :: k). Proxy t
Proxy :: Proxy (RequiredArgument mods a)) }
      subP :: Proxy api
subP  = Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api

instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
  => HasForeign lang ftype (QueryParam' mods sym a :> api) where
  type Foreign ftype (QueryParam' mods sym a :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (QueryParam' mods sym a :> api)
-> Req ftype
-> Foreign ftype (QueryParam' mods sym a :> api)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (QueryParam' mods sym a :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Req ftype -> Foreign ftype api) -> Req ftype -> Foreign ftype api
forall a b. (a -> b) -> a -> b
$
      Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Url ftype -> Identity (Url ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Url f)
reqUrl((Url ftype -> Identity (Url ftype))
 -> Req ftype -> Identity (Req ftype))
-> (([QueryArg ftype] -> Identity [QueryArg ftype])
    -> Url ftype -> Identity (Url ftype))
-> ([QueryArg ftype] -> Identity [QueryArg ftype])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([QueryArg ftype] -> Identity [QueryArg ftype])
-> Url ftype -> Identity (Url ftype)
forall f. Lens' (Url f) [QueryArg f]
queryStr (([QueryArg ftype] -> Identity [QueryArg ftype])
 -> Req ftype -> Identity (Req ftype))
-> [QueryArg ftype] -> Req ftype -> Req ftype
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Arg ftype -> ArgType -> QueryArg ftype
forall f. Arg f -> ArgType -> QueryArg f
QueryArg Arg ftype
arg ArgType
Normal]
    where
      str :: Text
str = String -> Text
pack (String -> Text) -> (Proxy sym -> String) -> Proxy sym -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym -> Text) -> Proxy sym -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
      arg :: Arg ftype
arg = Arg :: forall f. PathSegment -> f -> Arg f
Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
str
        , _argType :: ftype
_argType = Proxy lang
-> Proxy ftype -> Proxy (RequiredArgument mods a) -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy (RequiredArgument mods a)
forall k (t :: k). Proxy t
Proxy :: Proxy (RequiredArgument mods a)) }

instance
  (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype api)
  => HasForeign lang ftype (QueryParams sym a :> api) where
  type Foreign ftype (QueryParams sym a :> api) = Foreign ftype api
  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (QueryParams sym a :> api)
-> Req ftype
-> Foreign ftype (QueryParams sym a :> api)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (QueryParams sym a :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Req ftype -> Foreign ftype api) -> Req ftype -> Foreign ftype api
forall a b. (a -> b) -> a -> b
$
      Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Url ftype -> Identity (Url ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Url f)
reqUrl((Url ftype -> Identity (Url ftype))
 -> Req ftype -> Identity (Req ftype))
-> (([QueryArg ftype] -> Identity [QueryArg ftype])
    -> Url ftype -> Identity (Url ftype))
-> ([QueryArg ftype] -> Identity [QueryArg ftype])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([QueryArg ftype] -> Identity [QueryArg ftype])
-> Url ftype -> Identity (Url ftype)
forall f. Lens' (Url f) [QueryArg f]
queryStr (([QueryArg ftype] -> Identity [QueryArg ftype])
 -> Req ftype -> Identity (Req ftype))
-> [QueryArg ftype] -> Req ftype -> Req ftype
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Arg ftype -> ArgType -> QueryArg ftype
forall f. Arg f -> ArgType -> QueryArg f
QueryArg Arg ftype
arg ArgType
List]
    where
      str :: Text
str = String -> Text
pack (String -> Text) -> (Proxy sym -> String) -> Proxy sym -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym -> Text) -> Proxy sym -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
      arg :: Arg ftype
arg = Arg :: forall f. PathSegment -> f -> Arg f
Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
str
        , _argType :: ftype
_argType = Proxy lang -> Proxy ftype -> Proxy [a] -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy [a]
forall k (t :: k). Proxy t
Proxy :: Proxy [a]) }

instance
  (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype api)
  => HasForeign lang ftype (QueryFlag sym :> api) where
  type Foreign ftype (QueryFlag sym :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (QueryFlag sym :> api)
-> Req ftype
-> Foreign ftype (QueryFlag sym :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (QueryFlag sym :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Req ftype -> Foreign ftype api) -> Req ftype -> Foreign ftype api
forall a b. (a -> b) -> a -> b
$
      Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Url ftype -> Identity (Url ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Url f)
reqUrl((Url ftype -> Identity (Url ftype))
 -> Req ftype -> Identity (Req ftype))
-> (([QueryArg ftype] -> Identity [QueryArg ftype])
    -> Url ftype -> Identity (Url ftype))
-> ([QueryArg ftype] -> Identity [QueryArg ftype])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([QueryArg ftype] -> Identity [QueryArg ftype])
-> Url ftype -> Identity (Url ftype)
forall f. Lens' (Url f) [QueryArg f]
queryStr (([QueryArg ftype] -> Identity [QueryArg ftype])
 -> Req ftype -> Identity (Req ftype))
-> [QueryArg ftype] -> Req ftype -> Req ftype
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [Arg ftype -> ArgType -> QueryArg ftype
forall f. Arg f -> ArgType -> QueryArg f
QueryArg Arg ftype
arg ArgType
Flag]
    where
      str :: Text
str = String -> Text
pack (String -> Text) -> (Proxy sym -> String) -> Proxy sym -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym -> Text) -> Proxy sym -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
      arg :: Arg ftype
arg = Arg :: forall f. PathSegment -> f -> Arg f
Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
str
        , _argType :: ftype
_argType = Proxy lang -> Proxy ftype -> Proxy Bool -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang Proxy ftype
ftype (Proxy Bool
forall k (t :: k). Proxy t
Proxy :: Proxy Bool) }

instance
  (HasForeignType lang ftype (Maybe a), HasForeign lang ftype api)
  => HasForeign lang ftype (Fragment a :> api) where
  type Foreign ftype (Fragment a :> api) = Foreign ftype api
  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (Fragment a :> api)
-> Req ftype
-> Foreign ftype (Fragment a :> api)
foreignFor Proxy lang
lang Proxy ftype
Proxy Proxy (Fragment a :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Req ftype -> Foreign ftype api) -> Req ftype -> Foreign ftype api
forall a b. (a -> b) -> a -> b
$
      Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Url ftype -> Identity (Url ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Url f)
reqUrl ((Url ftype -> Identity (Url ftype))
 -> Req ftype -> Identity (Req ftype))
-> ((Maybe ftype -> Identity (Maybe ftype))
    -> Url ftype -> Identity (Url ftype))
-> (Maybe ftype -> Identity (Maybe ftype))
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ftype -> Identity (Maybe ftype))
-> Url ftype -> Identity (Url ftype)
forall f. Lens' (Url f) (Maybe f)
frag ((Maybe ftype -> Identity (Maybe ftype))
 -> Req ftype -> Identity (Req ftype))
-> Maybe ftype -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ftype -> Maybe ftype
forall a. a -> Maybe a
Just ftype
argT
    where
      argT :: ftype
argT = Proxy lang -> Proxy ftype -> Proxy (Maybe a) -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (Proxy ftype
forall k (t :: k). Proxy t
Proxy :: Proxy ftype) (Proxy (Maybe a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Maybe a))

instance HasForeign lang ftype Raw where
  type Foreign ftype Raw = HTTP.Method -> Req ftype

  foreignFor :: Proxy lang
-> Proxy ftype -> Proxy Raw -> Req ftype -> Foreign ftype Raw
foreignFor Proxy lang
_ Proxy ftype
Proxy Proxy Raw
Proxy Req ftype
req Method
method =
    Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (FunctionName -> Identity FunctionName)
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) FunctionName
reqFuncName ((FunctionName -> Identity FunctionName)
 -> Req ftype -> Identity (Req ftype))
-> (([Text] -> Identity [Text])
    -> FunctionName -> Identity FunctionName)
-> ([Text] -> Identity [Text])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Identity [Text])
-> FunctionName -> Identity FunctionName
Iso' FunctionName [Text]
_FunctionName (([Text] -> Identity [Text]) -> Req ftype -> Identity (Req ftype))
-> ([Text] -> [Text]) -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Text -> Text
toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Method -> Text
decodeUtf8 Method
method) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
        Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Method -> Identity Method) -> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) Method
reqMethod ((Method -> Identity Method) -> Req ftype -> Identity (Req ftype))
-> Method -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Method
method

instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api)
      => HasForeign lang ftype (ReqBody' mods list a :> api) where
  type Foreign ftype (ReqBody' mods list a :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (ReqBody' mods list a :> api)
-> Req ftype
-> Foreign ftype (ReqBody' mods list a :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (ReqBody' mods list a :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Req ftype -> Foreign ftype api) -> Req ftype -> Foreign ftype api
forall a b. (a -> b) -> a -> b
$
      Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Maybe ftype -> Identity (Maybe ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Maybe f)
reqBody ((Maybe ftype -> Identity (Maybe ftype))
 -> Req ftype -> Identity (Req ftype))
-> Maybe ftype -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (ftype -> Maybe ftype
forall a. a -> Maybe a
Just (ftype -> Maybe ftype) -> ftype -> Maybe ftype
forall a b. (a -> b) -> a -> b
$ Proxy lang -> Proxy ftype -> Proxy a -> ftype
forall k k (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang Proxy ftype
ftype (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

instance
    ( HasForeign lang ftype api
    ) =>  HasForeign lang ftype (StreamBody' mods framing ctype a :> api)
  where
    type Foreign ftype (StreamBody' mods framing ctype a :> api) = Foreign ftype api

    foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (StreamBody' mods framing ctype a :> api)
-> Req ftype
-> Foreign ftype (StreamBody' mods framing ctype a :> api)
foreignFor Proxy lang
_lang Proxy ftype
Proxy Proxy (StreamBody' mods framing ctype a :> api)
Proxy Req ftype
_req = String -> Foreign ftype api
forall a. HasCallStack => String -> a
error String
"HasForeign @StreamBody"

instance (KnownSymbol path, HasForeign lang ftype api)
      => HasForeign lang ftype (path :> api) where
  type Foreign ftype (path :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (path :> api)
-> Req ftype
-> Foreign ftype (path :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (path :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Req ftype -> Foreign ftype api) -> Req ftype -> Foreign ftype api
forall a b. (a -> b) -> a -> b
$
      Req ftype
req Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (Url ftype -> Identity (Url ftype))
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) (Url f)
reqUrl ((Url ftype -> Identity (Url ftype))
 -> Req ftype -> Identity (Req ftype))
-> ((Path ftype -> Identity (Path ftype))
    -> Url ftype -> Identity (Url ftype))
-> (Path ftype -> Identity (Path ftype))
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path ftype -> Identity (Path ftype))
-> Url ftype -> Identity (Url ftype)
forall f. Lens' (Url f) (Path f)
path ((Path ftype -> Identity (Path ftype))
 -> Req ftype -> Identity (Req ftype))
-> Path ftype -> Req ftype -> Req ftype
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [SegmentType ftype -> Segment ftype
forall f. SegmentType f -> Segment f
Segment (PathSegment -> SegmentType ftype
forall f. PathSegment -> SegmentType f
Static (Text -> PathSegment
PathSegment Text
str))]
          Req ftype -> (Req ftype -> Req ftype) -> Req ftype
forall a b. a -> (a -> b) -> b
& (FunctionName -> Identity FunctionName)
-> Req ftype -> Identity (Req ftype)
forall f. Lens' (Req f) FunctionName
reqFuncName ((FunctionName -> Identity FunctionName)
 -> Req ftype -> Identity (Req ftype))
-> (([Text] -> Identity [Text])
    -> FunctionName -> Identity FunctionName)
-> ([Text] -> Identity [Text])
-> Req ftype
-> Identity (Req ftype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Identity [Text])
-> FunctionName -> Identity FunctionName
Iso' FunctionName [Text]
_FunctionName (([Text] -> Identity [Text]) -> Req ftype -> Identity (Req ftype))
-> ([Text] -> [Text]) -> Req ftype -> Req ftype
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
str])
    where
      str :: Text
str = String -> Text
pack (String -> Text) -> (Proxy path -> String) -> Proxy path -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy path -> Text) -> Proxy path -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy path
forall k (t :: k). Proxy t
Proxy :: Proxy path)

instance HasForeign lang ftype api
  => HasForeign lang ftype (RemoteHost :> api) where
  type Foreign ftype (RemoteHost :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (RemoteHost :> api)
-> Req ftype
-> Foreign ftype (RemoteHost :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (RemoteHost :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Req ftype
req

instance HasForeign lang ftype api
  => HasForeign lang ftype (IsSecure :> api) where
  type Foreign ftype (IsSecure :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (IsSecure :> api)
-> Req ftype
-> Foreign ftype (IsSecure :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (IsSecure :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Req ftype
req

instance HasForeign lang ftype api => HasForeign lang ftype (Vault :> api) where
  type Foreign ftype (Vault :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (Vault :> api)
-> Req ftype
-> Foreign ftype (Vault :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (Vault :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Req ftype
req

instance HasForeign lang ftype api =>
  HasForeign lang ftype (WithNamedContext name context api) where

  type Foreign ftype (WithNamedContext name context api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (WithNamedContext name context api)
-> Req ftype
-> Foreign ftype (WithNamedContext name context api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (WithNamedContext name context api)
Proxy = Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)

instance HasForeign lang ftype api
  => HasForeign lang ftype (HttpVersion :> api) where
  type Foreign ftype (HttpVersion :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (HttpVersion :> api)
-> Req ftype
-> Foreign ftype (HttpVersion :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (HttpVersion :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Req ftype
req

instance HasForeign lang ftype api
  => HasForeign lang ftype (Summary desc :> api) where
  type Foreign ftype (Summary desc :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (Summary desc :> api)
-> Req ftype
-> Foreign ftype (Summary desc :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (Summary desc :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Req ftype
req

instance HasForeign lang ftype api
  => HasForeign lang ftype (Description desc :> api) where
  type Foreign ftype (Description desc :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (Description desc :> api)
-> Req ftype
-> Foreign ftype (Description desc :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (Description desc :> api)
Proxy Req ftype
req =
    Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Req ftype
req

-- | Utility class used by 'listFromAPI' which computes
--   the data needed to generate a function for each endpoint
--   and hands it all back in a list.
class GenerateList ftype reqs where
  generateList :: reqs -> [Req ftype]

instance GenerateList ftype EmptyForeignAPI where
  generateList :: EmptyForeignAPI -> [Req ftype]
generateList EmptyForeignAPI
_ = []

instance GenerateList ftype (Req ftype) where
  generateList :: Req ftype -> [Req ftype]
generateList Req ftype
r = [Req ftype
r]

instance (GenerateList ftype start, GenerateList ftype rest)
  => GenerateList ftype (start :<|> rest) where
  generateList :: (start :<|> rest) -> [Req ftype]
generateList (start
start :<|> rest
rest) = (start -> [Req ftype]
forall ftype reqs. GenerateList ftype reqs => reqs -> [Req ftype]
generateList start
start) [Req ftype] -> [Req ftype] -> [Req ftype]
forall a. [a] -> [a] -> [a]
++ (rest -> [Req ftype]
forall ftype reqs. GenerateList ftype reqs => reqs -> [Req ftype]
generateList rest
rest)

-- | Generate the necessary data for codegen as a list, each 'Req'
--   describing one endpoint from your API type.
listFromAPI
  :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api))
  => Proxy lang
  -> Proxy ftype
  -> Proxy api
  -> [Req ftype]
listFromAPI :: Proxy lang -> Proxy ftype -> Proxy api -> [Req ftype]
listFromAPI Proxy lang
lang Proxy ftype
ftype Proxy api
p = Foreign ftype api -> [Req ftype]
forall ftype reqs. GenerateList ftype reqs => reqs -> [Req ftype]
generateList (Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
forall k (lang :: k) ftype api.
HasForeign lang ftype api =>
Proxy lang
-> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy api
p Req ftype
forall ftype. Req ftype
defReq)