b1a6d88845
We've previously used functions in the Router type to provide information for subrouters. But this accesses the Requests too early, and breaks sharing of the router structure in general, causing the Router or large parts of the Router to be recomputed on every request. We now do not use functions anymore, and properly compute all static parts of the router first, and gain access to the request only in Delayed. This also turns the code used within Delayed into a proper monad now called DelayedIO, making some of the code using it a bit nicer.
72 lines
2.2 KiB
Haskell
72 lines
2.2 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE KindSignatures #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE PolyKinds #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
-- | These are custom combinators for Servant.Server.UsingContextSpec.
|
|
--
|
|
-- (For writing your own combinators you need to import Internal modules, for
|
|
-- just *using* combinators that require a Context, you don't. This module is
|
|
-- separate from Servant.Server.UsingContextSpec to test that the module imports
|
|
-- work out this way.)
|
|
module Servant.Server.UsingContextSpec.TestCombinators where
|
|
|
|
import GHC.TypeLits
|
|
|
|
import Servant
|
|
|
|
data ExtractFromContext
|
|
|
|
instance (HasContextEntry context String, HasServer subApi context) =>
|
|
HasServer (ExtractFromContext :> subApi) context where
|
|
|
|
type ServerT (ExtractFromContext :> subApi) m =
|
|
String -> ServerT subApi m
|
|
|
|
route Proxy context delayed =
|
|
route subProxy context (fmap (inject context) delayed)
|
|
where
|
|
subProxy :: Proxy subApi
|
|
subProxy = Proxy
|
|
|
|
inject context f = f (getContextEntry context)
|
|
|
|
data InjectIntoContext
|
|
|
|
instance (HasServer subApi (String ': context)) =>
|
|
HasServer (InjectIntoContext :> subApi) context where
|
|
|
|
type ServerT (InjectIntoContext :> subApi) m =
|
|
ServerT subApi m
|
|
|
|
route Proxy context delayed =
|
|
route subProxy newContext delayed
|
|
where
|
|
subProxy :: Proxy subApi
|
|
subProxy = Proxy
|
|
|
|
newContext = ("injected" :: String) :. context
|
|
|
|
data NamedContextWithBirdface (name :: Symbol) (subContext :: [*])
|
|
|
|
instance (HasContextEntry context (NamedContext name subContext), HasServer subApi subContext) =>
|
|
HasServer (NamedContextWithBirdface name subContext :> subApi) context where
|
|
|
|
type ServerT (NamedContextWithBirdface name subContext :> subApi) m =
|
|
ServerT subApi m
|
|
|
|
route Proxy context delayed =
|
|
route subProxy subContext delayed
|
|
where
|
|
subProxy :: Proxy subApi
|
|
subProxy = Proxy
|
|
|
|
subContext :: Context subContext
|
|
subContext = descendIntoNamedContext (Proxy :: Proxy name) context
|