Merge pull request #1390 from Profpatsch/document-servant-foreign

Document servant-foreign
This commit is contained in:
Caroline GAUDREAU 2021-03-25 12:21:20 +01:00 committed by GitHub
commit d06b65c4e6
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
3 changed files with 162 additions and 65 deletions

View file

@ -1,20 +1,32 @@
-- | Generalizes all the data needed to make code generation work with -- | Generalizes all the data needed to make code generation work with
-- arbitrary programming languages. -- arbitrary programming languages.
--
-- See documentation of 'HasForeignType' for a simple example. 'listFromAPI' returns a list of all your endpoints and their foreign types, given a mapping from Haskell types to foreign types (conventionally called `ftypes` below).
module Servant.Foreign module Servant.Foreign
( ArgType(..) (
, HeaderArg(..) -- * Main API
, QueryArg(..) listFromAPI
, Req(..) , Req(..)
, ReqBodyContentType(..) , defReq
, HasForeignType(..)
, GenerateList(..)
, HasForeign(..)
, NoTypes
-- * Subtypes of 'Req'
, Url(..)
, Path
, Segment(..) , Segment(..)
, SegmentType(..) , SegmentType(..)
, Url(..) , isCapture
-- aliases , captureArg
, Path , QueryArg(..)
, ArgType(..)
, HeaderArg(..)
, Arg(..) , Arg(..)
, FunctionName(..) , FunctionName(..)
, ReqBodyContentType(..)
, PathSegment(..) , PathSegment(..)
-- lenses -- * Lenses
, argName , argName
, argType , argType
, argPath , argPath
@ -30,7 +42,7 @@ module Servant.Foreign
, queryArgName , queryArgName
, queryArgType , queryArgType
, headerArg , headerArg
-- prisms -- * Prisms
, _PathSegment , _PathSegment
, _HeaderArg , _HeaderArg
, _ReplaceHeaderArg , _ReplaceHeaderArg
@ -39,16 +51,7 @@ module Servant.Foreign
, _Normal , _Normal
, _Flag , _Flag
, _List , _List
-- rest of it -- * Re-exports
, HasForeign(..)
, HasForeignType(..)
, GenerateList(..)
, NoTypes
, captureArg
, isCapture
, defReq
, listFromAPI
-- re-exports
, module Servant.API , module Servant.API
, module Servant.Foreign.Inflections , module Servant.Foreign.Inflections
) where ) where

View file

@ -20,20 +20,31 @@ import Prelude hiding
(head, tail) (head, tail)
import Servant.Foreign.Internal import Servant.Foreign.Internal
-- | Simply concat each part of the FunctionName together.
--
-- @[ "get", "documents", "by", "id" ] → "getdocumentsbyid"@
concatCase :: FunctionName -> Text
concatCase = view concatCaseL
concatCaseL :: Getter FunctionName Text concatCaseL :: Getter FunctionName Text
concatCaseL = _FunctionName . to mconcat concatCaseL = _FunctionName . to mconcat
-- | Function name builder that simply concat each part together -- | Use the snake_case convention.
concatCase :: FunctionName -> Text -- Each part is separated by a single underscore character.
concatCase = view concatCaseL --
-- @[ "get", "documents", "by", "id" ] → "get_documents_by_id"@
snakeCase :: FunctionName -> Text
snakeCase = view snakeCaseL
snakeCaseL :: Getter FunctionName Text snakeCaseL :: Getter FunctionName Text
snakeCaseL = _FunctionName . to (intercalate "_") snakeCaseL = _FunctionName . to (intercalate "_")
-- | Function name builder using the snake_case convention. -- | Use the camelCase convention.
-- each part is separated by a single underscore character. -- The first part is lower case, every other part starts with an upper case character.
snakeCase :: FunctionName -> Text --
snakeCase = view snakeCaseL -- @[ "get", "documents", "by", "id" ] → "getDocumentsById"@
camelCase :: FunctionName -> Text
camelCase = view camelCaseL
camelCaseL :: Getter FunctionName Text camelCaseL :: Getter FunctionName Text
camelCaseL = _FunctionName . to convert camelCaseL = _FunctionName . to convert
@ -42,8 +53,3 @@ camelCaseL = _FunctionName . to convert
convert (p:ps) = mconcat $ p : map capitalize ps convert (p:ps) = mconcat $ p : map capitalize ps
capitalize "" = "" capitalize "" = ""
capitalize name = C.toUpper (head name) `cons` tail name capitalize name = C.toUpper (head name) `cons` tail name
-- | Function name builder using the CamelCase convention.
-- each part begins with an upper case character.
camelCase :: FunctionName -> Text
camelCase = view camelCaseL

View file

@ -13,8 +13,6 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
-- | Generalizes all the data needed to make code generation work with
-- arbitrary programming languages.
module Servant.Foreign.Internal where module Servant.Foreign.Internal where
import Prelude () import Prelude ()
@ -40,55 +38,75 @@ import Servant.API.Modifiers
(RequiredArgument) (RequiredArgument)
import Servant.API.TypeLevel 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 { unFunctionName :: [Text] } newtype FunctionName = FunctionName { unFunctionName :: [Text] }
deriving (Data, Show, Eq, Semigroup, Monoid, Typeable) deriving (Data, Show, Eq, Semigroup, Monoid, Typeable)
makePrisms ''FunctionName makePrisms ''FunctionName
-- | See documentation of 'Arg'
newtype PathSegment = PathSegment { unPathSegment :: Text } newtype PathSegment = PathSegment { unPathSegment :: Text }
deriving (Data, Show, Eq, IsString, Semigroup, Monoid, Typeable) deriving (Data, Show, Eq, IsString, Semigroup, Monoid, Typeable)
makePrisms ''PathSegment makePrisms ''PathSegment
data Arg f = Arg -- | 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
{ _argName :: PathSegment { _argName :: PathSegment
, _argType :: f } -- ^ The name to be captured.
--
-- Only for capture args it really denotes a path segment.
, _argType :: ftype
-- ^ Foreign type the associated value will have
}
deriving (Data, Eq, Show, Typeable) deriving (Data, Eq, Show, Typeable)
makeLenses ''Arg makeLenses ''Arg
argPath :: Getter (Arg f) Text argPath :: Getter (Arg ftype) Text
argPath = argName . _PathSegment argPath = argName . _PathSegment
data SegmentType f data SegmentType ftype
= Static PathSegment = Static PathSegment
-- ^ a static path segment. like "/foo" -- ^ Static path segment.
| Cap (Arg f) --
-- ^ a capture. like "/:userid" -- @"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 (Data, Eq, Show, Typeable) deriving (Data, Eq, Show, Typeable)
makePrisms ''SegmentType makePrisms ''SegmentType
newtype Segment f = Segment { unSegment :: SegmentType f } -- | A part of the Urls path.
newtype Segment ftype = Segment { unSegment :: SegmentType ftype }
deriving (Data, Eq, Show, Typeable) deriving (Data, Eq, Show, Typeable)
makePrisms ''Segment makePrisms ''Segment
isCapture :: Segment f -> Bool -- | Whether a segment is a 'Cap'.
isCapture :: Segment ftype -> Bool
isCapture (Segment (Cap _)) = True isCapture (Segment (Cap _)) = True
isCapture _ = False isCapture _ = False
captureArg :: Segment f -> Arg f -- | Crashing Arg extraction from segment, TODO: remove
captureArg :: Segment ftype -> Arg ftype
captureArg (Segment (Cap s)) = s captureArg (Segment (Cap s)) = s
captureArg _ = error "captureArg called on non capture" captureArg _ = error "captureArg called on non capture"
type Path f = [Segment f] -- TODO: remove, unnecessary indirection
type Path ftype = [Segment ftype]
newtype Frag f = Frag { unFragment :: Arg f }
deriving (Data, Eq, Show, Typeable)
makePrisms ''Frag
-- | Type of a 'QueryArg'.
data ArgType data ArgType
= Normal = Normal
| Flag | Flag
@ -97,18 +115,41 @@ data ArgType
makePrisms ''ArgType makePrisms ''ArgType
data QueryArg f = QueryArg -- | Url Query argument.
{ _queryArgName :: Arg f --
-- 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 its 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
{ _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
, _queryArgType :: ArgType , _queryArgType :: ArgType
-- ^ one of normal/plain, list or flag
} }
deriving (Data, Eq, Show, Typeable) deriving (Data, Eq, Show, Typeable)
makeLenses ''QueryArg makeLenses ''QueryArg
data HeaderArg f = HeaderArg data HeaderArg ftype =
{ _headerArg :: Arg f } -- | The name of the header and the foreign type of its value.
HeaderArg
{ _headerArg :: Arg ftype }
-- | Unused, will never be set.
--
-- TODO: remove
| ReplaceHeaderArg | ReplaceHeaderArg
{ _headerArg :: Arg f { _headerArg :: Arg ftype
, _headerPattern :: Text , _headerPattern :: Text
} }
deriving (Data, Eq, Show, Typeable) deriving (Data, Eq, Show, Typeable)
@ -117,29 +158,71 @@ makeLenses ''HeaderArg
makePrisms ''HeaderArg makePrisms ''HeaderArg
data Url f = Url -- | Full endpoint url, with all captures and parameters
{ _path :: Path f data Url ftype = Url
, _queryStr :: [QueryArg f] { _path :: Path ftype
, _frag :: Maybe f -- ^ Url path, list of either static segments or captures
--
-- @"foo\/{id}\/bar"@
, _queryStr :: [QueryArg ftype]
-- ^ List of query args
--
-- @"?foo=bar&a=b"@
, _frag :: Maybe ftype
-- ^ Url fragment.
--
-- Not sent to the HTTP server, so only useful for frontend matters (e.g. inter-page linking).
--
-- @#fragmentText@
} }
deriving (Data, Eq, Show, Typeable) deriving (Data, Eq, Show, Typeable)
defUrl :: Url f defUrl :: Url ftype
defUrl = Url [] [] Nothing defUrl = Url [] [] Nothing
makeLenses ''Url makeLenses ''Url
-- | See documentation of '_reqBodyContentType'
data ReqBodyContentType = ReqBodyJSON | ReqBodyMultipart data ReqBodyContentType = ReqBodyJSON | ReqBodyMultipart
deriving (Data, Eq, Show, Read) deriving (Data, Eq, Show, Read)
data Req f = Req -- | Full description of an endpoint in your API, generated by 'listFromAPI'. It should give you all the information needed to generate foreign language bindings.
{ _reqUrl :: Url f --
-- 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
{ _reqUrl :: Url ftype
-- ^ Full list of URL segments, including captures
, _reqMethod :: HTTP.Method , _reqMethod :: HTTP.Method
, _reqHeaders :: [HeaderArg f] -- ^ @\"GET\"@\/@\"POST\"@\/@\"PUT\"@\/…
, _reqBody :: Maybe f , _reqHeaders :: [HeaderArg ftype]
, _reqReturnType :: Maybe f -- ^ Headers required by this endpoint, with their type
, _reqBody :: Maybe ftype
-- ^ Foreign type of the expected request body ('ReqBody'), if any
, _reqReturnType :: Maybe ftype
-- ^ The foreign type of the response, if any
, _reqFuncName :: FunctionName , _reqFuncName :: FunctionName
-- ^ The URL segments rendered in a way that they can be easily concatenated into a canonical function name
, _reqBodyContentType :: 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 (Data, Eq, Show, Typeable) deriving (Data, Eq, Show, Typeable)
@ -183,11 +266,16 @@ defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName []) ReqBodyJSON
class HasForeignType lang ftype a where class HasForeignType lang ftype a where
typeFor :: Proxy lang -> Proxy ftype -> Proxy a -> ftype 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 data NoTypes
instance HasForeignType NoTypes NoContent ftype where -- | Use if the foreign language does not have any types.
instance HasForeignType NoTypes NoContent a where
typeFor _ _ _ = NoContent typeFor _ _ _ = NoContent
-- | Implementation of the Servant framework types.
--
-- Relevant instances: Everything containing 'HasForeignType'.
class HasForeign lang ftype (api :: *) where class HasForeign lang ftype (api :: *) where
type Foreign ftype api :: * type Foreign ftype api :: *
foreignFor :: Proxy lang -> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api foreignFor :: Proxy lang -> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api