named-servant-server 0.0.1 → 0.0.2

raw patch · 4 files changed

+207/−47 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• named-servant-server.cabal +3/−2
• src/Servant/Named/Server.hs +0/−45
• src/Servant/Server/Named.hs +59/−0
• src/Servant/Server/Record.hs +145/−0

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: named-servant-server-version: 0.0.1+version: 0.0.2 maintainer: kristof@resonata.be copyright: Kristof Bastiaensen 2020 synopsis: server support for named-servant@@ -16,7 +16,8 @@    default-language: Haskell2010    Ghc-options: -Wall    exposed-modules:-        Servant.Named.Server+        Servant.Server.Named+        Servant.Server.Record    hs-source-dirs:         src    build-depends:

@@ -1,45 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE AllowAmbiguousTypes #-}--- | This module just exports orphan instances to make named-servant--- work with servers-module Servant.Named.Server () where-import Servant.API-import Servant.Server-import Servant.Named-import Data.Proxy-import GHC.TypeLits-import Named--instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)-      => HasServer (NamedQueryParams sym a :> api) context where--  type ServerT (NamedQueryParams sym a :> api) m =-    sym :! [a] -> ServerT api m--  hoistServerWithContext _ pc nt s =-    hoistServerWithContext (Proxy :: Proxy api) pc nt . s--  route Proxy context subserver =-    route (Proxy :: Proxy (QueryParams sym a :> api)) context $-    fmap (\f x -> f (Arg x)) subserver--instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)-      => HasServer (NamedQueryParam' mods sym a :> api) context where--  type ServerT (NamedQueryParam' mods sym a :> api) m =-    sym :! [a] -> ServerT api m--  hoistServerWithContext _ pc nt s =-    hoistServerWithContext (Proxy :: Proxy api) pc nt . s--  route Proxy context subserver =-    route (Proxy :: Proxy (QueryParams sym a :> api)) context $-    fmap (\f x -> f (Arg x)) subserver

@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | This module just exports orphan instances to make named-servant+-- work with servers+module Servant.Server.Named () where+import Servant.API+import Servant.Server+import Servant.Named+import Data.Proxy+import GHC.TypeLits+import Named++instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)+      => HasServer (NamedQueryParams sym a :> api) context where++  type ServerT (NamedQueryParams sym a :> api) m =+    sym :! [a] -> ServerT api m++  hoistServerWithContext _ pc nt s =+    hoistServerWithContext (Proxy :: Proxy api) pc nt . s++  route Proxy context subserver =+    route (Proxy :: Proxy (QueryParams sym a :> api)) context $+    fmap (\f x -> f (Arg x)) subserver++instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)+      => HasServer (NamedQueryParam' mods sym a :> api) context where++  type ServerT (NamedQueryParam' mods sym a :> api) m =+    sym :! [a] -> ServerT api m++  hoistServerWithContext _ pc nt s =+    hoistServerWithContext (Proxy :: Proxy api) pc nt . s++  route Proxy context subserver =+    route (Proxy :: Proxy (QueryParams sym a :> api)) context $+    fmap (\f x -> f (Arg x)) subserver++instance (KnownSymbol sym, HasServer api context)+      => HasServer (NamedQueryFlag sym :> api) context where++  type ServerT (NamedQueryFlag sym :> api) m =+    sym :! Bool -> ServerT api m++  hoistServerWithContext _ pc nt s =+    hoistServerWithContext (Proxy :: Proxy api) pc nt . s++  route Proxy context subserver =+    route (Proxy :: Proxy (QueryFlag sym :> api)) context $+    fmap (\f x -> f (Arg x)) subserver

@@ -0,0 +1,145 @@+-- | -- | This module just exports orphan instances to make named-servant+-- work with servers+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Servant.Server.Record () where+import Servant.API+import Data.Proxy+import GHC.TypeLits+import GHC.Generics+import Servant.Server+import Servant.Server.Internal+import Servant.Record++class GHasServer a context api where+  gRoute :: Proxy api -> Context context -> Delayed env (a -> Server api)+        -> Router env+  gHoistServerWithContext :: Proxy api -> Proxy context -> (forall x. m x -> n x)+                         -> (a -> ServerT api m) -> (a -> ServerT api n)++data GParam a++instance ( Generic a+         , GHasServer (Rep a ()) context api+         ) =>+         HasServer (RecordParam a :> api) context where+  type ServerT (RecordParam a :> api) m = a -> ServerT api m+  route _ context env = gRoute (Proxy :: Proxy api) context $+                        (\f (x :: Rep a ()) -> f (to x)) <$> env+  {-# INLINE route #-}+  hoistServerWithContext _ pc nt s x =+    gHoistServerWithContext (Proxy :: Proxy api) pc nt (s . to)+    (from x :: Rep a ())+  {-# INLINE hoistServerWithContext #-}++instance GHasServer a context api => HasServer (GParam a :> api) context where+  type ServerT (GParam a :> api) m = a -> ServerT api m+  route _ = gRoute (Proxy :: Proxy api)+  {-# INLINE route #-}+  hoistServerWithContext _ = gHoistServerWithContext (Proxy :: Proxy api)+  {-# INLINE hoistServerWithContext #-}++instance GHasServer (c m2 ()) context api =>+         GHasServer (D1 m3 (c m2) ()) context api where+  gRoute _ context env = gRoute (Proxy :: Proxy api) context $+                         (\f x -> f (M1 x)) <$> env+  {-# INLINE gRoute #-}                         +  gHoistServerWithContext _ pc nt s (M1 x) =+    gHoistServerWithContext (Proxy :: Proxy api) pc nt (s . M1) x+  {-# INLINE gHoistServerWithContext #-}++instance GHasServer (a ()) context (GParam (b ()) :> api) =>+         GHasServer ((a :*: b)()) context api where+  gRoute _ context env = gRoute (Proxy :: Proxy (GParam (b ()) :> api))+                         context $ (\f x y -> f (x :*: y)) <$> env+  {-# INLINE gRoute #-}                         +  gHoistServerWithContext _ pc nt s (x :*: y) =+    gHoistServerWithContext (Proxy :: Proxy (GParam (b ()) :> api))+    pc nt (\x' y' -> s (x' :*: y')) x y+  {-# INLINE gHoistServerWithContext #-}+    +instance GHasServer (a ()) context api =>+         GHasServer (C1 n a ()) context api where+  gRoute _ context env = gRoute (Proxy :: Proxy api) context $+                         (\f x -> f (M1 x)) <$> env+  {-# INLINE gRoute #-}                         +  gHoistServerWithContext _ pc nt s (M1 x) =+    gHoistServerWithContext (Proxy :: Proxy api) pc nt (s . M1) x+  {-# INLINE gHoistServerWithContext #-}++instance {-# OVERLAPPING #-}+  ( HasServer api context+  , KnownSymbol sym+  ) =>+  GHasServer (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 Bool) ())+             context+             api where+  gRoute _ context env = route (Proxy :: Proxy (QueryFlag sym :> api))+                         context $ (\f x -> f (M1 (K1 x))) <$> env+  {-# INLINE gRoute #-}                         +  gHoistServerWithContext _ pc nt s (M1 (K1 x)) =+    hoistServerWithContext (Proxy :: Proxy (QueryFlag sym :> api)) pc nt+    (s . M1 . K1) x+  {-# INLINE gHoistServerWithContext #-}+    +instance {-# OVERLAPPING #-}+  ( HasServer api context+  , FromHttpApiData a+  , KnownSymbol sym+  ) =>+  GHasServer (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 [a]) ())+             context+             api where+  gRoute _ context env = route (Proxy :: Proxy (QueryParams sym a :> api))+                         context $ (\f x -> f (M1 (K1 x))) <$> env+  {-# INLINE gRoute #-}                         +  gHoistServerWithContext _ pc nt s (M1 (K1 x)) =+    hoistServerWithContext (Proxy :: Proxy (QueryParams sym a :> api)) pc nt+    (s . M1 . K1) x+  {-# INLINE gHoistServerWithContext #-}+    +instance {-# OVERLAPPING #-}+  ( HasServer api context+  , FromHttpApiData a+  , KnownSymbol sym+  ) =>+  GHasServer (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 (Maybe a)) ())+             context+             api where+  gRoute _ context env =+    route (Proxy :: Proxy (QueryParam sym a :> api))+    context $ (\f x -> f (M1 (K1 x))) <$> env+  {-# INLINE gRoute #-}+  gHoistServerWithContext _ pc nt s (M1 (K1 x)) =+    hoistServerWithContext (Proxy :: Proxy (QueryParam sym a :> api))+    pc nt (s . M1 . K1) x+  {-# INLINE gHoistServerWithContext #-}+    +instance {-# OVERLAPPABLE #-}+  ( HasServer api context+  , FromHttpApiData a+  , KnownSymbol sym+  ) =>+  GHasServer (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 a) ())+             context+             api where+  gRoute _ context env =+    route (Proxy :: Proxy (QueryParam' '[Required, Strict] sym a :> api))+    context $ (\f x -> f (M1 (K1 x))) <$> env+  {-# INLINE gRoute #-}+  gHoistServerWithContext _ pc nt s (M1 (K1 x)) =+    hoistServerWithContext+    (Proxy :: Proxy (QueryParam' '[Required, Strict] sym a :> api))+    pc nt (s . M1 . K1) x+  {-# INLINE gHoistServerWithContext #-}