servant-foreign-0.6.1: Helpers for generating clients for servant APIs in any programming language

Safe HaskellNone
LanguageHaskell2010

Servant.Foreign.Internal

Description

Generalizes all the data needed to make code generation work with arbitrary programming languages.

Synopsis

Documentation

data Arg f Source

Constructors

Arg 

Fields

_argName :: PathSegment
 
_argType :: f
 

Instances

Eq f => Eq (Arg f) Source 
Show f => Show (Arg f) Source 

argType :: forall f f. Lens (Arg f) (Arg f) f f Source

data SegmentType f Source

Constructors

Static PathSegment

a static path segment. like "/foo"

Cap (Arg f)

a capture. like "/:userid"

Instances

_Cap :: forall f f. Prism (SegmentType f) (SegmentType f) (Arg f) (Arg f) Source

newtype Segment f Source

Constructors

Segment 

Fields

unSegment :: SegmentType f
 

Instances

Eq f => Eq (Segment f) Source 
Show f => Show (Segment f) Source 

_Segment :: forall f f. Iso (Segment f) (Segment f) (SegmentType f) (SegmentType f) Source

type Path f = [Segment f] Source

data ArgType Source

Constructors

Normal 
Flag 
List 

data QueryArg f Source

Constructors

QueryArg 

Instances

Eq f => Eq (QueryArg f) Source 
Show f => Show (QueryArg f) Source 

queryArgName :: forall f f. Lens (QueryArg f) (QueryArg f) (Arg f) (Arg f) Source

data HeaderArg f Source

Constructors

HeaderArg 

Fields

_headerArg :: Arg f
 
ReplaceHeaderArg 

Instances

Eq f => Eq (HeaderArg f) Source 
Show f => Show (HeaderArg f) Source 

headerArg :: forall f f. Lens (HeaderArg f) (HeaderArg f) (Arg f) (Arg f) Source

_HeaderArg :: forall f. Prism' (HeaderArg f) (Arg f) Source

data Url f Source

Constructors

Url 

Fields

_path :: Path f
 
_queryStr :: [QueryArg f]
 

Instances

Eq f => Eq (Url f) Source 
Show f => Show (Url f) Source 

queryStr :: forall f. Lens' (Url f) [QueryArg f] Source

path :: forall f. Lens' (Url f) (Path f) Source

data Req f Source

Instances

GenerateList ftype (Req ftype) Source 
Eq f => Eq (Req f) Source 
Show f => Show (Req f) Source 

reqUrl :: forall f. Lens' (Req f) (Url f) Source

reqReturnType :: forall f. Lens' (Req f) (Maybe f) Source

reqMethod :: forall f. Lens' (Req f) Method Source

reqHeaders :: forall f. Lens' (Req f) [HeaderArg f] Source

reqBody :: forall f. Lens' (Req f) (Maybe f) Source

defReq :: Req ftype Source

class NotFound Source

To be used exclusively as a "negative" return type/constraint by Elem type family.

type family Elem a ls :: Constraint Source

Equations

Elem a `[]` = NotFound 
Elem a (a : list) = () 
Elem a (b : list) = Elem a list 

class HasForeignType lang ftype a where Source

HasForeignType maps Haskell types with types in the target language of your backend. For example, let's say you're implementing a backend to some language X, and you want a Text representation of each input/output type mentioned in the API:

-- First you need to create a dummy type to parametrize your
-- instances.
data LangX

-- Otherwise you define instances for the types you need
instance HasForeignType LangX Text Int where
   typeFor _ _ _ = "intX"

-- Or for example in case of lists
instance HasForeignType LangX Text a => HasForeignType LangX Text [a] where
   typeFor lang type _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)

Finally to generate list of information about all the endpoints for an API you create a function of a form:

getEndpoints :: (HasForeign LangX Text api, GenerateList Text (Foreign Text api))
             => Proxy api -> [Req Text]
getEndpoints api = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy Text) api
-- If language __X__ is dynamically typed then you can use
-- a predefined NoTypes parameter with the () output type:
getEndpoints :: (HasForeign NoTypes () api, GenerateList Text (Foreign () api))
             => Proxy api -> [Req ()]
getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) api

Methods

typeFor :: Proxy lang -> Proxy ftype -> Proxy a -> ftype Source

Instances

data NoTypes Source

Instances

class HasForeign lang ftype layout where Source

Associated Types

type Foreign ftype layout :: * Source

Methods

foreignFor :: Proxy lang -> Proxy ftype -> Proxy layout -> Req ftype -> Foreign ftype layout Source

Instances

HasForeign k lang ftype Raw Source 
(HasForeign k lang ftype a, HasForeign k lang ftype b) => HasForeign k lang ftype ((:<|>) a b) Source 
HasForeign k lang ftype sublayout => HasForeign k lang ftype (WithNamedContext name context sublayout) Source 
HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * HttpVersion sublayout) Source 
HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * Vault sublayout) Source 
HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * IsSecure sublayout) Source 
HasForeign k lang ftype sublayout => HasForeign k lang ftype ((:>) * * RemoteHost sublayout) Source 
(KnownSymbol path, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) Symbol * path sublayout) Source 
(Elem JSON list, HasForeignType k k1 lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (ReqBody k list a) sublayout) Source 
(KnownSymbol sym, HasForeignType k * lang ftype Bool, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryFlag sym) sublayout) Source 
(KnownSymbol sym, HasForeignType k * lang ftype [a], HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryParams * sym a) sublayout) Source 
(KnownSymbol sym, HasForeignType k k1 lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (QueryParam k sym a) sublayout) Source 
(KnownSymbol sym, HasForeignType k * lang ftype a, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (Header sym a) sublayout) Source 
(KnownSymbol sym, HasForeignType k k1 lang ftype t, HasForeign k lang ftype sublayout) => HasForeign k lang ftype ((:>) * * (Capture k sym t) sublayout) Source 
(Elem JSON list, HasForeignType k k2 lang ftype a, ReflectMethod k1 method) => HasForeign k lang ftype (Verb k k method status list a) Source 

class GenerateList ftype reqs where Source

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.

Methods

generateList :: reqs -> [Req ftype] Source

Instances

GenerateList ftype (Req ftype) Source 
(GenerateList ftype start, GenerateList ftype rest) => GenerateList ftype ((:<|>) start rest) Source 

listFromAPI :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api)) => Proxy lang -> Proxy ftype -> Proxy api -> [Req ftype] Source

Generate the necessary data for codegen as a list, each Req describing one endpoint from your API type.