servant-queryparam-core 1.0.0 → 2.0.0

raw patch · 6 files changed

+501/−304 lines, 6 files

Files

• README.md +192/−0
• servant-queryparam-core.cabal +9/−4
• src/Servant/QueryParam/Record.hs +187/−0
• src/Servant/QueryParam/TypeLevel.hs +113/−0
• src/Servant/Record.hs +0/−187
• src/Servant/TypeLevel.hs +0/−113

@@ -0,0 +1,192 @@+# servant-queryparam++Provides several libraries that let you use records to specify query parameters in [servant](https://hackage.haskell.org/package/servant) APIs.++These libraries are:++- [servant-queryparam-core](https://github.com/deemp/servant-queryparam/blob/main/servant-queryparam-core)+- [servant-queryparam-server](https://github.com/deemp/servant-queryparam/blob/main/servant-queryparam-server)+- [servant-queryparam-client](https://github.com/deemp/servant-queryparam/blob/main/servant-queryparam-client)+- [servant-queryparam-openapi3](https://github.com/deemp/servant-queryparam/blob/main/servant-queryparam-openapi3)++The following example was taken from [here](https://github.com/deemp/servant-queryparam/tree/main/servant-queryparam-example).++## Example++This example demonstrates servant APIs with query parameters.+There's an OpenAPI specification for each of them.++First, I enable compiler extensions.++```haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+```++Next, I import the necessary modules.++```haskell+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Except (ExceptT (..))+import Data.Aeson (ToJSON)+import Data.ByteString.Lazy.Char8 qualified as BSL8+import Data.Data (Proxy (..), Typeable)+import Data.Maybe (maybeToList)+import Data.OpenApi (OpenApi, ToParamSchema, ToSchema)+import Data.OpenApi.Internal.Utils (encodePretty)+import GHC.Generics (Generic)+import GHC.TypeLits (Symbol)+import Network.Wai.Handler.Warp qualified as Warp+import Servant (Application, Context (..), GenericMode ((:-)), Get, Handler (..), JSON, NamedRoutes, ServerError, (:>))+import Servant.OpenApi (HasOpenApi (..))+import Servant.OpenApi.Record ()+import Servant.Record (RecordParam)+import Servant.Server.Generic (genericServe, genericServeTWithContext)+import Servant.Server.Record ()+import Servant.TypeLevel (DropPrefix, Eval, Exp)+```++I define a label for dropping the prefix of a `Symbol`.++```haskell+data DropPrefixExp :: Symbol -> Exp Symbol+```++Next, I provide an interpreter for that wrapper.++```haskell+type instance Eval (DropPrefixExp sym) = DropPrefix sym+```++`DropPrefix` drops the leading `'_'` characters, then the non-`'_'` characters, then the `'_'` characters.++```haskell+-- >>> :kind! DropPrefix "_params_user"+-- DropPrefix "_params_user" :: Symbol+-- = "user"+```++Then, I define a label for keeping the prefix of a `Symbol`.++```haskell+data KeepPrefixExp :: Symbol -> Exp Symbol+```++The interpreter of this label does nothing to a `Symbol`.++```haskell+type instance Eval (KeepPrefixExp sym) = sym+```++Now, I write a record.+I'll use this record to produce query parameters.++```haskell+data Params = Params+  { _params_user :: Maybe String+  , _params_users :: [String]+  , _params_oneUser :: String+  , _params_userFlag :: Bool+  }+  deriving (Show, Generic, Typeable, ToJSON, ToSchema)+```++This is our first API.+In this API, the query parameter names are the record field names with dropped prefixes.+E.g., the query parameter `user` corresponds to the field name `_params_user`.++```haskell+newtype UserAPI1 routes = UserAPI1+  { get :: routes :- "get" :> RecordParam DropPrefixExp Params :> Get '[JSON] [String]+  }+  deriving (Generic)+```++This is our second API.+In this API, query parameter names are the record field names.+E.g., the query parameter `_params_user` corresponds to the field name `_params_user`.++```haskell+newtype UserAPI2 routes = UserAPI2+  { get :: routes :- "get" :> RecordParam KeepPrefixExp Params :> Get '[JSON] [String]+  }+  deriving (Generic)+```++Now, I define an OpenAPI specification for the first API.++```haskell+specDrop :: OpenApi+specDrop = toOpenApi (Proxy :: Proxy (NamedRoutes UserAPI1))+```++Then, I define an OpenAPI specification for the second API.++```haskell+specKeep :: OpenApi+specKeep = toOpenApi (Proxy :: Proxy (NamedRoutes UserAPI2))+```++Following that, I define an `Application`.+At the `/get` endpoint, the application returns a list of query parameter values.++```haskell+server :: Application+server =+  genericServeTWithContext+    (\x -> Servant.Handler (ExceptT $ Right <$> liftIO x))+    UserAPI1+      { get = \Params{..} ->+          pure $+            maybeToList _params_user+              <> _params_users+              <> [_params_oneUser, show _params_userFlag]+      }+    EmptyContext+```++Finally, I combine all parts.++First, the application will print the OpenAPI specifications in JSON format. Next, it will start a server.++```haskell+main :: IO ()+main = do+  putStrLn "\n---\nQuery parameters without prefixes\n---\n"+  BSL8.putStrLn $ encodePretty specDrop+  putStrLn "\n---\nQuery parameters with prefixes\n---\n"+  BSL8.putStrLn $ encodePretty specKeep++  putStrLn "\n---\nStarting the server...\n---\n"+  putStrLn "\nTry running\n"+  putStrLn "curl -v \"localhost:8080/get?user=1&users=2&users=3&oneUser=4&userFlag=true\""+  Warp.run 8080 server+```++## Run++Run the server.++```hs+cabal run example+```++## Test++When the server is up, request the `/get` endpoint via `curl`.++```console+curl -v "localhost:8080/get?user=1&users=2&users=3&oneUser=4&userFlag=true"+```++You should receive the values of query parameters in a list.++```console+...+["1","2","3","4","True"]+```

@@ -1,7 +1,7 @@ cabal-version: 2.2 name:          servant-queryparam-core synopsis:      Use records for query parameters in servant APIs.-version:       1.0.0+version:       2.0.0 maintainer:    Danila Danko <https://github.com/deemp> author:        Kristof Bastiaensen copyright:     Kristof Bastiaensen 2020@@ -11,8 +11,13 @@ description:   Having positional parameters in @servant@ can be error-prone, especially when there are a lot of them and they have similar types.   This package solves that problem by letting one use records to specify query parameters in @servant@ APIs.-  Use [servant-queryparam-server](https://hackage.haskell.org/package/servant-queryparam-server) for servers and [servant-queryparam-client](https://hackage.haskell.org/package/servant-queryparam-client) for clients.+  Use [servant-queryparam-server](https://hackage.haskell.org/package/servant-queryparam-server) for servers, [servant-queryparam-client](https://hackage.haskell.org/package/servant-queryparam-client) for clients,+  [servant-queryparam-openapi3](https://hackage.haskell.org/package/servant-queryparam-openapi3) for [openapi3](https://hackage.haskell.org/package/openapi3).+  See the [README](https://github.com/deemp/servant-queryparam/tree/main/servant-queryparam-core#readme) for more information. +extra-source-files:+  README.md+ source-repository head   type:     git   location: https://github.com/deemp/servant-queryparam@@ -21,8 +26,8 @@   default-language: GHC2021   ghc-options:      -Wall   exposed-modules:-    Servant.Record-    Servant.TypeLevel+    Servant.QueryParam.Record+    Servant.QueryParam.TypeLevel    hs-source-dirs:   src   build-depends:

@@ -0,0 +1,187 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- | This module provides functions and instances for working with query parameter records.+module Servant.QueryParam.Record (RecordParam, UnRecordParam) where++import Data.Kind+import Data.Proxy+import GHC.Generics+import GHC.TypeLits+import Servant.API+import Servant.QueryParam.TypeLevel++-- | 'RecordParam' uses fields in a record to represent query parameters.+--+-- For each record field:+--+-- - The modified record field name becomes a query parameter name.+-- - The record field type becomes the query parameter type.+--+-- For example, this API:+--+-- @+-- type API = "users" :> (QueryParam "category" Category :>+--                        QueryParam' '[Required, Strict] "sort_by" SortBy :>+--                        QueryFlag "with_schema" :>+--                        QueryParams "filters" Filter :>+--                        Get '[JSON] User)+-- @+--+-- can be written using records:+--+-- @+-- data DropPrefixExp :: sym -> 'Exp' sym+--+-- type instance 'Eval' (DropPrefixExp sym) = 'DropPrefix' sym+--+-- data UserParams = UserParams+--   { _userParams_category :: Maybe Category+--   , _userParams_sort_by :: SortBy+--   , _userParams_with_schema :: Bool+--   , _userParams_filters :: [Filter]+--   }+--+-- type API = "users" :> 'RecordParam' DropPrefixExp UserParams :> Get '[JSON] User+-- @+--+-- Here, @DropPrefixExp@ wraps a @sym@ into @Exp@.+--+-- The instance of 'Eval' for @DropPrefixExp sym@ drops the prefix of that @sym@ via 'DropPrefix'.+--+-- 'DropPrefix' is applied to the fields of @UserParams@.+--+-- The @"_userParams_category"@ record field corresponds to the query parameter @"category"@.+data RecordParam (mod :: Symbol -> Exp Symbol) (a :: Type)++-- | Append an element to a servant API+type family ServantAppend x y where+  ServantAppend (a :> b) c = a :> ServantAppend b c+  ServantAppend a c = a :> c++-- | Type family for rewriting a 'RecordParam' API to a regular @servant@ API.+-- This family is useful for defining instances of classes that extract information from the API type,+-- such as classes from @servant-swagger@ or @servant-foreign@.+--+-- Typical use:+--+-- @+-- instance SomeClass (UnRecordParam (RecordParam mod a :> api))) =>+--          SomeClass (RecordParam mod a :> api) where+--    someMethod _ = someMethod (Proxy :: Proxy (UnRecordParam (RecordParam mod a :> api))+-- @+type family UnRecordParam (mod :: Symbol -> Exp Symbol) (x :: Type) :: Type where+  UnRecordParam mod (a :> b) = ServantAppend (UnRecordParam mod a) b+  UnRecordParam mod (RecordParam mod a) = UnRecordParam mod (Rep a ())+  UnRecordParam mod (D1 m c d) = UnRecordParam mod (c d)+  UnRecordParam mod ((a :*: b) d) =+    ServantAppend+      (UnRecordParam mod (a d))+      (UnRecordParam mod (b d))+  UnRecordParam mod (C1 m a d) = UnRecordParam mod (a d)+  UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 Bool) d) =+    QueryFlag (Eval (mod sym))+  UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 [a]) d) =+    QueryParams (Eval (mod sym)) a+  UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 (Maybe a)) d) =+    QueryParam' [Optional, Strict] (Eval (mod sym)) a+  UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 a) d) =+    QueryParam' [Required, Strict] (Eval (mod sym)) a++instance (Generic a, GHasLink mod (Rep a) sub) => HasLink (RecordParam mod a :> sub) where+  type MkLink (RecordParam mod a :> sub) b = a -> MkLink sub b+  toLink toA _ l record = gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy sub) l (from record :: Rep a ())++data GParam (mod :: Symbol -> Exp Symbol) a++instance GHasLink mod a sub => HasLink (GParam mod (a ()) :> sub) where+  type MkLink (GParam mod (a ()) :> sub) b = a () -> MkLink sub b+  toLink toA _ = gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy sub)+  {-# INLINE toLink #-}++class HasLink sub => GHasLink (mod :: Symbol -> Exp Symbol) (a :: Type -> Type) sub where+  gToLink :: Proxy mod -> (Link -> b) -> Proxy sub -> Link -> a () -> MkLink sub b++instance GHasLink mod c sub => GHasLink mod (D1 m c) sub where+  gToLink _ toA _ l (M1 x) = gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy sub) l x+  {-# INLINE gToLink #-}++instance+  ( HasLink sub+  , GHasLink mod a (GParam mod (b ()) :> sub)+  ) =>+  GHasLink mod (a :*: b) sub+  where+  gToLink _ toA _ l (a :*: b) =+    gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy (GParam mod (b ()) :> sub)) l a b+  {-# INLINE gToLink #-}++instance+  ( GHasLink mod a sub+  , HasLink sub+  ) =>+  GHasLink mod (C1 m a) sub+  where+  gToLink _ toA _ l (M1 x) = gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy sub) l x+  {-# INLINE gToLink #-}++instance+  {-# OVERLAPPING #-}+  ( KnownSymbol sym+  , KnownSymbol (Eval (mod sym))+  , HasLink (sub :: Type)+  ) =>+  GHasLink mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 Bool)) sub+  where+  gToLink _ toA _ l (M1 (K1 x)) =+    toLink toA (Proxy :: Proxy (QueryFlag (Eval (mod sym)) :> sub)) l x+  {-# INLINE gToLink #-}++instance+  {-# OVERLAPPING #-}+  ( KnownSymbol sym+  , KnownSymbol (Eval (mod sym))+  , ToHttpApiData a+  , HasLink (a :> sub)+  , HasLink sub+  ) =>+  GHasLink mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 [a])) sub+  where+  gToLink _ toA _ l (M1 (K1 x)) =+    toLink toA (Proxy :: Proxy (QueryParams (Eval (mod sym)) a :> sub)) l x+  {-# INLINE gToLink #-}++instance+  {-# OVERLAPPING #-}+  ( KnownSymbol sym+  , KnownSymbol (Eval (mod sym))+  , ToHttpApiData a+  , HasLink (a :> sub)+  , HasLink sub+  ) =>+  GHasLink mod (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] (Eval (mod sym)) a :> sub)) l x+  {-# INLINE gToLink #-}++instance+  {-# OVERLAPPABLE #-}+  ( KnownSymbol sym+  , KnownSymbol (Eval (mod sym))+  , ToHttpApiData a+  , HasLink (a :> sub)+  , HasLink sub+  ) =>+  GHasLink mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 a)) sub+  where+  gToLink _ toA _ l (M1 (K1 x)) =+    toLink toA (Proxy :: Proxy (QueryParam' '[Required, Strict] (Eval (mod sym)) a :> sub)) l x+  {-# INLINE gToLink #-}

@@ -0,0 +1,113 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+-- |+-- This module provides functions to modify 'Symbol's and type-level lists.+--+-- The workflow to define a modification function can be as follows.+--+-- 1. Use 'ToList' to convert a 'Symbol' to a type-level list of 'Char's.+--+-- 1. Use functions from here and from the package [first-class-families](https://hackage.haskell.org/package/first-class-families) for type-level lists (@Fcf.Data.List@).+--+-- 1. Use 'FromList' to convert a type-level list of 'Char's back to a 'Symbol'.+--+-- Example (see 'DropPrefix'):+--+-- >>> :kind! DropPrefix "_userParams_category"+-- DropPrefix "_userParams_category" :: Symbol+-- = "category"+--+-- Modules that use the 'Eval' type family (e.g., "Servant.Record") must be imported together with modules that export instances of 'Eval'+-- (see the @GHC@ documentation on Type families).+module Servant.QueryParam.TypeLevel+  ( -- * Re-exports from @first-class-families@+    Eval,+    Exp,++    -- * List functions+    FromList,+    FromList1,+    ToList,+    ToList1,++    -- * Comparison functions+    TyEq,+    NotTyEq,++    -- * Examples+    DropUnderscores,+    DropNonUnderscores,+    DropPrefix,+  )+where++import Fcf+import Fcf.Data.List+import GHC.TypeLits++-- | Convert a 'Symbol' to a list of 'Char's.+type family ToList (sym :: Symbol) :: [Char] where+  ToList sym = ToList1 (UnconsSymbol sym)++-- | Convert a possibly unconsed 'Symbol' to a list of 'Char's.+type family ToList1 (sym :: Maybe (Char, Symbol)) :: [Char] where+  ToList1 'Nothing = '[]+  ToList1 ('Just '(c, sym)) = c : ToList1 (UnconsSymbol sym)++-- | Convert a list of 'Char's to a 'Symbol'.+--+-- >>> :kind! FromList ['a', '+', 'c']+-- FromList ['a', '+', 'c'] :: Symbol+-- = "a+c"+type family FromList (cs :: [Char]) :: Symbol where+  FromList cs = FromList1 (Eval (Reverse cs)) ""++-- | Convert a list of 'Char's to a 'Symbol'.+--+-- In this list, 'Chars' go in a reverse order.+--+-- >>> :kind! FromList1 ['a', 'b', 'c'] ""+-- FromList1 ['a', 'b', 'c'] "" :: Symbol+-- = "cba"+type family FromList1 (syms :: [Char]) (sym :: Symbol) :: Symbol where+  FromList1 '[] s = s+  FromList1 (x : xs) s = FromList1 xs (ConsSymbol x s)++-- $ lists++-- | Type inequality+data NotTyEq :: a -> b -> Exp Bool++type instance Eval (NotTyEq a b) = NotTyEqImpl a b++-- | Check types aren't equal+type family NotTyEqImpl (a :: k) (b :: k) :: Bool where+  NotTyEqImpl a a = 'False+  NotTyEqImpl a b = 'True++-- $ examples++-- | Drop leading underscores.+--+-- >>> :kind! Eval (DropUnderscores ['_', '_', 'a'])+-- Eval (DropUnderscores ['_', '_', 'a']) :: [Char]+-- = '['a']+type DropUnderscores = DropWhile (TyEq '_')++-- | Drop leading non-underscores.+--+-- >>> :kind! Eval (DropNonUnderscores ['a', 'a', '_'])+-- Eval (DropNonUnderscores ['a', 'a', '_']) :: [Char]+-- = '['_']+type DropNonUnderscores = DropWhile (NotTyEq '_')++-- | Drop the prefix of a 'Symbol'.+--+-- >>> :kind! DropPrefix "_userParams_category"+-- DropPrefix "_userParams_category" :: Symbol+-- = "category"+type family DropPrefix (sym :: Symbol) :: Symbol where+  DropPrefix sym = FromList (Eval (DropUnderscores (Eval (DropNonUnderscores (Eval (DropUnderscores (ToList sym)))))))

@@ -1,187 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}---- | This module provides functions and instances for working with query parameter records.-module Servant.Record (RecordParam, UnRecordParam) where--import Data.Kind-import Data.Proxy-import GHC.Generics-import GHC.TypeLits-import Servant.API-import Servant.TypeLevel---- | 'RecordParam' uses fields in a record to represent query parameters.------ For each record field:------ - The modified record field name becomes a query parameter name.--- - The record field type becomes the query parameter type.------ For example, this API:------ @--- type API = "users" :> (QueryParam "category" Category :>---                        QueryParam' '[Required, Strict] "sort_by" SortBy :>---                        QueryFlag "with_schema" :>---                        QueryParams "filters" Filter :>---                        Get '[JSON] User)--- @------ can be written using records:------ @--- data DropPrefixExp :: sym -> 'Exp' sym------ type instance 'Eval' (DropPrefixExp sym) = 'DropPrefix' sym------ data UserParams = UserParams---   { _userParams_category :: Maybe Category---   , _userParams_sort_by :: SortBy---   , _userParams_with_schema :: Bool---   , _userParams_filters :: [Filter]---   }------ type API = "users" :> 'RecordParam' DropPrefixExp UserParams :> Get '[JSON] User--- @------ Here, @DropPrefixExp@ wraps a @sym@ into @Exp@.------ The instance of 'Eval' for @DropPrefixExp sym@ drops the prefix of that @sym@ via 'DropPrefix'.------ 'DropPrefix' is applied to the fields of @UserParams@.------ The @"_userParams_category"@ record field corresponds to the query parameter @"category"@.-data RecordParam (mod :: Symbol -> Exp Symbol) (a :: Type)---- | Append an element to a servant API-type family ServantAppend x y where-  ServantAppend (a :> b) c = a :> ServantAppend b c-  ServantAppend a c = a :> c---- | Type family for rewriting a 'RecordParam' API to a regular @servant@ API.--- This family is useful for defining instances of classes that extract information from the API type,--- such as classes from @servant-swagger@ or @servant-foreign@.------ Typical use:------ @--- instance SomeClass (UnRecordParam (RecordParam mod a :> api))) =>---          SomeClass (RecordParam mod a :> api) where---    someMethod _ = someMethod (Proxy :: Proxy (UnRecordParam (RecordParam mod a :> api))--- @-type family UnRecordParam (mod :: Symbol -> Exp Symbol) (x :: Type) :: Type where-  UnRecordParam mod (a :> b) = ServantAppend (UnRecordParam mod a) b-  UnRecordParam mod (RecordParam mod a) = UnRecordParam mod (Rep a ())-  UnRecordParam mod (D1 m c d) = UnRecordParam mod (c d)-  UnRecordParam mod ((a :*: b) d) =-    ServantAppend-      (UnRecordParam mod (a d))-      (UnRecordParam mod (b d))-  UnRecordParam mod (C1 m a d) = UnRecordParam mod (a d)-  UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 Bool) d) =-    QueryFlag (Eval (mod sym))-  UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 [a]) d) =-    QueryParams (Eval (mod sym)) a-  UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 (Maybe a)) d) =-    QueryParam' [Optional, Strict] (Eval (mod sym)) a-  UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 a) d) =-    QueryParam' [Required, Strict] (Eval (mod sym)) a--instance (Generic a, GHasLink mod (Rep a) sub) => HasLink (RecordParam mod a :> sub) where-  type MkLink (RecordParam mod a :> sub) b = a -> MkLink sub b-  toLink toA _ l record = gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy sub) l (from record :: Rep a ())--data GParam (mod :: Symbol -> Exp Symbol) a--instance GHasLink mod a sub => HasLink (GParam mod (a ()) :> sub) where-  type MkLink (GParam mod (a ()) :> sub) b = a () -> MkLink sub b-  toLink toA _ = gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy sub)-  {-# INLINE toLink #-}--class HasLink sub => GHasLink (mod :: Symbol -> Exp Symbol) (a :: Type -> Type) sub where-  gToLink :: Proxy mod -> (Link -> b) -> Proxy sub -> Link -> a () -> MkLink sub b--instance GHasLink mod c sub => GHasLink mod (D1 m c) sub where-  gToLink _ toA _ l (M1 x) = gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy sub) l x-  {-# INLINE gToLink #-}--instance-  ( HasLink sub-  , GHasLink mod a (GParam mod (b ()) :> sub)-  ) =>-  GHasLink mod (a :*: b) sub-  where-  gToLink _ toA _ l (a :*: b) =-    gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy (GParam mod (b ()) :> sub)) l a b-  {-# INLINE gToLink #-}--instance-  ( GHasLink mod a sub-  , HasLink sub-  ) =>-  GHasLink mod (C1 m a) sub-  where-  gToLink _ toA _ l (M1 x) = gToLink (Proxy :: Proxy mod) toA (Proxy :: Proxy sub) l x-  {-# INLINE gToLink #-}--instance-  {-# OVERLAPPING #-}-  ( KnownSymbol sym-  , KnownSymbol (Eval (mod sym))-  , HasLink (sub :: Type)-  ) =>-  GHasLink mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 Bool)) sub-  where-  gToLink _ toA _ l (M1 (K1 x)) =-    toLink toA (Proxy :: Proxy (QueryFlag (Eval (mod sym)) :> sub)) l x-  {-# INLINE gToLink #-}--instance-  {-# OVERLAPPING #-}-  ( KnownSymbol sym-  , KnownSymbol (Eval (mod sym))-  , ToHttpApiData a-  , HasLink (a :> sub)-  , HasLink sub-  ) =>-  GHasLink mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 [a])) sub-  where-  gToLink _ toA _ l (M1 (K1 x)) =-    toLink toA (Proxy :: Proxy (QueryParams (Eval (mod sym)) a :> sub)) l x-  {-# INLINE gToLink #-}--instance-  {-# OVERLAPPING #-}-  ( KnownSymbol sym-  , KnownSymbol (Eval (mod sym))-  , ToHttpApiData a-  , HasLink (a :> sub)-  , HasLink sub-  ) =>-  GHasLink mod (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] (Eval (mod sym)) a :> sub)) l x-  {-# INLINE gToLink #-}--instance-  {-# OVERLAPPABLE #-}-  ( KnownSymbol sym-  , KnownSymbol (Eval (mod sym))-  , ToHttpApiData a-  , HasLink (a :> sub)-  , HasLink sub-  ) =>-  GHasLink mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 a)) sub-  where-  gToLink _ toA _ l (M1 (K1 x)) =-    toLink toA (Proxy :: Proxy (QueryParam' '[Required, Strict] (Eval (mod sym)) a :> sub)) l x-  {-# INLINE gToLink #-}

@@ -1,113 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE PolyKinds #-}--- |--- This module provides functions to modify 'Symbol's and type-level lists.------ The workflow to define a modification function can be as follows.------ 1. Use 'ToList' to convert a 'Symbol' to a type-level list of 'Char's.------ 1. Use functions from here and from the package [first-class-families](https://hackage.haskell.org/package/first-class-families) for type-level lists (@Fcf.Data.List@).------ 1. Use 'FromList' to convert a type-level list of 'Char's back to a 'Symbol'.------ Example (see 'DropPrefix'):------ >>> :kind! DropPrefix "_userParams_category"--- DropPrefix "_userParams_category" :: Symbol--- = "category"------ Modules that use the 'Eval' type family (e.g., "Servant.Record") must be imported together with modules that export instances of 'Eval'--- (see the @GHC@ documentation on Type families).-module Servant.TypeLevel-  ( -- * Re-exports from @first-class-families@-    Eval,-    Exp,--    -- * List functions-    FromList,-    FromList1,-    ToList,-    ToList1,--    -- * Comparison functions-    TyEq,-    NotTyEq,--    -- * Examples-    DropUnderscores,-    DropNonUnderscores,-    DropPrefix,-  )-where--import Fcf-import Fcf.Data.List-import GHC.TypeLits---- | Convert a 'Symbol' to a list of 'Char's.-type family ToList (sym :: Symbol) :: [Char] where-  ToList sym = ToList1 (UnconsSymbol sym)---- | Convert a possibly unconsed 'Symbol' to a list of 'Char's.-type family ToList1 (sym :: Maybe (Char, Symbol)) :: [Char] where-  ToList1 'Nothing = '[]-  ToList1 ('Just '(c, sym)) = c : ToList1 (UnconsSymbol sym)---- | Convert a list of 'Char's to a 'Symbol'.------ >>> :kind! FromList ['a', '+', 'c']--- FromList ['a', '+', 'c'] :: Symbol--- = "a+c"-type family FromList (cs :: [Char]) :: Symbol where-  FromList cs = FromList1 (Eval (Reverse cs)) ""---- | Convert a list of 'Char's to a 'Symbol'.------ In this list, 'Chars' go in a reverse order.------ >>> :kind! FromList1 ['a', 'b', 'c'] ""--- FromList1 ['a', 'b', 'c'] "" :: Symbol--- = "cba"-type family FromList1 (syms :: [Char]) (sym :: Symbol) :: Symbol where-  FromList1 '[] s = s-  FromList1 (x : xs) s = FromList1 xs (ConsSymbol x s)---- $ lists---- | Type inequality-data NotTyEq :: a -> b -> Exp Bool--type instance Eval (NotTyEq a b) = NotTyEqImpl a b---- | Check types aren't equal-type family NotTyEqImpl (a :: k) (b :: k) :: Bool where-  NotTyEqImpl a a = 'False-  NotTyEqImpl a b = 'True---- $ examples---- | Drop leading underscores.------ >>> :kind! Eval (DropUnderscores ['_', '_', 'a'])--- Eval (DropUnderscores ['_', '_', 'a']) :: [Char]--- = '['a']-type DropUnderscores = DropWhile (TyEq '_')---- | Drop leading non-underscores.------ >>> :kind! Eval (DropNonUnderscores ['a', 'a', '_'])--- Eval (DropNonUnderscores ['a', 'a', '_']) :: [Char]--- = '['_']-type DropNonUnderscores = DropWhile (NotTyEq '_')---- | Drop the prefix of a 'Symbol'.------ >>> :kind! DropPrefix "_userParams_category"--- DropPrefix "_userParams_category" :: Symbol--- = "category"-type family DropPrefix (sym :: Symbol) :: Symbol where-  DropPrefix sym = FromList (Eval (DropUnderscores (Eval (DropNonUnderscores (Eval (DropUnderscores (ToList sym)))))))