eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Rename type variables 'layout' and 'sublayout' to 'api'

Browse source
This commit is contained in:
Sönke Hahn 2016-06-02 15:49:55 +08:00
parent 023368c396
commit 5effdfdbbb
8 changed files with 205 additions and 205 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

84
servant-client/src/Servant/Client.hs
View file

@ -57,15 +57,15 @@ import Servant.Common.Req
-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book] -- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
-- > (getAllBooks :<|> postNewBook) = client myApi -- > (getAllBooks :<|> postNewBook) = client myApi
client :: HasClient layout => Proxy layout -> Client layout client :: HasClient api => Proxy api -> Client api
client p = clientWithRoute p defReq client p = clientWithRoute p defReq
-- | This class lets us define how each API combinator -- | This class lets us define how each API combinator
-- influences the creation of an HTTP request. It's mostly -- influences the creation of an HTTP request. It's mostly
-- an internal class, you can just use 'client'. -- an internal class, you can just use 'client'.
class HasClient layout where class HasClient api where
type Client layout :: * type Client api :: *
clientWithRoute :: Proxy layout -> Req -> Client layout clientWithRoute :: Proxy api -> Req -> Client api
-- | A client querying function for @a ':<|>' b@ will actually hand you -- | A client querying function for @a ':<|>' b@ will actually hand you
@ -106,14 +106,14 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book -- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book
-- > getBook = client myApi -- > getBook = client myApi
-- > -- then you can just use "getBook" to query that endpoint -- > -- then you can just use "getBook" to query that endpoint
instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) instance (KnownSymbol capture, ToHttpApiData a, HasClient api)
=> HasClient (Capture capture a :> sublayout) where => HasClient (Capture capture a :> api) where
type Client (Capture capture a :> sublayout) = type Client (Capture capture a :> api) =
a -> Client sublayout a -> Client api
clientWithRoute Proxy req val = clientWithRoute Proxy req val =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy api)
(appendToPath p req) (appendToPath p req)
where p = unpack (toUrlPiece val) where p = unpack (toUrlPiece val)
@ -186,14 +186,14 @@ instance OVERLAPPING_
-- > viewReferer = client myApi -- > viewReferer = client myApi
-- > -- then you can just use "viewRefer" to query that endpoint -- > -- then you can just use "viewRefer" to query that endpoint
-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
=> HasClient (Header sym a :> sublayout) where => HasClient (Header sym a :> api) where
type Client (Header sym a :> sublayout) = type Client (Header sym a :> api) =
Maybe a -> Client sublayout Maybe a -> Client api
clientWithRoute Proxy req mval = clientWithRoute Proxy req mval =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy api)
(maybe req (maybe req
(\value -> Servant.Common.Req.addHeader hname value req) (\value -> Servant.Common.Req.addHeader hname value req)
mval mval
@ -203,14 +203,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
-- | Using a 'HttpVersion' combinator in your API doesn't affect the client -- | Using a 'HttpVersion' combinator in your API doesn't affect the client
-- functions. -- functions.
instance HasClient sublayout instance HasClient api
=> HasClient (HttpVersion :> sublayout) where => HasClient (HttpVersion :> api) where
type Client (HttpVersion :> sublayout) = type Client (HttpVersion :> api) =
Client sublayout Client api
clientWithRoute Proxy = clientWithRoute Proxy =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy api)
-- | If you use a 'QueryParam' in one of your endpoints in your API, -- | If you use a 'QueryParam' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -237,15 +237,15 @@ instance HasClient sublayout
-- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy Nothing' for all books
-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
=> HasClient (QueryParam sym a :> sublayout) where => HasClient (QueryParam sym a :> api) where
type Client (QueryParam sym a :> sublayout) = type Client (QueryParam sym a :> api) =
Maybe a -> Client sublayout Maybe a -> Client api
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string
clientWithRoute Proxy req mparam = clientWithRoute Proxy req mparam =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy api)
(maybe req (maybe req
(flip (appendToQueryString pname) req . Just) (flip (appendToQueryString pname) req . Just)
mparamText mparamText
@ -282,14 +282,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
-- > -- 'getBooksBy []' for all books -- > -- 'getBooksBy []' for all books
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
-- > -- to get all books by Asimov and Heinlein -- > -- to get all books by Asimov and Heinlein
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
=> HasClient (QueryParams sym a :> sublayout) where => HasClient (QueryParams sym a :> api) where
type Client (QueryParams sym a :> sublayout) = type Client (QueryParams sym a :> api) =
[a] -> Client sublayout [a] -> Client api
clientWithRoute Proxy req paramlist = clientWithRoute Proxy req paramlist =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy api)
(foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just)) (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
req req
paramlist' paramlist'
@ -320,14 +320,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
-- > -- then you can just use "getBooks" to query that endpoint. -- > -- then you can just use "getBooks" to query that endpoint.
-- > -- 'getBooksBy False' for all books -- > -- 'getBooksBy False' for all books
-- > -- 'getBooksBy True' to only get _already published_ books -- > -- 'getBooksBy True' to only get _already published_ books
instance (KnownSymbol sym, HasClient sublayout) instance (KnownSymbol sym, HasClient api)
=> HasClient (QueryFlag sym :> sublayout) where => HasClient (QueryFlag sym :> api) where
type Client (QueryFlag sym :> sublayout) = type Client (QueryFlag sym :> api) =
Bool -> Client sublayout Bool -> Client api
clientWithRoute Proxy req flag = clientWithRoute Proxy req flag =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy api)
(if flag (if flag
then appendToQueryString paramname Nothing req then appendToQueryString paramname Nothing req
else req else req
@ -364,14 +364,14 @@ instance HasClient Raw where
-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book
-- > addBook = client myApi -- > addBook = client myApi
-- > -- then you can just use "addBook" to query that endpoint -- > -- then you can just use "addBook" to query that endpoint
instance (MimeRender ct a, HasClient sublayout) instance (MimeRender ct a, HasClient api)
=> HasClient (ReqBody (ct ': cts) a :> sublayout) where => HasClient (ReqBody (ct ': cts) a :> api) where
type Client (ReqBody (ct ': cts) a :> sublayout) = type Client (ReqBody (ct ': cts) a :> api) =
a -> Client sublayout a -> Client api
clientWithRoute Proxy req body = clientWithRoute Proxy req body =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy api)
(let ctProxy = Proxy :: Proxy ct (let ctProxy = Proxy :: Proxy ct
in setRQBody (mimeRender ctProxy body) in setRQBody (mimeRender ctProxy body)
(contentType ctProxy) (contentType ctProxy)
@ -379,11 +379,11 @@ instance (MimeRender ct a, HasClient sublayout)
) )
-- | Make the querying function append @path@ to the request path. -- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where instance (KnownSymbol path, HasClient api) => HasClient (path :> api) where
type Client (path :> sublayout) = Client sublayout type Client (path :> api) = Client api
clientWithRoute Proxy req = clientWithRoute Proxy req =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy api)
(appendToPath p req) (appendToPath p req)
where p = symbolVal (Proxy :: Proxy path) where p = symbolVal (Proxy :: Proxy path)

106
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -163,7 +163,7 @@ data DocNote = DocNote
-- --
-- These are intended to be built using extraInfo. -- These are intended to be built using extraInfo.
-- Multiple ExtraInfo may be combined with the monoid instance. -- Multiple ExtraInfo may be combined with the monoid instance.
newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action) newtype ExtraInfo api = ExtraInfo (HashMap Endpoint Action)
instance Monoid (ExtraInfo a) where instance Monoid (ExtraInfo a) where
mempty = ExtraInfo mempty mempty = ExtraInfo mempty
ExtraInfo a `mappend` ExtraInfo b = ExtraInfo a `mappend` ExtraInfo b =
@ -300,11 +300,11 @@ makeLenses ''Action
-- default way to create documentation. -- default way to create documentation.
-- --
-- prop> docs == docsWithOptions defaultDocOptions -- prop> docs == docsWithOptions defaultDocOptions
docs :: HasDocs layout => Proxy layout -> API docs :: HasDocs api => Proxy api -> API
docs p = docsWithOptions p defaultDocOptions docs p = docsWithOptions p defaultDocOptions
-- | Generate the docs for a given API that implements 'HasDocs'. -- | Generate the docs for a given API that implements 'HasDocs'.
docsWithOptions :: HasDocs layout => Proxy layout -> DocOptions -> API docsWithOptions :: HasDocs api => Proxy api -> DocOptions -> API
docsWithOptions p = docsFor p (defEndpoint, defAction) docsWithOptions p = docsFor p (defEndpoint, defAction)
-- | Closed type family, check if endpoint is exactly within API. -- | Closed type family, check if endpoint is exactly within API.
@ -316,7 +316,7 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where
IsIn (e :> sa) (e :> sb) = IsIn sa sb IsIn (e :> sa) (e :> sb) = IsIn sa sb
IsIn e e = () IsIn e e = ()
-- | Create an 'ExtraInfo' that is garunteed to be within the given API layout. -- | Create an 'ExtraInfo' that is guaranteed to be within the given API layout.
-- --
-- The safety here is to ensure that you only add custom documentation to an -- The safety here is to ensure that you only add custom documentation to an
-- endpoint that actually exists within your API. -- endpoint that actually exists within your API.
@ -329,8 +329,8 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where
-- > , DocNote "Second secton" ["And some more"] -- > , DocNote "Second secton" ["And some more"]
-- > ] -- > ]
extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint) extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
=> Proxy endpoint -> Action -> ExtraInfo layout => Proxy endpoint -> Action -> ExtraInfo api
extraInfo p action = extraInfo p action =
let api = docsFor p (defEndpoint, defAction) defaultDocOptions let api = docsFor p (defEndpoint, defAction) defaultDocOptions
-- Assume one endpoint, HasLink constraint means that we should only ever -- Assume one endpoint, HasLink constraint means that we should only ever
@ -349,7 +349,7 @@ extraInfo p action =
-- 'extraInfo'. -- 'extraInfo'.
-- --
-- If you only want to add an introduction, use 'docsWithIntros'. -- If you only want to add an introduction, use 'docsWithIntros'.
docsWith :: HasDocs layout => DocOptions -> [DocIntro] -> ExtraInfo layout -> Proxy layout -> API docsWith :: HasDocs api => DocOptions -> [DocIntro] -> ExtraInfo api -> Proxy api -> API
docsWith opts intros (ExtraInfo endpoints) p = docsWith opts intros (ExtraInfo endpoints) p =
docsWithOptions p opts docsWithOptions p opts
& apiIntros <>~ intros & apiIntros <>~ intros
@ -358,13 +358,13 @@ docsWith opts intros (ExtraInfo endpoints) p =
-- | Generate the docs for a given API that implements 'HasDocs' with with any -- | Generate the docs for a given API that implements 'HasDocs' with with any
-- number of introduction(s) -- number of introduction(s)
docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
docsWithIntros intros = docsWith defaultDocOptions intros mempty docsWithIntros intros = docsWith defaultDocOptions intros mempty
-- | The class that abstracts away the impact of API combinators -- | The class that abstracts away the impact of API combinators
-- on documentation generation. -- on documentation generation.
class HasDocs layout where class HasDocs api where
docsFor :: Proxy layout -> (Endpoint, Action) -> DocOptions -> API docsFor :: Proxy api -> (Endpoint, Action) -> DocOptions -> API
-- | The class that lets us display a sample input or output in the supported -- | The class that lets us display a sample input or output in the supported
-- content-types when generating documentation for endpoints that either: -- content-types when generating documentation for endpoints that either:
@ -675,26 +675,26 @@ markdown api = unlines $
-- | The generated docs for @a ':<|>' b@ just appends the docs -- | The generated docs for @a ':<|>' b@ just appends the docs
-- for @a@ with the docs for @b@. -- for @a@ with the docs for @b@.
instance OVERLAPPABLE_ instance OVERLAPPABLE_
(HasDocs layout1, HasDocs layout2) (HasDocs a, HasDocs b)
=> HasDocs (layout1 :<|> layout2) where => HasDocs (a :<|> b) where
docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action) docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)
where p1 :: Proxy layout1 where p1 :: Proxy a
p1 = Proxy p1 = Proxy
p2 :: Proxy layout2 p2 :: Proxy b
p2 = Proxy p2 = Proxy
-- | @"books" :> 'Capture' "isbn" Text@ will appear as -- | @"books" :> 'Capture' "isbn" Text@ will appear as
-- @/books/:isbn@ in the docs. -- @/books/:isbn@ in the docs.
instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout) instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
=> HasDocs (Capture sym a :> sublayout) where => HasDocs (Capture sym a :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint', action') docsFor subApiP (endpoint', action')
where sublayoutP = Proxy :: Proxy sublayout where subApiP = Proxy :: Proxy api
captureP = Proxy :: Proxy (Capture sym a) captureP = Proxy :: Proxy (Capture sym a)
action' = over captures (|> toCapture captureP) action action' = over captures (|> toCapture captureP) action
@ -736,43 +736,43 @@ instance OVERLAPPING_
status = fromInteger $ natVal (Proxy :: Proxy status) status = fromInteger $ natVal (Proxy :: Proxy status)
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance (KnownSymbol sym, HasDocs sublayout) instance (KnownSymbol sym, HasDocs api)
=> HasDocs (Header sym a :> sublayout) where => HasDocs (Header sym a :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action') docsFor subApiP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout where subApiP = Proxy :: Proxy api
action' = over headers (|> headername) action action' = over headers (|> headername) action
headername = T.pack $ symbolVal (Proxy :: Proxy sym) headername = T.pack $ symbolVal (Proxy :: Proxy sym)
instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout) instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs api)
=> HasDocs (QueryParam sym a :> sublayout) where => HasDocs (QueryParam sym a :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action') docsFor subApiP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout where subApiP = Proxy :: Proxy api
paramP = Proxy :: Proxy (QueryParam sym a) paramP = Proxy :: Proxy (QueryParam sym a)
action' = over params (|> toParam paramP) action action' = over params (|> toParam paramP) action
instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout) instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs api)
=> HasDocs (QueryParams sym a :> sublayout) where => HasDocs (QueryParams sym a :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action') docsFor subApiP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout where subApiP = Proxy :: Proxy api
paramP = Proxy :: Proxy (QueryParams sym a) paramP = Proxy :: Proxy (QueryParams sym a)
action' = over params (|> toParam paramP) action action' = over params (|> toParam paramP) action
instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout) instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
=> HasDocs (QueryFlag sym :> sublayout) where => HasDocs (QueryFlag sym :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action') docsFor subApiP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout where subApiP = Proxy :: Proxy api
paramP = Proxy :: Proxy (QueryFlag sym) paramP = Proxy :: Proxy (QueryFlag sym)
action' = over params (|> toParam paramP) action action' = over params (|> toParam paramP) action
@ -785,49 +785,49 @@ instance HasDocs Raw where
-- example data. However, there's no reason to believe that the instances of -- example data. However, there's no reason to believe that the instances of
-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that -- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
-- both are even defined) for any particular type. -- both are even defined) for any particular type.
instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs sublayout) instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
=> HasDocs (ReqBody (ct ': cts) a :> sublayout) where => HasDocs (ReqBody (ct ': cts) a :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action') docsFor subApiP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout where subApiP = Proxy :: Proxy api
action' = action & rqbody .~ sampleByteString t p action' = action & rqbody .~ sampleByteString t p
& rqtypes .~ allMime t & rqtypes .~ allMime t
t = Proxy :: Proxy (ct ': cts) t = Proxy :: Proxy (ct ': cts)
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint', action) docsFor subApiP (endpoint', action)
where sublayoutP = Proxy :: Proxy sublayout where subApiP = Proxy :: Proxy api
endpoint' = endpoint & path <>~ [symbolVal pa] endpoint' = endpoint & path <>~ [symbolVal pa]
pa = Proxy :: Proxy path pa = Proxy :: Proxy path
instance HasDocs sublayout => HasDocs (RemoteHost :> sublayout) where instance HasDocs api => HasDocs (RemoteHost :> api) where
docsFor Proxy ep = docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) ep docsFor (Proxy :: Proxy api) ep
instance HasDocs sublayout => HasDocs (IsSecure :> sublayout) where instance HasDocs api => HasDocs (IsSecure :> api) where
docsFor Proxy ep = docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) ep docsFor (Proxy :: Proxy api) ep
instance HasDocs sublayout => HasDocs (HttpVersion :> sublayout) where instance HasDocs api => HasDocs (HttpVersion :> api) where
docsFor Proxy ep = docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) ep docsFor (Proxy :: Proxy api) ep
instance HasDocs sublayout => HasDocs (Vault :> sublayout) where instance HasDocs api => HasDocs (Vault :> api) where
docsFor Proxy ep = docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) ep docsFor (Proxy :: Proxy api) ep
instance HasDocs sublayout => HasDocs (WithNamedContext name context sublayout) where instance HasDocs api => HasDocs (WithNamedContext name context api) where
docsFor Proxy = docsFor (Proxy :: Proxy sublayout) docsFor Proxy = docsFor (Proxy :: Proxy api)
instance (ToAuthInfo (BasicAuth realm usr), HasDocs sublayout) => HasDocs (BasicAuth realm usr :> sublayout) where instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor (Proxy :: Proxy sublayout) (endpoint, action') docsFor (Proxy :: Proxy api) (endpoint, action')
where where
authProxy = Proxy :: Proxy (BasicAuth realm usr) authProxy = Proxy :: Proxy (BasicAuth realm usr)
action' = over authInfo (|> toAuthInfo authProxy) action action' = over authInfo (|> toAuthInfo authProxy) action

4
servant-docs/src/Servant/Docs/Internal/Pretty.hs
View file

@ -29,12 +29,12 @@ instance ToJSON a => MimeRender PrettyJSON a where
-- @ -- @
-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI)) -- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI))
-- @ -- @
pretty :: Proxy layout -> Proxy (Pretty layout) pretty :: Proxy api -> Proxy (Pretty api)
pretty Proxy = Proxy pretty Proxy = Proxy
-- | Replace all JSON content types with PrettyJSON. -- | Replace all JSON content types with PrettyJSON.
-- Kind-polymorphic so it can operate on kinds @*@ and @[*]@. -- Kind-polymorphic so it can operate on kinds @*@ and @[*]@.
type family Pretty (layout :: k) :: k where type family Pretty (api :: k) :: k where
Pretty (x :<|> y) = Pretty x :<|> Pretty y Pretty (x :<|> y) = Pretty x :<|> Pretty y
Pretty (x :> y) = Pretty x :> Pretty y Pretty (x :> y) = Pretty x :> Pretty y
Pretty (Get cs r) = Get (Pretty cs) r Pretty (Get cs r) = Get (Pretty cs) r

100
servant-foreign/src/Servant/Foreign/Internal.hs
View file

@ -184,9 +184,9 @@ data NoTypes
instance HasForeignType NoTypes () ftype where instance HasForeignType NoTypes () ftype where
typeFor _ _ _ = () typeFor _ _ _ = ()
class HasForeign lang ftype (layout :: *) where class HasForeign lang ftype (api :: *) where
type Foreign ftype layout :: * type Foreign ftype api :: *
foreignFor :: Proxy lang -> Proxy ftype -> Proxy layout -> Req ftype -> Foreign ftype layout foreignFor :: Proxy lang -> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
instance (HasForeign lang ftype a, HasForeign lang ftype b) instance (HasForeign lang ftype a, HasForeign lang ftype b)
=> HasForeign lang ftype (a :<|> b) where => HasForeign lang ftype (a :<|> b) where
@ -196,12 +196,12 @@ instance (HasForeign lang ftype a, HasForeign lang ftype b)
foreignFor lang ftype (Proxy :: Proxy a) req foreignFor lang ftype (Proxy :: Proxy a) req
:<|> foreignFor lang ftype (Proxy :: Proxy b) req :<|> foreignFor lang ftype (Proxy :: Proxy b) req
instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout) instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)
=> HasForeign lang ftype (Capture sym t :> sublayout) where => HasForeign lang ftype (Capture sym t :> api) where
type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout type Foreign ftype (Capture sym a :> api) = Foreign ftype api
foreignFor lang Proxy Proxy req = foreignFor lang Proxy Proxy req =
foreignFor lang Proxy (Proxy :: Proxy sublayout) $ foreignFor lang Proxy (Proxy :: Proxy api) $
req & reqUrl . path <>~ [Segment (Cap arg)] req & reqUrl . path <>~ [Segment (Cap arg)]
& reqFuncName . _FunctionName %~ (++ ["by", str]) & reqFuncName . _FunctionName %~ (++ ["by", str])
where where
@ -224,9 +224,9 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
method = reflectMethod (Proxy :: Proxy method) method = reflectMethod (Proxy :: Proxy method)
methodLC = toLower $ decodeUtf8 method methodLC = toLower $ decodeUtf8 method
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout) instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api)
=> HasForeign lang ftype (Header sym a :> sublayout) where => HasForeign lang ftype (Header sym a :> api) where
type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout type Foreign ftype (Header sym a :> api) = Foreign ftype api
foreignFor lang Proxy Proxy req = foreignFor lang Proxy Proxy req =
foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg] foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
@ -235,14 +235,14 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype su
arg = Arg arg = Arg
{ _argName = PathSegment hname { _argName = PathSegment hname
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) } , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
subP = Proxy :: Proxy sublayout subP = Proxy :: Proxy api
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout) instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api)
=> HasForeign lang ftype (QueryParam sym a :> sublayout) where => HasForeign lang ftype (QueryParam sym a :> api) where
type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout type Foreign ftype (QueryParam sym a :> api) = Foreign ftype api
foreignFor lang Proxy Proxy req = foreignFor lang Proxy Proxy req =
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $ foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $
req & reqUrl.queryStr <>~ [QueryArg arg Normal] req & reqUrl.queryStr <>~ [QueryArg arg Normal]
where where
str = pack . symbolVal $ (Proxy :: Proxy sym) str = pack . symbolVal $ (Proxy :: Proxy sym)
@ -251,11 +251,11 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype su
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) } , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
instance instance
(KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout) (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype api)
=> HasForeign lang ftype (QueryParams sym a :> sublayout) where => HasForeign lang ftype (QueryParams sym a :> api) where
type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout type Foreign ftype (QueryParams sym a :> api) = Foreign ftype api
foreignFor lang Proxy Proxy req = foreignFor lang Proxy Proxy req =
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $ foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $
req & reqUrl.queryStr <>~ [QueryArg arg List] req & reqUrl.queryStr <>~ [QueryArg arg List]
where where
str = pack . symbolVal $ (Proxy :: Proxy sym) str = pack . symbolVal $ (Proxy :: Proxy sym)
@ -264,12 +264,12 @@ instance
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) } , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) }
instance instance
(KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout) (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype api)
=> HasForeign lang ftype (QueryFlag sym :> sublayout) where => HasForeign lang ftype (QueryFlag sym :> api) where
type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout type Foreign ftype (QueryFlag sym :> api) = Foreign ftype api
foreignFor lang ftype Proxy req = foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) $ foreignFor lang ftype (Proxy :: Proxy api) $
req & reqUrl.queryStr <>~ [QueryArg arg Flag] req & reqUrl.queryStr <>~ [QueryArg arg Flag]
where where
str = pack . symbolVal $ (Proxy :: Proxy sym) str = pack . symbolVal $ (Proxy :: Proxy sym)
@ -284,20 +284,20 @@ instance HasForeign lang ftype Raw where
req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :) req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
& reqMethod .~ method & reqMethod .~ method
instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout) instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api)
=> HasForeign lang ftype (ReqBody list a :> sublayout) where => HasForeign lang ftype (ReqBody list a :> api) where
type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout type Foreign ftype (ReqBody list a :> api) = Foreign ftype api
foreignFor lang ftype Proxy req = foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) $ foreignFor lang ftype (Proxy :: Proxy api) $
req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a)) req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a))
instance (KnownSymbol path, HasForeign lang ftype sublayout) instance (KnownSymbol path, HasForeign lang ftype api)
=> HasForeign lang ftype (path :> sublayout) where => HasForeign lang ftype (path :> api) where
type Foreign ftype (path :> sublayout) = Foreign ftype sublayout type Foreign ftype (path :> api) = Foreign ftype api
foreignFor lang ftype Proxy req = foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) $ foreignFor lang ftype (Proxy :: Proxy api) $
req & reqUrl . path <>~ [Segment (Static (PathSegment str))] req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
& reqFuncName . _FunctionName %~ (++ [str]) & reqFuncName . _FunctionName %~ (++ [str])
where where
@ -305,39 +305,39 @@ instance (KnownSymbol path, HasForeign lang ftype sublayout)
Data.Text.map (\c -> if c == '.' then '_' else c) Data.Text.map (\c -> if c == '.' then '_' else c)
. pack . symbolVal $ (Proxy :: Proxy path) . pack . symbolVal $ (Proxy :: Proxy path)
instance HasForeign lang ftype sublayout instance HasForeign lang ftype api
=> HasForeign lang ftype (RemoteHost :> sublayout) where => HasForeign lang ftype (RemoteHost :> api) where
type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout type Foreign ftype (RemoteHost :> api) = Foreign ftype api
foreignFor lang ftype Proxy req = foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) req foreignFor lang ftype (Proxy :: Proxy api) req
instance HasForeign lang ftype sublayout instance HasForeign lang ftype api
=> HasForeign lang ftype (IsSecure :> sublayout) where => HasForeign lang ftype (IsSecure :> api) where
type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout type Foreign ftype (IsSecure :> api) = Foreign ftype api
foreignFor lang ftype Proxy req = foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) req foreignFor lang ftype (Proxy :: Proxy api) req
instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where instance HasForeign lang ftype api => HasForeign lang ftype (Vault :> api) where
type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout type Foreign ftype (Vault :> api) = Foreign ftype api
foreignFor lang ftype Proxy req = foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) req foreignFor lang ftype (Proxy :: Proxy api) req
instance HasForeign lang ftype sublayout => instance HasForeign lang ftype api =>
HasForeign lang ftype (WithNamedContext name context sublayout) where HasForeign lang ftype (WithNamedContext name context api) where
type Foreign ftype (WithNamedContext name context sublayout) = Foreign ftype sublayout type Foreign ftype (WithNamedContext name context api) = Foreign ftype api
foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy sublayout) foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
instance HasForeign lang ftype sublayout instance HasForeign lang ftype api
=> HasForeign lang ftype (HttpVersion :> sublayout) where => HasForeign lang ftype (HttpVersion :> api) where
type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout type Foreign ftype (HttpVersion :> api) = Foreign ftype api
foreignFor lang ftype Proxy req = foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy sublayout) req foreignFor lang ftype (Proxy :: Proxy api) req
-- | Utility class used by 'listFromAPI' which computes -- | Utility class used by 'listFromAPI' which computes
-- the data needed to generate a function for each endpoint -- the data needed to generate a function for each endpoint

2
servant-js/src/Servant/JS.hs
View file

@ -128,7 +128,7 @@ import Servant.Foreign (listFromAPI)
-- | Generate the data necessary to generate javascript code -- | Generate the data necessary to generate javascript code
-- for all the endpoints of an API, as ':<|>'-separated values -- for all the endpoints of an API, as ':<|>'-separated values
-- of type 'AjaxReq'. -- of type 'AjaxReq'.
javascript :: HasForeign NoTypes () layout => Proxy layout -> Foreign () layout javascript :: HasForeign NoTypes () api => Proxy api -> Foreign () api
javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq
-- | Directly generate all the javascript functions for your API -- | Directly generate all the javascript functions for your API

24
servant-js/test/Servant/JSSpec/CustomHeaders.hs
View file

@ -23,11 +23,11 @@ import Servant.JS.Internal
-- using -- Basic, Digest, whatever. -- using -- Basic, Digest, whatever.
data Authorization (sym :: Symbol) a data Authorization (sym :: Symbol) a
instance (KnownSymbol sym, HasForeign lang () sublayout) instance (KnownSymbol sym, HasForeign lang () api)
=> HasForeign lang () (Authorization sym a :> sublayout) where => HasForeign lang () (Authorization sym a :> api) where
type Foreign () (Authorization sym a :> sublayout) = Foreign () sublayout type Foreign () (Authorization sym a :> api) = Foreign () api
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
req & reqHeaders <>~ req & reqHeaders <>~
[ ReplaceHeaderArg (Arg "Authorization" ()) [ ReplaceHeaderArg (Arg "Authorization" ())
$ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ] $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
@ -37,11 +37,11 @@ instance (KnownSymbol sym, HasForeign lang () sublayout)
-- | This is a combinator that fetches an X-MyLovelyHorse header. -- | This is a combinator that fetches an X-MyLovelyHorse header.
data MyLovelyHorse a data MyLovelyHorse a
instance (HasForeign lang () sublayout) instance (HasForeign lang () api)
=> HasForeign lang () (MyLovelyHorse a :> sublayout) where => HasForeign lang () (MyLovelyHorse a :> api) where
type Foreign () (MyLovelyHorse a :> sublayout) = Foreign () sublayout type Foreign () (MyLovelyHorse a :> api) = Foreign () api
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" ()) tpl ] req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" ()) tpl ]
where where
tpl = "I am good friends with {X-MyLovelyHorse}" tpl = "I am good friends with {X-MyLovelyHorse}"
@ -49,11 +49,11 @@ instance (HasForeign lang () sublayout)
-- | This is a combinator that fetches an X-WhatsForDinner header. -- | This is a combinator that fetches an X-WhatsForDinner header.
data WhatsForDinner a data WhatsForDinner a
instance (HasForeign lang () sublayout) instance (HasForeign lang () api)
=> HasForeign lang () (WhatsForDinner a :> sublayout) where => HasForeign lang () (WhatsForDinner a :> api) where
type Foreign () (WhatsForDinner a :> sublayout) = Foreign () sublayout type Foreign () (WhatsForDinner a :> api) = Foreign () api
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" ()) tpl ] req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" ()) tpl ]
where where
tpl = "I would like {X-WhatsForDinner} with a cherry on top." tpl = "I would like {X-WhatsForDinner} with a cherry on top."

12
servant-server/src/Servant/Server.hs
View file

@ -130,11 +130,11 @@ import Servant.Utils.Enter
-- > main :: IO () -- > main :: IO ()
-- > main = Network.Wai.Handler.Warp.run 8080 app -- > main = Network.Wai.Handler.Warp.run 8080 app
-- --
serve :: (HasServer layout '[]) => Proxy layout -> Server layout -> Application serve :: (HasServer api '[]) => Proxy api -> Server api -> Application
serve p = serveWithContext p EmptyContext serve p = serveWithContext p EmptyContext
serveWithContext :: (HasServer layout context) serveWithContext :: (HasServer api context)
=> Proxy layout -> Context context -> Server layout -> Application => Proxy api -> Context context -> Server api -> Application
serveWithContext p context server = serveWithContext p context server =
toApplication (runRouter (route p context (emptyDelayed (Route server)))) toApplication (runRouter (route p context (emptyDelayed (Route server))))
@ -189,12 +189,12 @@ serveWithContext p context server =
-- that one takes precedence. If both parts fail, the \"better\" error -- that one takes precedence. If both parts fail, the \"better\" error
-- code will be returned. -- code will be returned.
-- --
layout :: (HasServer layout '[]) => Proxy layout -> Text layout :: (HasServer api '[]) => Proxy api -> Text
layout p = layoutWithContext p EmptyContext layout p = layoutWithContext p EmptyContext
-- | Variant of 'layout' that takes an additional 'Context'. -- | Variant of 'layout' that takes an additional 'Context'.
layoutWithContext :: (HasServer layout context) layoutWithContext :: (HasServer api context)
=> Proxy layout -> Context context -> Text => Proxy api -> Context context -> Text
layoutWithContext p context = layoutWithContext p context =
routerLayout (route p context (emptyDelayed (FailFatal err501))) routerLayout (route p context (emptyDelayed (FailFatal err501)))

78
servant-server/src/Servant/Server/Internal.hs
View file

@ -68,16 +68,16 @@ import Servant.Server.Internal.RoutingApplication
import Servant.Server.Internal.ServantErr import Servant.Server.Internal.ServantErr
class HasServer layout context where class HasServer api context where
type ServerT layout (m :: * -> *) :: * type ServerT api (m :: * -> *) :: *
route :: route ::
Proxy layout Proxy api
-> Context context -> Context context
-> Delayed env (Server layout) -> Delayed env (Server api)
-> Router env -> Router env
type Server layout = ServerT layout Handler type Server api = ServerT api Handler
-- * Instances -- * Instances
@ -118,15 +118,15 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
-- > server = getBook -- > server = getBook
-- > where getBook :: Text -> Handler Book -- > where getBook :: Text -> Handler Book
-- > getBook isbn = ... -- > getBook isbn = ...
instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout context) instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
=> HasServer (Capture capture a :> sublayout) context where => HasServer (Capture capture a :> api) context where
type ServerT (Capture capture a :> sublayout) m = type ServerT (Capture capture a :> api) m =
a -> ServerT sublayout m a -> ServerT api m
route Proxy context d = route Proxy context d =
CaptureRouter $ CaptureRouter $
route (Proxy :: Proxy sublayout) route (Proxy :: Proxy api)
context context
(addCapture d $ \ txt -> case parseUrlPieceMaybe txt :: Maybe a of (addCapture d $ \ txt -> case parseUrlPieceMaybe txt :: Maybe a of
Nothing -> delayedFail err400 Nothing -> delayedFail err400
@ -236,15 +236,15 @@ instance OVERLAPPING_
-- > server = viewReferer -- > server = viewReferer
-- > where viewReferer :: Referer -> Handler referer -- > where viewReferer :: Referer -> Handler referer
-- > viewReferer referer = return referer -- > viewReferer referer = return referer
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context) instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)
=> HasServer (Header sym a :> sublayout) context where => HasServer (Header sym a :> api) context where
type ServerT (Header sym a :> sublayout) m = type ServerT (Header sym a :> api) m =
Maybe a -> ServerT sublayout m Maybe a -> ServerT api m
route Proxy context subserver = route Proxy context subserver =
let mheader req = parseHeaderMaybe =<< lookup str (requestHeaders req) let mheader req = parseHeaderMaybe =<< lookup str (requestHeaders req)
in route (Proxy :: Proxy sublayout) context (passToServer subserver mheader) in route (Proxy :: Proxy api) context (passToServer subserver mheader)
where str = fromString $ symbolVal (Proxy :: Proxy sym) where str = fromString $ symbolVal (Proxy :: Proxy sym)
-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API, -- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
@ -268,11 +268,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
-- > where getBooksBy :: Maybe Text -> Handler [Book] -- > where getBooksBy :: Maybe Text -> Handler [Book]
-- > getBooksBy Nothing = ...return all books... -- > getBooksBy Nothing = ...return all books...
-- > getBooksBy (Just author) = ...return books by the given author... -- > getBooksBy (Just author) = ...return books by the given author...
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context) instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)
=> HasServer (QueryParam sym a :> sublayout) context where => HasServer (QueryParam sym a :> api) context where
type ServerT (QueryParam sym a :> sublayout) m = type ServerT (QueryParam sym a :> api) m =
Maybe a -> ServerT sublayout m Maybe a -> ServerT api m
route Proxy context subserver = route Proxy context subserver =
let querytext r = parseQueryText $ rawQueryString r let querytext r = parseQueryText $ rawQueryString r
@ -282,7 +282,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
Just Nothing -> Nothing -- param present with no value -> Nothing Just Nothing -> Nothing -- param present with no value -> Nothing
Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
-- the right type -- the right type
in route (Proxy :: Proxy sublayout) context (passToServer subserver param) in route (Proxy :: Proxy api) context (passToServer subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API, -- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
@ -304,11 +304,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
-- > server = getBooksBy -- > server = getBooksBy
-- > where getBooksBy :: [Text] -> Handler [Book] -- > where getBooksBy :: [Text] -> Handler [Book]
-- > getBooksBy authors = ...return all books by these authors... -- > getBooksBy authors = ...return all books by these authors...
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context) instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)
=> HasServer (QueryParams sym a :> sublayout) context where => HasServer (QueryParams sym a :> api) context where
type ServerT (QueryParams sym a :> sublayout) m = type ServerT (QueryParams sym a :> api) m =
[a] -> ServerT sublayout m [a] -> ServerT api m
route Proxy context subserver = route Proxy context subserver =
let querytext r = parseQueryText $ rawQueryString r let querytext r = parseQueryText $ rawQueryString r
@ -317,7 +317,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
-- corresponding values -- corresponding values
parameters r = filter looksLikeParam (querytext r) parameters r = filter looksLikeParam (querytext r)
values r = mapMaybe (convert . snd) (parameters r) values r = mapMaybe (convert . snd) (parameters r)
in route (Proxy :: Proxy sublayout) context (passToServer subserver values) in route (Proxy :: Proxy api) context (passToServer subserver values)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
convert Nothing = Nothing convert Nothing = Nothing
@ -335,11 +335,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
-- > server = getBooks -- > server = getBooks
-- > where getBooks :: Bool -> Handler [Book] -- > where getBooks :: Bool -> Handler [Book]
-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument... -- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
instance (KnownSymbol sym, HasServer sublayout context) instance (KnownSymbol sym, HasServer api context)
=> HasServer (QueryFlag sym :> sublayout) context where => HasServer (QueryFlag sym :> api) context where
type ServerT (QueryFlag sym :> sublayout) m = type ServerT (QueryFlag sym :> api) m =
Bool -> ServerT sublayout m Bool -> ServerT api m
route Proxy context subserver = route Proxy context subserver =
let querytext r = parseQueryText $ rawQueryString r let querytext r = parseQueryText $ rawQueryString r
@ -347,7 +347,7 @@ instance (KnownSymbol sym, HasServer sublayout context)
Just Nothing -> True -- param is there, with no value Just Nothing -> True -- param is there, with no value
Just (Just v) -> examine v -- param with a value Just (Just v) -> examine v -- param with a value
Nothing -> False -- param not in the query string Nothing -> False -- param not in the query string
in route (Proxy :: Proxy sublayout) context (passToServer subserver param) in route (Proxy :: Proxy api) context (passToServer subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
examine v | v == "true" || v == "1" || v == "" = True examine v | v == "true" || v == "1" || v == "" = True
| otherwise = False | otherwise = False
@ -392,14 +392,14 @@ instance HasServer Raw context where
-- > server = postBook -- > server = postBook
-- > where postBook :: Book -> Handler Book -- > where postBook :: Book -> Handler Book
-- > postBook book = ...insert into your db... -- > postBook book = ...insert into your db...
instance ( AllCTUnrender list a, HasServer sublayout context instance ( AllCTUnrender list a, HasServer api context
) => HasServer (ReqBody list a :> sublayout) context where ) => HasServer (ReqBody list a :> api) context where
type ServerT (ReqBody list a :> sublayout) m = type ServerT (ReqBody list a :> api) m =
a -> ServerT sublayout m a -> ServerT api m
route Proxy context subserver = route Proxy context subserver =
route (Proxy :: Proxy sublayout) context (addBodyCheck subserver bodyCheck) route (Proxy :: Proxy api) context (addBodyCheck subserver bodyCheck)
where where
bodyCheck = withRequest $ \ request -> do bodyCheck = withRequest $ \ request -> do
-- See HTTP RFC 2616, section 7.2.1 -- See HTTP RFC 2616, section 7.2.1
@ -416,15 +416,15 @@ instance ( AllCTUnrender list a, HasServer sublayout context
Just (Right v) -> return v Just (Right v) -> return v
-- | Make sure the incoming request starts with @"/path"@, strip it and -- | Make sure the incoming request starts with @"/path"@, strip it and
-- pass the rest of the request path to @sublayout@. -- pass the rest of the request path to @api@.
instance (KnownSymbol path, HasServer sublayout context) => HasServer (path :> sublayout) context where instance (KnownSymbol path, HasServer api context) => HasServer (path :> api) context where
type ServerT (path :> sublayout) m = ServerT sublayout m type ServerT (path :> api) m = ServerT api m
route Proxy context subserver = route Proxy context subserver =
pathRouter pathRouter
(cs (symbolVal proxyPath)) (cs (symbolVal proxyPath))
(route (Proxy :: Proxy sublayout) context subserver) (route (Proxy :: Proxy api) context subserver)
where proxyPath = Proxy :: Proxy path where proxyPath = Proxy :: Proxy path
instance HasServer api context => HasServer (RemoteHost :> api) context where instance HasServer api context => HasServer (RemoteHost :> api) context where