named-servant 0.0.1 → 0.0.2

raw patch · 3 files changed

+108/−2 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Servant.Named: data NamedQueryFlag (sym :: Symbol)

+ Servant.Named: instance (GHC.TypeLits.KnownSymbol sym, Servant.Links.HasLink sub) => Servant.Links.HasLink (Servant.Named.NamedQueryFlag sym Servant.API.Sub.:> sub)

+ Servant.Record: data RecordParam (a :: *)

+ Servant.Record: instance (GHC.Generics.Generic a, Servant.Record.GHasLink (GHC.Generics.Rep a ()) sub) => Servant.Links.HasLink (Servant.Record.RecordParam a Servant.API.Sub.:> sub)

+ Servant.Record: instance (GHC.TypeLits.KnownSymbol sym, Servant.Links.HasLink sub) => Servant.Record.GHasLink (GHC.Generics.S1 ('GHC.Generics.MetaSel ('GHC.Maybe.Just sym) d1 d2 d3) (GHC.Generics.Rec0 GHC.Types.Bool) ()) sub

+ Servant.Record: instance (GHC.TypeLits.KnownSymbol sym, Web.Internal.HttpApiData.ToHttpApiData a, Servant.Links.HasLink (a Servant.API.Sub.:> sub), Servant.Links.HasLink sub) => Servant.Record.GHasLink (GHC.Generics.S1 ('GHC.Generics.MetaSel ('GHC.Maybe.Just sym) d1 d2 d3) (GHC.Generics.Rec0 (GHC.Maybe.Maybe a)) ()) sub

+ Servant.Record: instance (Servant.Links.HasLink sub, Servant.Record.GHasLink (a ()) (Servant.Record.GParam (b ()) Servant.API.Sub.:> sub)) => Servant.Record.GHasLink ((GHC.Generics.:*:) a b ()) sub

+ Servant.Record: instance (Servant.Record.GHasLink (a ()) sub, Servant.Links.HasLink sub) => Servant.Record.GHasLink (GHC.Generics.C1 m a ()) sub

+ Servant.Record: instance Servant.Record.GHasLink (c m2 ()) sub => Servant.Record.GHasLink (GHC.Generics.D1 m (c m2) ()) sub

+ Servant.Record: instance Servant.Record.GHasLink a sub => Servant.Links.HasLink (Servant.Record.GParam a Servant.API.Sub.:> sub)

Files

named-servant.cabal +2/−1
src/Servant/Named.hs +12/−1
src/Servant/Record.hs +94/−0

named-servant.cabal view

@@ -1,7 +1,7 @@ cabal-version: 1.12 name: named-servant description: support named parameters in servant using the named package-version: 0.0.1+version: 0.0.2 maintainer: kristof@resonata.be copyright: Kristof Bastiaensen 2020 license: BSD3@@ -17,6 +17,7 @@    Ghc-options: -Wall    exposed-modules:         Servant.Named+        Servant.Record    hs-source-dirs:         src    build-depends:

src/Servant/Named.hs view

@@ -8,7 +8,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE EmptyDataDecls #-} module Servant.Named (NamedQueryParam, OptionalQueryParam, NamedQueryParams,-                      NamedQueryParam') where+                      NamedQueryFlag, NamedQueryParam') where import Servant.API import Servant.API.Modifiers import Data.Proxy@@ -57,3 +57,14 @@     toLink toA _ l (Arg params) =       toLink toA (Proxy :: Proxy (QueryParams sym v :> sub)) l params +-- | Like `QueryFlag, but extracts a named type @named `:!` Bool@+-- instead, where named corresponds to the query parameter string.+data NamedQueryFlag (sym :: Symbol)+instance (KnownSymbol sym, HasLink sub)+    => HasLink (NamedQueryFlag sym :> sub)+  where+    type MkLink (NamedQueryFlag sym :> sub) a =+      (sym :! Bool) -> MkLink sub a+    toLink toA _ l (Arg qparam) =+      toLink toA (Proxy :: Proxy (QueryFlag sym :> sub)) l qparam+

+ src/Servant/Record.hs view

@@ -0,0 +1,94 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Servant.Record (RecordParam) where+import Servant.API+import Data.Proxy+import GHC.TypeLits+import GHC.Generics++data RecordParam (a :: *)++instance (Generic a, GHasLink (Rep a ()) sub) =>+         HasLink (RecordParam a :> sub)+  where+    type MkLink (RecordParam a :> sub) b = a -> MkLink sub b+    toLink toA _ l record =+      gToLink toA (Proxy :: Proxy sub) l (from record :: Rep a ())++data GParam a++instance GHasLink a sub => HasLink (GParam a :> sub) where+  type MkLink (GParam a :> sub) b = a -> MkLink sub b+  toLink toA _ = gToLink toA (Proxy :: Proxy sub)+  {-# INLINE toLink #-}+  +class HasLink sub => GHasLink a sub where+  gToLink :: (Link -> b) -> Proxy sub -> Link -> a -> MkLink sub b++instance GHasLink (c m2 ()) sub => GHasLink (D1 m (c m2) ()) sub where+  gToLink toA _ l (M1 x) = gToLink toA (Proxy :: Proxy sub) l x+  {-# INLINE gToLink #-}++instance ( HasLink sub+         , GHasLink (a ()) (GParam (b ()) :> sub)+         )+         => GHasLink ((a :*: b) ()) sub where+  gToLink toA _ l (a :*: b) =+    gToLink toA (Proxy :: Proxy (GParam (b ()) :> sub)) l a b+  {-# INLINE gToLink #-}++instance (GHasLink (a ()) sub, HasLink sub) =>+         GHasLink (C1 m a ()) sub where+  gToLink toA _ l (M1 x) = gToLink toA (Proxy :: Proxy sub) l x+  {-# INLINE gToLink #-}++instance {-# OVERLAPPING #-}+  ( KnownSymbol sym+  , HasLink sub+  ) =>+  GHasLink (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 Bool) ()) sub where+  gToLink toA _ l (M1 (K1 x)) =+    toLink toA (Proxy :: Proxy (QueryFlag sym :> sub)) l x+  {-# INLINE gToLink #-}++instance {-# OVERLAPPING #-}+  ( KnownSymbol sym+  , ToHttpApiData a+  , HasLink (a :> sub)+  , HasLink sub) =>+  GHasLink (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 [a]) ()) sub where+  gToLink toA _ l (M1 (K1 x)) =+    toLink toA (Proxy :: Proxy (QueryParams sym a :> sub)) l x+  {-# INLINE gToLink #-}++instance {-# OVERLAPPING #-}+  ( KnownSymbol sym+  , ToHttpApiData a+  , HasLink (a :> sub)+  , HasLink sub) =>+  GHasLink (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 (Maybe a)) ()) sub where+  gToLink toA _ l (M1 (K1 x)) =+    toLink toA (Proxy :: Proxy (QueryParam' '[Optional, Strict] sym a :> sub))+    l x+  {-# INLINE gToLink #-}++instance {-# OVERLAPPABLE #-}+  ( KnownSymbol sym+  , ToHttpApiData a+  , HasLink (a :> sub)+  , HasLink sub) =>+  GHasLink (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 a) ()) sub where+  gToLink toA _ l (M1 (K1 x)) =+    toLink toA (Proxy :: Proxy (QueryParam' '[Required, Strict] sym a :> sub))+    l x+  {-# INLINE gToLink #-}+