packages feed

servant-queryparam-core (empty) → 0.0.1

raw patch · 3 files changed

+331/−0 lines, 3 filesdep +basedep +first-class-familiesdep +servant

Dependencies added: base, first-class-families, servant

Files

+ servant-queryparam-core.cabal view
@@ -0,0 +1,31 @@+cabal-version: 2.2+name:          servant-queryparam-core+synopsis:      Use records for query parameters in servant APIs.+version:       0.0.1+maintainer:    Danila Danko <https://github.com/deemp>+author:        Kristof Bastiaensen+copyright:     Kristof Bastiaensen 2020+license:       BSD-3-Clause+build-type:    Simple+category:      Servant, Web+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.++source-repository head+  type:     git+  location: https://github.com/deemp/servant-queryparam++library+  default-language: GHC2021+  ghc-options:      -Wall+  exposed-modules:+    Servant.Record+    Servant.TypeLevel++  hs-source-dirs:   src+  build-depends:+    , base                  >=4.16    && <5+    , first-class-families  >=0.8.0.0+    , servant               >=0.19
+ src/Servant/Record.hs view
@@ -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.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 #-}
+ src/Servant/TypeLevel.hs view
@@ -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.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)))))))