git.iko.soy/roboservant
on master help sign in
some cleanup + a compilation speed fix from sam gelineau
commita96a0ffa0e0c185a8cbd5736aa03b454e431c56f authorMark Wotton <mwotton@gmail.com> dateSat 2 Jan 2021, 13:12 (6 years ago) parent6ab4cd5
4 files changed+35−18
compare with master
unifiedsplit
benchmarks/prelude+1−11 src/Roboservant/Types/FlattenServer.hs+4−3 src/Roboservant/Types/ReifiedApi.hs+5−4 test/Nested.hs+25
benchmarks/prelude+1−11
@@ -52,17 +52,7 @@ handler = pure . \case
5252 Input1 foo -> Output1 foo
5353 Input2 bar -> Output2 bar
5454
55−main =
56− -- 28s at 80 reps
57− -- 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)
55+main = fuzz @Api server defaultConfig (pure ())
6656
6757defaultConfig :: Config
6858defaultConfig = Config {
src/Roboservant/Types/FlattenServer.hs+4−3
@@ -6,6 +6,7 @@
66{-# LANGUAGE TypeApplications #-}
77{-# LANGUAGE TypeOperators #-}
88{-# LANGUAGE UndecidableInstances #-}
9+-- | terrible name, this really just pulls stuff out where we can fiddle with it.
910
1011module Roboservant.Types.FlattenServer where
1112
@@ -18,10 +19,10 @@ data Bundled endpoints where
1819class FlattenServer api where
1920 flattenServer :: Server api -> Bundled (Endpoints api)
2021
22+
2123instance
22− ( Endpoints (endpoint :<|> api) ~ (endpoint ': Endpoints api)
23−-- , Server (endpoint :<|> api) ~ (Server endpoint :<|> Server api)
24− , FlattenServer api
24+ ( FlattenServer api
25+ , Endpoints endpoint ~ '[endpoint]
2526 ) =>
2627 FlattenServer (endpoint :<|> api)
2728 where
src/Roboservant/Types/ReifiedApi.hs+5−4
@@ -55,11 +55,11 @@ type ReifiedApi = [(ApiOffset, ReifiedEndpoint)]
5555tagType :: Typeable a => f a -> TypedF f a
5656tagType = (R.typeRep :*:)
5757
58−class ToReifiedApi (endpoints :: [*]) where
58+class ToReifiedApi (endpoints ) where
59+
5960 toReifiedApi :: Bundled endpoints -> Proxy endpoints -> ReifiedApi
6061
61−class ( V.Curried (EndpointArgs endpoint) (Handler (EndpointRes endpoint)) ~ Server endpoint
62− , V.RecordToList (EndpointArgs endpoint)
62+class ( V.RecordToList (EndpointArgs endpoint)
6363 , V.RMap (EndpointArgs endpoint)
6464 ) => ToReifiedEndpoint (endpoint :: *) where
6565 type EndpointArgs endpoint :: [Type]
@@ -72,10 +72,11 @@ instance ToReifiedApi '[] where
7272
7373instance
7474 ( Typeable (EndpointRes endpoint)
75+
7576 , NormalizeFunction (ServerT endpoint Handler)
7677 , Normal (ServerT endpoint Handler) ~ V.Curried (EndpointArgs endpoint) (IO (Either ServerError (NonEmpty (Dynamic,Int))))
7778 , ToReifiedEndpoint endpoint
78− , ToReifiedApi endpoints, Typeable (ServerT endpoint Handler)
79+ , ToReifiedApi endpoints
7980 ) =>
8081 ToReifiedApi (endpoint : endpoints)
8182 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