a96a0ff · roboservant · git.iko.soy

benchmarks/prelude+1−11

compare with master

unifiedsplit

@@ -52,17 +52,7 @@ handler = pure . \case

52 Input1 foo -> Output1 foo

53 Input2 bar -> Output2 bar

54

55−main =

56− -- 28s at 80 reps

57− -- fuzz @Api server defaultConfig (pure ())

55+main = fuzz @Api server defaultConfig (pure ())

58− pure ()

59−

60−-- 18.5s at 80 reps

61−-- reifiedApi = toReifiedApi flattened endpoints

62−

63−flattened = flattenServer @Api server

64−

65−endpoints = Proxy @(Endpoints Api)

66

56

67defaultConfig :: Config

57defaultConfig :: Config

68defaultConfig = Config {

58defaultConfig = Config {

src/Roboservant/Types/FlattenServer.hs+4−3

@@ -6,6 +6,7 @@

6{-# LANGUAGE TypeApplications #-}

7{-# LANGUAGE TypeOperators #-}

8{-# LANGUAGE UndecidableInstances #-}

9+-- | terrible name, this really just pulls stuff out where we can fiddle with it.

9

10

10module Roboservant.Types.FlattenServer where

11module Roboservant.Types.FlattenServer where

11

12

@@ -18,10 +19,10 @@ data Bundled endpoints where

18class FlattenServer api where

19class FlattenServer api where

19 flattenServer :: Server api -> Bundled (Endpoints api)

20 flattenServer :: Server api -> Bundled (Endpoints api)

20

21

22+

21instance

23instance

24+ ( FlattenServer api

22− ( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api)

25+ , Endpoints endpoint ~ '[endpoint]

23−-- , Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api)

24− , FlattenServer api

25 ) =>

26 ) =>

26 FlattenServer (endpoint :<|> api)

27 FlattenServer (endpoint :<|> api)

27 where

28 where

src/Roboservant/Types/ReifiedApi.hs+5−4

@@ -55,11 +55,11 @@ type ReifiedApi = [(ApiOffset, ReifiedEndpoint)]

55tagType :: Typeable a => f a -> TypedF f a

56tagType = (R.typeRep :*:)

57

58−class ToReifiedApi (endpoints :: [*]) where

58+class ToReifiedApi (endpoints ) where

59+

59 toReifiedApi :: Bundled endpoints -> Proxy endpoints -> ReifiedApi

60 toReifiedApi :: Bundled endpoints -> Proxy endpoints -> ReifiedApi

60

61

61−class ( V.Curried (EndpointArgs endpoint) (Handler (EndpointRes endpoint)) ~ Server endpoint

62− , V.RecordToList (EndpointArgs endpoint)

62+class ( V.RecordToList (EndpointArgs endpoint)

63 , V.RMap (EndpointArgs endpoint)

64 ) => ToReifiedEndpoint (endpoint :: *) where

65 type EndpointArgs endpoint :: [Type]

@@ -72,10 +72,11 @@ instance ToReifiedApi '[] where

72

73instance

74 ( Typeable (EndpointRes endpoint)

75+

75 , NormalizeFunction (ServerT endpoint Handler)

76 , NormalizeFunction (ServerT endpoint Handler)

76 , Normal (ServerT endpoint Handler) ~ V.Curried (EndpointArgs endpoint) (IO (Either ServerError (NonEmpty (Dynamic,Int))))

77 , Normal (ServerT endpoint Handler) ~ V.Curried (EndpointArgs endpoint) (IO (Either ServerError (NonEmpty (Dynamic,Int))))

77 , ToReifiedEndpoint endpoint

78 , ToReifiedEndpoint endpoint

78− , ToReifiedApi endpoints, Typeable (ServerT endpoint Handler)

79+ , ToReifiedApi endpoints

79 ) =>

80 ) =>

80 ToReifiedApi (endpoint : endpoints)

81 ToReifiedApi (endpoint : endpoints)

81 where

82 where

test/Nested.hsnew file+25

@@ -0,0 +1,25 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE DerivingStrategies #-}

4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5+{-# LANGUAGE OverloadedStrings #-}

6+{-# LANGUAGE TypeOperators #-}

7+

8+module Nested where

9+

10+import Servant

11+import Servant.API.Flatten

12+

13+

14+type Api =

15+ ("one" :> Post '[JSON] Int

16+ :<|> "two" :> Post '[JSON] Int

17+ )

18+ :<|> (

19+ "three" :> Post '[JSON] Int

20+ )

21+

22+type FlatApi = Flat Api

23+

24+server :: Server FlatApi

25+server = pure 1 :<|> pure 2 :<|> pure 3