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

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.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

-- | Canonical name of the endpoint, can be used to generate a function name.
--
-- You can use the functions in "Servant.Foreign.Inflections", like 'Servant.Foreign.Inflections.camelCase' to transform to `Text`.
newtype FunctionName = FunctionName { FunctionName -> [Text]
unFunctionName :: [Text] }
  deriving (Typeable FunctionName
FunctionName -> DataType
FunctionName -> Constr
(forall b. Data b => b -> b) -> FunctionName -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FunctionName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionName -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Int -> FunctionName -> ShowS
[FunctionName] -> ShowS
FunctionName -> String
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
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, NonEmpty FunctionName -> FunctionName
FunctionName -> FunctionName -> 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 :: forall b. Integral b => 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
[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
Monoid, Typeable)

makePrisms ''FunctionName

-- | See documentation of 'Arg'
newtype PathSegment = PathSegment { PathSegment -> Text
unPathSegment :: Text }
  deriving (Typeable PathSegment
PathSegment -> DataType
PathSegment -> Constr
(forall b. Data b => b -> b) -> PathSegment -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> PathSegment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PathSegment -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PathSegment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PathSegment -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Int -> PathSegment -> ShowS
[PathSegment] -> ShowS
PathSegment -> String
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
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
forall a. (String -> a) -> IsString a
fromString :: String -> PathSegment
$cfromString :: String -> PathSegment
IsString, NonEmpty PathSegment -> PathSegment
PathSegment -> PathSegment -> 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 :: forall b. Integral b => 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
[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
Monoid, Typeable)

makePrisms ''PathSegment

-- | Maps a name to the foreign type that belongs to the annotated value.
--
-- Used for header args, query args, and capture args.
data Arg ftype = Arg
  { forall ftype. Arg ftype -> PathSegment
_argName :: PathSegment
  -- ^ The name to be captured.
  --
  -- Only for capture args it really denotes a path segment.
  , forall ftype. Arg ftype -> ftype
_argType :: ftype
  -- ^ Foreign type the associated value will have
  }
  deriving (Arg ftype -> DataType
Arg ftype -> Constr
forall {ftype}. Data ftype => Typeable (Arg ftype)
forall ftype. Data ftype => Arg ftype -> DataType
forall ftype. Data ftype => Arg ftype -> Constr
forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> Arg ftype -> Arg ftype
forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> Arg ftype -> u
forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> Arg ftype -> [u]
forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Arg ftype -> r
forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Arg ftype -> r
forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d) -> Arg ftype -> m (Arg ftype)
forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg ftype -> m (Arg ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg ftype -> c (Arg ftype)
forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg ftype))
forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Arg ftype))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg ftype)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg ftype -> c (Arg ftype)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg ftype))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Arg ftype -> m (Arg ftype)
$cgmapMo :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg ftype -> m (Arg ftype)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Arg ftype -> m (Arg ftype)
$cgmapMp :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Arg ftype -> m (Arg ftype)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Arg ftype -> m (Arg ftype)
$cgmapM :: forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d) -> Arg ftype -> m (Arg ftype)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Arg ftype -> u
$cgmapQi :: forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> Arg ftype -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Arg ftype -> [u]
$cgmapQ :: forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> Arg ftype -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Arg ftype -> r
$cgmapQr :: forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Arg ftype -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Arg ftype -> r
$cgmapQl :: forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Arg ftype -> r
gmapT :: (forall b. Data b => b -> b) -> Arg ftype -> Arg ftype
$cgmapT :: forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> Arg ftype -> Arg ftype
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Arg ftype))
$cdataCast2 :: forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Arg ftype))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg ftype))
$cdataCast1 :: forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Arg ftype))
dataTypeOf :: Arg ftype -> DataType
$cdataTypeOf :: forall ftype. Data ftype => Arg ftype -> DataType
toConstr :: Arg ftype -> Constr
$ctoConstr :: forall ftype. Data ftype => Arg ftype -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg ftype)
$cgunfold :: forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Arg ftype)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg ftype -> c (Arg ftype)
$cgfoldl :: forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Arg ftype -> c (Arg ftype)
Data, Arg ftype -> Arg ftype -> Bool
forall ftype. Eq ftype => Arg ftype -> Arg ftype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arg ftype -> Arg ftype -> Bool
$c/= :: forall ftype. Eq ftype => Arg ftype -> Arg ftype -> Bool
== :: Arg ftype -> Arg ftype -> Bool
$c== :: forall ftype. Eq ftype => Arg ftype -> Arg ftype -> Bool
Eq, Int -> Arg ftype -> ShowS
forall ftype. Show ftype => Int -> Arg ftype -> ShowS
forall ftype. Show ftype => [Arg ftype] -> ShowS
forall ftype. Show ftype => Arg ftype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arg ftype] -> ShowS
$cshowList :: forall ftype. Show ftype => [Arg ftype] -> ShowS
show :: Arg ftype -> String
$cshow :: forall ftype. Show ftype => Arg ftype -> String
showsPrec :: Int -> Arg ftype -> ShowS
$cshowsPrec :: forall ftype. Show ftype => Int -> Arg ftype -> ShowS
Show, Typeable)

makeLenses ''Arg

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

data SegmentType ftype
  = Static PathSegment
    -- ^ Static path segment.
    --
    -- @"foo\/bar\/baz"@
    --
    -- contains the static segments @"foo"@, @"bar"@ and @"baz"@.
  | Cap (Arg ftype)
    -- ^ A capture.
    --
    -- @"user\/{userid}\/name"@
    --
    -- would capture the arg @userid@ with type @ftype@.
  deriving (SegmentType ftype -> DataType
SegmentType ftype -> Constr
forall {ftype}. Data ftype => Typeable (SegmentType ftype)
forall ftype. Data ftype => SegmentType ftype -> DataType
forall ftype. Data ftype => SegmentType ftype -> Constr
forall ftype.
Data ftype =>
(forall b. Data b => b -> b)
-> SegmentType ftype -> SegmentType ftype
forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> SegmentType ftype -> u
forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> SegmentType ftype -> [u]
forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType ftype -> r
forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType ftype -> r
forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d)
-> SegmentType ftype -> m (SegmentType ftype)
forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SegmentType ftype -> m (SegmentType ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SegmentType ftype
-> c (SegmentType ftype)
forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SegmentType ftype))
forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SegmentType ftype))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType ftype)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SegmentType ftype
-> c (SegmentType ftype)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SegmentType ftype))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SegmentType ftype -> m (SegmentType ftype)
$cgmapMo :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SegmentType ftype -> m (SegmentType ftype)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SegmentType ftype -> m (SegmentType ftype)
$cgmapMp :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SegmentType ftype -> m (SegmentType ftype)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SegmentType ftype -> m (SegmentType ftype)
$cgmapM :: forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d)
-> SegmentType ftype -> m (SegmentType ftype)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SegmentType ftype -> u
$cgmapQi :: forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> SegmentType ftype -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SegmentType ftype -> [u]
$cgmapQ :: forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> SegmentType ftype -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType ftype -> r
$cgmapQr :: forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType ftype -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType ftype -> r
$cgmapQl :: forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentType ftype -> r
gmapT :: (forall b. Data b => b -> b)
-> SegmentType ftype -> SegmentType ftype
$cgmapT :: forall ftype.
Data ftype =>
(forall b. Data b => b -> b)
-> SegmentType ftype -> SegmentType ftype
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SegmentType ftype))
$cdataCast2 :: forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SegmentType ftype))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SegmentType ftype))
$cdataCast1 :: forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SegmentType ftype))
dataTypeOf :: SegmentType ftype -> DataType
$cdataTypeOf :: forall ftype. Data ftype => SegmentType ftype -> DataType
toConstr :: SegmentType ftype -> Constr
$ctoConstr :: forall ftype. Data ftype => SegmentType ftype -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType ftype)
$cgunfold :: forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SegmentType ftype)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SegmentType ftype
-> c (SegmentType ftype)
$cgfoldl :: forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SegmentType ftype
-> c (SegmentType ftype)
Data, SegmentType ftype -> SegmentType ftype -> Bool
forall ftype.
Eq ftype =>
SegmentType ftype -> SegmentType ftype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentType ftype -> SegmentType ftype -> Bool
$c/= :: forall ftype.
Eq ftype =>
SegmentType ftype -> SegmentType ftype -> Bool
== :: SegmentType ftype -> SegmentType ftype -> Bool
$c== :: forall ftype.
Eq ftype =>
SegmentType ftype -> SegmentType ftype -> Bool
Eq, Int -> SegmentType ftype -> ShowS
forall ftype. Show ftype => Int -> SegmentType ftype -> ShowS
forall ftype. Show ftype => [SegmentType ftype] -> ShowS
forall ftype. Show ftype => SegmentType ftype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentType ftype] -> ShowS
$cshowList :: forall ftype. Show ftype => [SegmentType ftype] -> ShowS
show :: SegmentType ftype -> String
$cshow :: forall ftype. Show ftype => SegmentType ftype -> String
showsPrec :: Int -> SegmentType ftype -> ShowS
$cshowsPrec :: forall ftype. Show ftype => Int -> SegmentType ftype -> ShowS
Show, Typeable)

makePrisms ''SegmentType

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

makePrisms ''Segment

-- | Whether a segment is a 'Cap'.
isCapture :: Segment ftype -> Bool
isCapture :: forall ftype. Segment ftype -> Bool
isCapture (Segment (Cap Arg ftype
_)) = Bool
True
isCapture                Segment ftype
_  = Bool
False

-- | Crashing Arg extraction from segment, TODO: remove
captureArg :: Segment ftype -> Arg ftype
captureArg :: forall ftype. Segment ftype -> Arg ftype
captureArg (Segment (Cap Arg ftype
s)) = Arg ftype
s
captureArg                 Segment ftype
_ = forall a. HasCallStack => String -> a
error String
"captureArg called on non capture"

-- TODO: remove, unnecessary indirection
type Path ftype = [Segment ftype]

-- | Type of a 'QueryArg'.
data ArgType
  = Normal
  | Flag
  | List
  deriving (Typeable ArgType
ArgType -> DataType
ArgType -> Constr
(forall b. Data b => b -> b) -> ArgType -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> ArgType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ArgType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ArgType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArgType -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, ArgType -> ArgType -> Bool
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
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

-- | Url Query argument.
--
-- Urls can contain query arguments, which is a list of key-value pairs.
-- In a typical url, query arguments look like this:
--
-- @?foo=bar&alist[]=el1&alist[]=el2&aflag@
--
-- Each pair can be
--
-- * @?foo=bar@: a plain key-val pair, either optional or required ('QueryParam')
-- * @?aflag@: a flag (no value, implicitly Bool with default `false` if it’s missing) ('QueryFlag')
-- * @?alist[]=el1&alist[]=el2@: list of values ('QueryParams')
--
-- @_queryArgType@ will be set accordingly.
--
-- For the plain key-val pairs ('QueryParam'), @_queryArgName@’s @ftype@ will be wrapped in a @Maybe@ if the argument is optional.
data QueryArg ftype = QueryArg
  { forall ftype. QueryArg ftype -> Arg ftype
_queryArgName :: Arg ftype
  -- ^ Name and foreign type of the argument. Will be wrapped in `Maybe` if the query is optional and in a `[]` if the query is a list
  , forall ftype. QueryArg ftype -> ArgType
_queryArgType :: ArgType
  -- ^ one of normal/plain, list or flag
  }
  deriving (QueryArg ftype -> DataType
QueryArg ftype -> Constr
forall {ftype}. Data ftype => Typeable (QueryArg ftype)
forall ftype. Data ftype => QueryArg ftype -> DataType
forall ftype. Data ftype => QueryArg ftype -> Constr
forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> QueryArg ftype -> QueryArg ftype
forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> QueryArg ftype -> u
forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> QueryArg ftype -> [u]
forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg ftype -> r
forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg ftype -> r
forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d)
-> QueryArg ftype -> m (QueryArg ftype)
forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> QueryArg ftype -> m (QueryArg ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg ftype -> c (QueryArg ftype)
forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (QueryArg ftype))
forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QueryArg ftype))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg ftype)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg ftype -> c (QueryArg ftype)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (QueryArg ftype))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> QueryArg ftype -> m (QueryArg ftype)
$cgmapMo :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> QueryArg ftype -> m (QueryArg ftype)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> QueryArg ftype -> m (QueryArg ftype)
$cgmapMp :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> QueryArg ftype -> m (QueryArg ftype)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> QueryArg ftype -> m (QueryArg ftype)
$cgmapM :: forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d)
-> QueryArg ftype -> m (QueryArg ftype)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> QueryArg ftype -> u
$cgmapQi :: forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> QueryArg ftype -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> QueryArg ftype -> [u]
$cgmapQ :: forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> QueryArg ftype -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg ftype -> r
$cgmapQr :: forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg ftype -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg ftype -> r
$cgmapQl :: forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryArg ftype -> r
gmapT :: (forall b. Data b => b -> b) -> QueryArg ftype -> QueryArg ftype
$cgmapT :: forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> QueryArg ftype -> QueryArg ftype
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QueryArg ftype))
$cdataCast2 :: forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (QueryArg ftype))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (QueryArg ftype))
$cdataCast1 :: forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (QueryArg ftype))
dataTypeOf :: QueryArg ftype -> DataType
$cdataTypeOf :: forall ftype. Data ftype => QueryArg ftype -> DataType
toConstr :: QueryArg ftype -> Constr
$ctoConstr :: forall ftype. Data ftype => QueryArg ftype -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg ftype)
$cgunfold :: forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (QueryArg ftype)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg ftype -> c (QueryArg ftype)
$cgfoldl :: forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryArg ftype -> c (QueryArg ftype)
Data, QueryArg ftype -> QueryArg ftype -> Bool
forall ftype. Eq ftype => QueryArg ftype -> QueryArg ftype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryArg ftype -> QueryArg ftype -> Bool
$c/= :: forall ftype. Eq ftype => QueryArg ftype -> QueryArg ftype -> Bool
== :: QueryArg ftype -> QueryArg ftype -> Bool
$c== :: forall ftype. Eq ftype => QueryArg ftype -> QueryArg ftype -> Bool
Eq, Int -> QueryArg ftype -> ShowS
forall ftype. Show ftype => Int -> QueryArg ftype -> ShowS
forall ftype. Show ftype => [QueryArg ftype] -> ShowS
forall ftype. Show ftype => QueryArg ftype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryArg ftype] -> ShowS
$cshowList :: forall ftype. Show ftype => [QueryArg ftype] -> ShowS
show :: QueryArg ftype -> String
$cshow :: forall ftype. Show ftype => QueryArg ftype -> String
showsPrec :: Int -> QueryArg ftype -> ShowS
$cshowsPrec :: forall ftype. Show ftype => Int -> QueryArg ftype -> ShowS
Show, Typeable)

makeLenses ''QueryArg

data HeaderArg ftype =
  -- | The name of the header and the foreign type of its value.
  HeaderArg
  { forall ftype. HeaderArg ftype -> Arg ftype
_headerArg :: Arg ftype }
  -- | Unused, will never be set.
  --
  -- TODO: remove
  | ReplaceHeaderArg
  { _headerArg     :: Arg ftype
  , forall ftype. HeaderArg ftype -> Text
_headerPattern :: Text
  }
  deriving (HeaderArg ftype -> DataType
HeaderArg ftype -> Constr
forall {ftype}. Data ftype => Typeable (HeaderArg ftype)
forall ftype. Data ftype => HeaderArg ftype -> DataType
forall ftype. Data ftype => HeaderArg ftype -> Constr
forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> HeaderArg ftype -> HeaderArg ftype
forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> HeaderArg ftype -> u
forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> HeaderArg ftype -> [u]
forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg ftype -> r
forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg ftype -> r
forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d)
-> HeaderArg ftype -> m (HeaderArg ftype)
forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HeaderArg ftype -> m (HeaderArg ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg ftype -> c (HeaderArg ftype)
forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HeaderArg ftype))
forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HeaderArg ftype))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg ftype)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg ftype -> c (HeaderArg ftype)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HeaderArg ftype))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HeaderArg ftype -> m (HeaderArg ftype)
$cgmapMo :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HeaderArg ftype -> m (HeaderArg ftype)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HeaderArg ftype -> m (HeaderArg ftype)
$cgmapMp :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> HeaderArg ftype -> m (HeaderArg ftype)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HeaderArg ftype -> m (HeaderArg ftype)
$cgmapM :: forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d)
-> HeaderArg ftype -> m (HeaderArg ftype)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HeaderArg ftype -> u
$cgmapQi :: forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> HeaderArg ftype -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HeaderArg ftype -> [u]
$cgmapQ :: forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> HeaderArg ftype -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg ftype -> r
$cgmapQr :: forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg ftype -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg ftype -> r
$cgmapQl :: forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HeaderArg ftype -> r
gmapT :: (forall b. Data b => b -> b) -> HeaderArg ftype -> HeaderArg ftype
$cgmapT :: forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> HeaderArg ftype -> HeaderArg ftype
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HeaderArg ftype))
$cdataCast2 :: forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (HeaderArg ftype))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (HeaderArg ftype))
$cdataCast1 :: forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (HeaderArg ftype))
dataTypeOf :: HeaderArg ftype -> DataType
$cdataTypeOf :: forall ftype. Data ftype => HeaderArg ftype -> DataType
toConstr :: HeaderArg ftype -> Constr
$ctoConstr :: forall ftype. Data ftype => HeaderArg ftype -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg ftype)
$cgunfold :: forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HeaderArg ftype)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg ftype -> c (HeaderArg ftype)
$cgfoldl :: forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HeaderArg ftype -> c (HeaderArg ftype)
Data, HeaderArg ftype -> HeaderArg ftype -> Bool
forall ftype.
Eq ftype =>
HeaderArg ftype -> HeaderArg ftype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderArg ftype -> HeaderArg ftype -> Bool
$c/= :: forall ftype.
Eq ftype =>
HeaderArg ftype -> HeaderArg ftype -> Bool
== :: HeaderArg ftype -> HeaderArg ftype -> Bool
$c== :: forall ftype.
Eq ftype =>
HeaderArg ftype -> HeaderArg ftype -> Bool
Eq, Int -> HeaderArg ftype -> ShowS
forall ftype. Show ftype => Int -> HeaderArg ftype -> ShowS
forall ftype. Show ftype => [HeaderArg ftype] -> ShowS
forall ftype. Show ftype => HeaderArg ftype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderArg ftype] -> ShowS
$cshowList :: forall ftype. Show ftype => [HeaderArg ftype] -> ShowS
show :: HeaderArg ftype -> String
$cshow :: forall ftype. Show ftype => HeaderArg ftype -> String
showsPrec :: Int -> HeaderArg ftype -> ShowS
$cshowsPrec :: forall ftype. Show ftype => Int -> HeaderArg ftype -> ShowS
Show, Typeable)

makeLenses ''HeaderArg

makePrisms ''HeaderArg

-- | Full endpoint url, with all captures and parameters
data Url ftype = Url
  { forall ftype. Url ftype -> Path ftype
_path     :: Path ftype
  -- ^ Url path, list of either static segments or captures
  --
  -- @"foo\/{id}\/bar"@
  , forall ftype. Url ftype -> [QueryArg ftype]
_queryStr :: [QueryArg ftype]
  -- ^ List of query args
  --
  -- @"?foo=bar&a=b"@
  , forall ftype. Url ftype -> Maybe ftype
_frag     :: Maybe ftype
  -- ^ Url fragment.
  --
  -- Not sent to the HTTP server, so only useful for frontend matters (e.g. inter-page linking).
  --
  -- @#fragmentText@
  }
  deriving (Url ftype -> DataType
Url ftype -> Constr
forall {ftype}. Data ftype => Typeable (Url ftype)
forall ftype. Data ftype => Url ftype -> DataType
forall ftype. Data ftype => Url ftype -> Constr
forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> Url ftype -> Url ftype
forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> Url ftype -> u
forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> Url ftype -> [u]
forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url ftype -> r
forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url ftype -> r
forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d) -> Url ftype -> m (Url ftype)
forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url ftype -> m (Url ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url ftype -> c (Url ftype)
forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url ftype))
forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url ftype))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url ftype)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url ftype -> c (Url ftype)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Url ftype))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Url ftype -> m (Url ftype)
$cgmapMo :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url ftype -> m (Url ftype)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Url ftype -> m (Url ftype)
$cgmapMp :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Url ftype -> m (Url ftype)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Url ftype -> m (Url ftype)
$cgmapM :: forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d) -> Url ftype -> m (Url ftype)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Url ftype -> u
$cgmapQi :: forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> Url ftype -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Url ftype -> [u]
$cgmapQ :: forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> Url ftype -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url ftype -> r
$cgmapQr :: forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Url ftype -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url ftype -> r
$cgmapQl :: forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Url ftype -> r
gmapT :: (forall b. Data b => b -> b) -> Url ftype -> Url ftype
$cgmapT :: forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> Url ftype -> Url ftype
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url ftype))
$cdataCast2 :: forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Url ftype))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Url ftype))
$cdataCast1 :: forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Url ftype))
dataTypeOf :: Url ftype -> DataType
$cdataTypeOf :: forall ftype. Data ftype => Url ftype -> DataType
toConstr :: Url ftype -> Constr
$ctoConstr :: forall ftype. Data ftype => Url ftype -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url ftype)
$cgunfold :: forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Url ftype)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url ftype -> c (Url ftype)
$cgfoldl :: forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Url ftype -> c (Url ftype)
Data, Url ftype -> Url ftype -> Bool
forall ftype. Eq ftype => Url ftype -> Url ftype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Url ftype -> Url ftype -> Bool
$c/= :: forall ftype. Eq ftype => Url ftype -> Url ftype -> Bool
== :: Url ftype -> Url ftype -> Bool
$c== :: forall ftype. Eq ftype => Url ftype -> Url ftype -> Bool
Eq, Int -> Url ftype -> ShowS
forall ftype. Show ftype => Int -> Url ftype -> ShowS
forall ftype. Show ftype => [Url ftype] -> ShowS
forall ftype. Show ftype => Url ftype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Url ftype] -> ShowS
$cshowList :: forall ftype. Show ftype => [Url ftype] -> ShowS
show :: Url ftype -> String
$cshow :: forall ftype. Show ftype => Url ftype -> String
showsPrec :: Int -> Url ftype -> ShowS
$cshowsPrec :: forall ftype. Show ftype => Int -> Url ftype -> ShowS
Show, Typeable)

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

makeLenses ''Url

-- | See documentation of '_reqBodyContentType'
data ReqBodyContentType = ReqBodyJSON | ReqBodyMultipart
  deriving (Typeable ReqBodyContentType
ReqBodyContentType -> DataType
ReqBodyContentType -> Constr
(forall b. Data b => b -> b)
-> ReqBodyContentType -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> ReqBodyContentType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ReqBodyContentType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ReqBodyContentType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ReqBodyContentType -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, ReqBodyContentType -> ReqBodyContentType -> Bool
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
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]
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)

-- | Full description of an endpoint in your API, generated by 'listFromAPI'. It should give you all the information needed to generate foreign language bindings.
--
-- Every field containing @ftype@ will use the foreign type mapping specified via 'HasForeignType' (see its docstring on how to set that up).
--
-- See https://docs.servant.dev/en/stable/tutorial/ApiType.html for accessible documentation of the possible content of an endpoint.
data Req ftype = Req
  { forall ftype. Req ftype -> Url ftype
_reqUrl             :: Url ftype
  -- ^ Full list of URL segments, including captures
  , forall ftype. Req ftype -> Method
_reqMethod          :: HTTP.Method
  -- ^ @\"GET\"@\/@\"POST\"@\/@\"PUT\"@\/…
  , forall ftype. Req ftype -> [HeaderArg ftype]
_reqHeaders         :: [HeaderArg ftype]
  -- ^ Headers required by this endpoint, with their type
  , forall ftype. Req ftype -> Maybe ftype
_reqBody            :: Maybe ftype
  -- ^ Foreign type of the expected request body ('ReqBody'), if any
  , forall ftype. Req ftype -> Maybe ftype
_reqReturnType      :: Maybe ftype
  -- ^ The foreign type of the response, if any
  , forall ftype. Req ftype -> FunctionName
_reqFuncName        :: FunctionName
  -- ^ The URL segments rendered in a way that they can be easily concatenated into a canonical function name
  , forall ftype. Req ftype -> ReqBodyContentType
_reqBodyContentType :: ReqBodyContentType
  -- ^ The content type the request body is transferred as.
  --
  -- This is a severe limitation of @servant-foreign@ currently,
  -- as we only allow the content type to be `JSON`
  -- no user-defined content types. ('ReqBodyMultipart' is not
  -- actually implemented.)
  --
  -- Thus, any routes looking like this will work:
  --
  -- @"foo" :> Get '[JSON] Foo@
  --
  -- while routes like
  --
  -- @"foo" :> Get '[MyFancyContentType] Foo@
  --
  -- will fail with an error like
  --
  -- @• JSON expected in list '[MyFancyContentType]@
  }
  deriving (Req ftype -> DataType
Req ftype -> Constr
forall {ftype}. Data ftype => Typeable (Req ftype)
forall ftype. Data ftype => Req ftype -> DataType
forall ftype. Data ftype => Req ftype -> Constr
forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> Req ftype -> Req ftype
forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> Req ftype -> u
forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> Req ftype -> [u]
forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Req ftype -> r
forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Req ftype -> r
forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d) -> Req ftype -> m (Req ftype)
forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Req ftype -> m (Req ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req ftype)
forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req ftype -> c (Req ftype)
forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Req ftype))
forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Req ftype))
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 (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req ftype)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req ftype -> c (Req ftype)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Req ftype))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Req ftype -> m (Req ftype)
$cgmapMo :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Req ftype -> m (Req ftype)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Req ftype -> m (Req ftype)
$cgmapMp :: forall ftype (m :: * -> *).
(Data ftype, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Req ftype -> m (Req ftype)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Req ftype -> m (Req ftype)
$cgmapM :: forall ftype (m :: * -> *).
(Data ftype, Monad m) =>
(forall d. Data d => d -> m d) -> Req ftype -> m (Req ftype)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Req ftype -> u
$cgmapQi :: forall ftype u.
Data ftype =>
Int -> (forall d. Data d => d -> u) -> Req ftype -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Req ftype -> [u]
$cgmapQ :: forall ftype u.
Data ftype =>
(forall d. Data d => d -> u) -> Req ftype -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Req ftype -> r
$cgmapQr :: forall ftype r r'.
Data ftype =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Req ftype -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Req ftype -> r
$cgmapQl :: forall ftype r r'.
Data ftype =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Req ftype -> r
gmapT :: (forall b. Data b => b -> b) -> Req ftype -> Req ftype
$cgmapT :: forall ftype.
Data ftype =>
(forall b. Data b => b -> b) -> Req ftype -> Req ftype
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Req ftype))
$cdataCast2 :: forall ftype (t :: * -> * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Req ftype))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Req ftype))
$cdataCast1 :: forall ftype (t :: * -> *) (c :: * -> *).
(Data ftype, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Req ftype))
dataTypeOf :: Req ftype -> DataType
$cdataTypeOf :: forall ftype. Data ftype => Req ftype -> DataType
toConstr :: Req ftype -> Constr
$ctoConstr :: forall ftype. Data ftype => Req ftype -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req ftype)
$cgunfold :: forall ftype (c :: * -> *).
Data ftype =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Req ftype)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req ftype -> c (Req ftype)
$cgfoldl :: forall ftype (c :: * -> *).
Data ftype =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Req ftype -> c (Req ftype)
Data, Req ftype -> Req ftype -> Bool
forall ftype. Eq ftype => Req ftype -> Req ftype -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Req ftype -> Req ftype -> Bool
$c/= :: forall ftype. Eq ftype => Req ftype -> Req ftype -> Bool
== :: Req ftype -> Req ftype -> Bool
$c== :: forall ftype. Eq ftype => Req ftype -> Req ftype -> Bool
Eq, Int -> Req ftype -> ShowS
forall ftype. Show ftype => Int -> Req ftype -> ShowS
forall ftype. Show ftype => [Req ftype] -> ShowS
forall ftype. Show ftype => Req ftype -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Req ftype] -> ShowS
$cshowList :: forall ftype. Show ftype => [Req ftype] -> ShowS
show :: Req ftype -> String
$cshow :: forall ftype. Show ftype => Req ftype -> String
showsPrec :: Int -> Req ftype -> ShowS
$cshowsPrec :: forall ftype. Show ftype => Int -> Req ftype -> ShowS
Show, Typeable)

makeLenses ''Req

defReq :: Req ftype
defReq :: forall ftype. Req ftype
defReq = forall ftype.
Url ftype
-> Method
-> [HeaderArg ftype]
-> Maybe ftype
-> Maybe ftype
-> FunctionName
-> ReqBodyContentType
-> Req ftype
Req forall ftype. Url ftype
defUrl Method
"GET" [] forall a. Maybe a
Nothing 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 ftype _ = "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

-- | The language definition without any foreign types. It can be used for dynamic languages which do not /do/ type annotations.
data NoTypes

-- | Use if the foreign language does not have any types.
instance HasForeignType NoTypes NoContent a where
  typeFor :: Proxy NoTypes -> Proxy NoContent -> Proxy a -> NoContent
typeFor Proxy NoTypes
_ Proxy NoContent
_ Proxy a
_ = NoContent
NoContent

-- | Implementation of the Servant framework types.
--
-- Relevant instances: Everything containing 'HasForeignType'.
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 =
         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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) Req ftype
req
    forall a b. a -> b -> a :<|> 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 (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
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 =
    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 forall {k} (t :: k). Proxy t
Proxy (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall a b. (a -> b) -> a -> b
$
      Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Url ftype)
reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) (Path ftype)
path forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall ftype. SegmentType ftype -> Segment ftype
Segment (forall ftype. Arg ftype -> SegmentType ftype
Cap Arg ftype
arg)]
          forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) FunctionName
reqFuncName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' FunctionName [Text]
_FunctionName forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. [a] -> [a] -> [a]
++ [Text
"by", Text
str])
    where
      str :: Text
str   = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)
      ftype :: ftype
ftype = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy t)
      arg :: Arg ftype
arg   = 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 =
    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 forall {k} (t :: k). Proxy t
Proxy (forall {k} (t :: k). Proxy t
Proxy :: Proxy sublayout) forall a b. (a -> b) -> a -> b
$
      Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Url ftype)
reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) (Path ftype)
path forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall ftype. SegmentType ftype -> Segment ftype
Segment (forall ftype. Arg ftype -> SegmentType ftype
Cap Arg ftype
arg)]
          forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) FunctionName
reqFuncName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' FunctionName [Text]
_FunctionName forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. [a] -> [a] -> [a]
++ [Text
"by", Text
str])
    where
      str :: Text
str   = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)
      ftype :: ftype
ftype = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy [t])
      arg :: Arg ftype
arg   = 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 forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) FunctionName
reqFuncName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' FunctionName [Text]
_FunctionName forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
methodLC forall a. a -> [a] -> [a]
:)
        forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) Method
reqMethod forall s t a b. ASetter s t a b -> b -> s -> t
.~ Method
method
        forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Maybe ftype)
reqReturnType forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ftype
retType
    where
      retType :: ftype
retType  = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      method :: Method
method   = forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (forall {k} (t :: k). Proxy t
Proxy :: Proxy method)
      methodLC :: Text
methodLC = Text -> Text
toLower 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 forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) FunctionName
reqFuncName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' FunctionName [Text]
_FunctionName forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
methodLC forall a. a -> [a] -> [a]
:)
        forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) Method
reqMethod forall s t a b. ASetter s t a b -> b -> s -> t
.~ Method
method
        forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Maybe ftype)
reqReturnType forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ftype
retType
    where
      retType :: ftype
retType  = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy NoContent)
      method :: Method
method   = forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (forall {k} (t :: k). Proxy t
Proxy :: Proxy method)
      methodLC :: Text
methodLC = Text -> Text
toLower 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 forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) FunctionName
reqFuncName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' FunctionName [Text]
_FunctionName forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
methodLC forall a. a -> [a] -> [a]
:)
        forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) Method
reqMethod forall s t a b. ASetter s t a b -> b -> s -> t
.~ Method
method
        forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Maybe ftype)
reqReturnType forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ftype
retType
    where
      retType :: ftype
retType  = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
      method :: Method
method   = forall {k} (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (forall {k} (t :: k). Proxy t
Proxy :: Proxy method)
      methodLC :: Text
methodLC = Text -> Text
toLower 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 =
    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 forall {k} (t :: k). Proxy t
Proxy Proxy api
subP forall a b. (a -> b) -> a -> b
$ Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) [HeaderArg ftype]
reqHeaders forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall ftype. Arg ftype -> HeaderArg ftype
HeaderArg Arg ftype
arg]
    where
      hname :: Text
hname = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)
      arg :: Arg ftype
arg   = Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
hname
        , _argType :: ftype
_argType  = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy (RequiredArgument mods a)) }
      subP :: Proxy api
subP  = 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 =
    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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall a b. (a -> b) -> a -> b
$
      Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Url ftype)
reqUrlforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall ftype. Lens' (Url ftype) [QueryArg ftype]
queryStr forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall ftype. Arg ftype -> ArgType -> QueryArg ftype
QueryArg Arg ftype
arg ArgType
Normal]
    where
      str :: Text
str = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)
      arg :: Arg ftype
arg = Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
str
        , _argType :: ftype
_argType = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (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 =
    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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall a b. (a -> b) -> a -> b
$
      Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Url ftype)
reqUrlforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall ftype. Lens' (Url ftype) [QueryArg ftype]
queryStr forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall ftype. Arg ftype -> ArgType -> QueryArg ftype
QueryArg Arg ftype
arg ArgType
List]
    where
      str :: Text
str = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)
      arg :: Arg ftype
arg = Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
str
        , _argType :: ftype
_argType = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (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 =
    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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall a b. (a -> b) -> a -> b
$
      Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Url ftype)
reqUrlforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall ftype. Lens' (Url ftype) [QueryArg ftype]
queryStr forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall ftype. Arg ftype -> ArgType -> QueryArg ftype
QueryArg Arg ftype
arg ArgType
Flag]
    where
      str :: Text
str = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)
      arg :: Arg ftype
arg = Arg
        { _argName :: PathSegment
_argName = Text -> PathSegment
PathSegment Text
str
        , _argType :: ftype
_argType = 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 (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 =
    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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall a b. (a -> b) -> a -> b
$
      Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Url ftype)
reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) (Maybe ftype)
frag forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just ftype
argT
    where
      argT :: ftype
argT = forall {k} {k} (lang :: k) ftype (a :: k).
HasForeignType lang ftype a =>
Proxy lang -> Proxy ftype -> Proxy a -> ftype
typeFor Proxy lang
lang (forall {k} (t :: k). Proxy t
Proxy :: Proxy ftype) (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 forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) FunctionName
reqFuncName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' FunctionName [Text]
_FunctionName forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Text -> Text
toLower forall a b. (a -> b) -> a -> b
$ Method -> Text
decodeUtf8 Method
method) forall a. a -> [a] -> [a]
:)
        forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) Method
reqMethod 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 =
    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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall a b. (a -> b) -> a -> b
$
      Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Maybe ftype)
reqBody forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 (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 = 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 =
    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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) forall a b. (a -> b) -> a -> b
$
      Req ftype
req forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) (Url ftype)
reqUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ftype. Lens' (Url ftype) (Path ftype)
path forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [forall ftype. SegmentType ftype -> Segment ftype
Segment (forall ftype. PathSegment -> SegmentType ftype
Static (Text -> PathSegment
PathSegment Text
str))]
          forall a b. a -> (a -> b) -> b
& forall ftype. Lens' (Req ftype) FunctionName
reqFuncName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' FunctionName [Text]
_FunctionName forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. [a] -> [a] -> [a]
++ [Text
str])
    where
      str :: Text
str = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ (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 =
    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 (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 =
    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 (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 =
    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 (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 = 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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy api)

instance HasForeign lang ftype api =>
  HasForeign lang ftype (WithResource res :> api) where

  type Foreign ftype (WithResource res :> api) = Foreign ftype api

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (WithResource res :> api)
-> Req ftype
-> Foreign ftype (WithResource res :> api)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (WithResource res :> api)
Proxy = 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 (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 =
    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 (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 =
    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 (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 =
    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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy api) Req ftype
req

instance HasForeign lang ftype (ToServantApi r) => HasForeign lang ftype (NamedRoutes r) where
  type Foreign ftype (NamedRoutes r) = Foreign ftype (ToServantApi r)

  foreignFor :: Proxy lang
-> Proxy ftype
-> Proxy (NamedRoutes r)
-> Req ftype
-> Foreign ftype (NamedRoutes r)
foreignFor Proxy lang
lang Proxy ftype
ftype Proxy (NamedRoutes r)
Proxy Req ftype
req =
    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 (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ToServantApi r)) 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) = (forall ftype reqs. GenerateList ftype reqs => reqs -> [Req ftype]
generateList start
start) forall a. [a] -> [a] -> [a]
++ (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 :: forall {k} (lang :: k) ftype api.
(HasForeign lang ftype api,
 GenerateList ftype (Foreign ftype api)) =>
Proxy lang -> Proxy ftype -> Proxy api -> [Req ftype]
listFromAPI Proxy lang
lang Proxy ftype
ftype Proxy api
p = forall ftype reqs. GenerateList ftype reqs => reqs -> [Req ftype]
generateList (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 forall ftype. Req ftype
defReq)