mirror of
https://github.com/ilyakooo0/roboservant.git
synced 2024-09-11 08:05:47 +03:00
some cleanup + a compilation speed fix from sam gelineau
This commit is contained in:
parent
6ab4cd5960
commit
a96a0ffa0e
@ -52,17 +52,7 @@ handler = pure . \case
|
||||
Input1 foo -> Output1 foo
|
||||
Input2 bar -> Output2 bar
|
||||
|
||||
main =
|
||||
-- 28s at 80 reps
|
||||
-- fuzz @Api server defaultConfig (pure ())
|
||||
pure ()
|
||||
|
||||
-- 18.5s at 80 reps
|
||||
-- reifiedApi = toReifiedApi flattened endpoints
|
||||
|
||||
flattened = flattenServer @Api server
|
||||
|
||||
endpoints = Proxy @(Endpoints Api)
|
||||
main = fuzz @Api server defaultConfig (pure ())
|
||||
|
||||
defaultConfig :: Config
|
||||
defaultConfig = Config {
|
||||
|
@ -6,6 +6,7 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
-- | terrible name, this really just pulls stuff out where we can fiddle with it.
|
||||
|
||||
module Roboservant.Types.FlattenServer where
|
||||
|
||||
@ -18,10 +19,10 @@ data Bundled endpoints where
|
||||
class FlattenServer api where
|
||||
flattenServer :: Server api -> Bundled (Endpoints api)
|
||||
|
||||
|
||||
instance
|
||||
( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api)
|
||||
-- , Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api)
|
||||
, FlattenServer api
|
||||
( FlattenServer api
|
||||
, Endpoints endpoint ~ '[endpoint]
|
||||
) =>
|
||||
FlattenServer (endpoint :<|> api)
|
||||
where
|
||||
|
@ -55,11 +55,11 @@ type ReifiedApi = [(ApiOffset, ReifiedEndpoint)]
|
||||
tagType :: Typeable a => f a -> TypedF f a
|
||||
tagType = (R.typeRep :*:)
|
||||
|
||||
class ToReifiedApi (endpoints :: [*]) where
|
||||
class ToReifiedApi (endpoints ) where
|
||||
|
||||
toReifiedApi :: Bundled endpoints -> Proxy endpoints -> ReifiedApi
|
||||
|
||||
class ( V.Curried (EndpointArgs endpoint) (Handler (EndpointRes endpoint)) ~ Server endpoint
|
||||
, V.RecordToList (EndpointArgs endpoint)
|
||||
class ( V.RecordToList (EndpointArgs endpoint)
|
||||
, V.RMap (EndpointArgs endpoint)
|
||||
) => ToReifiedEndpoint (endpoint :: *) where
|
||||
type EndpointArgs endpoint :: [Type]
|
||||
@ -72,10 +72,11 @@ instance ToReifiedApi '[] where
|
||||
|
||||
instance
|
||||
( Typeable (EndpointRes endpoint)
|
||||
|
||||
, NormalizeFunction (ServerT endpoint Handler)
|
||||
, Normal (ServerT endpoint Handler) ~ V.Curried (EndpointArgs endpoint) (IO (Either ServerError (NonEmpty (Dynamic,Int))))
|
||||
, ToReifiedEndpoint endpoint
|
||||
, ToReifiedApi endpoints, Typeable (ServerT endpoint Handler)
|
||||
, ToReifiedApi endpoints
|
||||
) =>
|
||||
ToReifiedApi (endpoint : endpoints)
|
||||
where
|
||||
|
25
test/Nested.hs
Normal file
25
test/Nested.hs
Normal file
@ -0,0 +1,25 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Nested where
|
||||
|
||||
import Servant
|
||||
import Servant.API.Flatten
|
||||
|
||||
|
||||
type Api =
|
||||
("one" :> Post '[JSON] Int
|
||||
:<|> "two" :> Post '[JSON] Int
|
||||
)
|
||||
:<|> (
|
||||
"three" :> Post '[JSON] Int
|
||||
)
|
||||
|
||||
type FlatApi = Flat Api
|
||||
|
||||
server :: Server FlatApi
|
||||
server = pure 1 :<|> pure 2 :<|> pure 3
|
Loading…
Reference in New Issue
Block a user