packages feed

servant-queryparam-server (empty) → 0.4.0

raw patch · 2 files changed

+252/−0 lines, 2 filesdep +basedep +servantdep +servant-queryparam-core

Dependencies added: base, servant, servant-queryparam-core, servant-server, text

Files

+ servant-queryparam-server.cabal view
@@ -0,0 +1,28 @@+cabal-version: 1.12+name:          servant-queryparam-server+version:       0.4.0+maintainer:    Danila Danko <https://github.com/deemp>+author:        Kristof Bastiaensen+copyright:     Kristof Bastiaensen 2020+synopsis:+  Server support for [servant-queryparam-core](https://hackage.haskell.org/package/servant-queryparam-core).++category:      Servant, Web+license:       BSD3+build-type:    Simple++source-repository head+  type:     git+  location: https://github.com/deemp/servant-queryparam++library+  default-language: GHC2021+  ghc-options:      -Wall+  exposed-modules:  Servant.Server.Record+  hs-source-dirs:   src+  build-depends:+      base                     >=4.16  && <5+    , servant                  >=0.19+    , servant-queryparam-core  >=0.0.1+    , servant-server           >=0.19+    , text
+ src/Servant/Server/Record.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | This module exports orphan instances to make+-- [@servant-queryparam-core@](https://hackage.haskell.org/package/servant-queryparam-core) work with servers.+module Servant.Server.Record () where++import Data.Kind+import Data.Proxy+import GHC.Generics+import GHC.TypeLits+import Servant.API+import Servant.Record+import Servant.Server+import Servant.Server.Internal+import Servant.TypeLevel++instance (Generic a, GHasServer mod (Rep a) context api) => HasServer (RecordParam mod a :> api) context where+  type ServerT (RecordParam mod a :> api) m = a -> ServerT api m+  route _ context env =+    gRoute (Proxy :: Proxy mod) (Proxy :: Proxy api) context $+      (\f (x :: Rep a ()) -> f (to x)) <$> env+  {-# INLINE route #-}+  hoistServerWithContext _ pc nt s x =+    gHoistServerWithContext (Proxy :: Proxy mod) (Proxy :: Proxy api) pc nt (s . to) (from x :: Rep a ())+  {-# INLINE hoistServerWithContext #-}++class GHasServer (mod :: Symbol -> Exp Symbol) (a :: Type -> Type) context api where+  gRoute ::+    Proxy mod ->+    Proxy api ->+    Context context ->+    Delayed env (a () -> Server api) ->+    Router env+  gHoistServerWithContext ::+    Proxy mod ->+    Proxy api ->+    Proxy context ->+    (forall x. m x -> n x) ->+    (a () -> ServerT api m) ->+    (a () -> ServerT api n)++data GParam (mod :: Symbol -> Exp Symbol) a++instance+  GHasServer mod a context api =>+  HasServer (GParam mod (a ()) :> api) context+  where+  type ServerT (GParam mod (a ()) :> api) m = a () -> ServerT api m+  route _ = gRoute (Proxy :: Proxy mod) (Proxy :: Proxy api)+  {-# INLINE route #-}+  hoistServerWithContext _ = gHoistServerWithContext (Proxy :: Proxy mod) (Proxy :: Proxy api)+  {-# INLINE hoistServerWithContext #-}++instance+  GHasServer mod c context api =>+  GHasServer mod (D1 m3 c) context api+  where+  gRoute _ _ context env =+    gRoute (Proxy :: Proxy mod) (Proxy :: Proxy api) context $+      (\f x -> f (M1 x)) <$> env+  {-# INLINE gRoute #-}+  gHoistServerWithContext _ _ pc nt s (M1 x) =+    gHoistServerWithContext (Proxy :: Proxy mod) (Proxy :: Proxy api) pc nt (s . M1) x+  {-# INLINE gHoistServerWithContext #-}++instance+  GHasServer mod a context (GParam mod (b ()) :> api) =>+  GHasServer mod (a :*: b) context api+  where+  gRoute _ _ context env =+    gRoute+      (Proxy :: Proxy mod)+      (Proxy :: Proxy (GParam mod (b ()) :> api))+      context+      $ (\f x y -> f (x :*: y)) <$> env+  {-# INLINE gRoute #-}+  gHoistServerWithContext _ _ pc nt s (x :*: y) =+    gHoistServerWithContext+      (Proxy :: Proxy mod)+      (Proxy :: Proxy (GParam mod (b ()) :> api))+      pc+      nt+      (\x' y' -> s (x' :*: y'))+      x+      y+  {-# INLINE gHoistServerWithContext #-}++instance+  GHasServer mod a context api =>+  GHasServer mod (C1 n a) context api+  where+  gRoute _ _ context env =+    gRoute (Proxy :: Proxy mod) (Proxy :: Proxy api) context $+      (\f x -> f (M1 x)) <$> env+  {-# INLINE gRoute #-}+  gHoistServerWithContext _ _ pc nt s (M1 x) =+    gHoistServerWithContext (Proxy :: Proxy mod) (Proxy :: Proxy api) pc nt (s . M1) x+  {-# INLINE gHoistServerWithContext #-}++instance+  {-# OVERLAPPING #-}+  ( HasServer (api :: Type) context,+    KnownSymbol sym,+    KnownSymbol (Eval (mod sym))+  ) =>+  GHasServer+    mod+    (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 Bool))+    context+    api+  where+  gRoute _ _ context env =+    route+      (Proxy :: Proxy (QueryFlag (Eval (mod sym)) :> api))+      context+      $ (\f x -> f (M1 (K1 x))) <$> env+  {-# INLINE gRoute #-}+  gHoistServerWithContext _ _ pc nt s (M1 (K1 x)) =+    hoistServerWithContext+      (Proxy :: Proxy (QueryFlag (Eval (mod sym)) :> api))+      pc+      nt+      (s . M1 . K1)+      x+  {-# INLINE gHoistServerWithContext #-}++instance+  {-# OVERLAPPING #-}+  ( HasServer (api :: Type) context,+    FromHttpApiData a,+    KnownSymbol sym,+    KnownSymbol (Eval (mod sym)),+    HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters+  ) =>+  GHasServer+    mod+    (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 [a]))+    context+    api+  where+  gRoute _ _ context env =+    route+      (Proxy :: Proxy (QueryParams (Eval (mod sym)) a :> api))+      context+      $ (\f x -> f (M1 (K1 x))) <$> env+  {-# INLINE gRoute #-}+  gHoistServerWithContext _ _ pc nt s (M1 (K1 x)) =+    hoistServerWithContext+      (Proxy :: Proxy (QueryParams (Eval (mod sym)) a :> api))+      pc+      nt+      (s . M1 . K1)+      x+  {-# INLINE gHoistServerWithContext #-}++instance+  {-# OVERLAPPING #-}+  ( HasServer (api :: Type) context,+    FromHttpApiData a,+    KnownSymbol sym,+    KnownSymbol (Eval (mod sym)),+    HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters+  ) =>+  GHasServer+    mod+    (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 (Maybe a)))+    context+    api+  where+  gRoute _ _ context env =+    route+      (Proxy :: Proxy (QueryParam (Eval (mod sym)) a :> api))+      context+      $ (\f x -> f (M1 (K1 x))) <$> env+  {-# INLINE gRoute #-}+  gHoistServerWithContext _ _ pc nt s (M1 (K1 x)) =+    hoistServerWithContext+      (Proxy :: Proxy (QueryParam (Eval (mod sym)) a :> api))+      pc+      nt+      (s . M1 . K1)+      x+  {-# INLINE gHoistServerWithContext #-}++instance+  {-# OVERLAPPABLE #-}+  ( HasServer (api :: Type) context,+    FromHttpApiData a,+    KnownSymbol sym,+    KnownSymbol (Eval (mod sym)),+    HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters+  ) =>+  GHasServer+    mod+    (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 a))+    context+    api+  where+  gRoute _ _ context env =+    route+      (Proxy :: Proxy (QueryParam' '[Required, Strict] (Eval (mod 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] (Eval (mod sym)) a :> api))+      pc+      nt+      (s . M1 . K1)+      x+  {-# INLINE gHoistServerWithContext #-}