servant-util 0.3 → 0.4
raw patch · 8 files changed
+72/−43 lines, 8 filesdep +bytestring
Dependencies added: bytestring
Files
- CHANGES.md +4/−0
- servant-util.cabal +5/−4
- src/Servant/Util/Combinators/Filtering/Base.hs +22/−9
- src/Servant/Util/Combinators/Filtering/Client.hs +3/−3
- src/Servant/Util/Combinators/Filtering/Construction.hs +21/−13
- src/Servant/Util/Combinators/Filtering/Filters/General.hs +11/−9
- src/Servant/Util/Combinators/Filtering/Filters/Like.hs +3/−3
- src/Servant/Util/Combinators/Sorting/Construction.hs +3/−2
CHANGES.md view
@@ -1,6 +1,10 @@ Unreleased ===== +* Replaced `mapAutoFilterValue` in `IsAutoFilter` typeclass with `Functor` superclass.+* Exposed `MkSomeFilter` constraint.+* Added support for building the project with `servant` version >= 0.19.+ 0.3 ===
servant-util.cabal view
@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.6.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: f0ae0577e7cde4002a074bd5fada6d918ea3dc45baee134d38fa8e002ad66d9f name: servant-util-version: 0.3+version: 0.4 synopsis: Servant servers utilities. description: Basement for common Servant combinators like filtering, sorting, pagination and semantical logging. category: Servant, Web@@ -111,6 +109,7 @@ QuickCheck , aeson , base >=4.7 && <5+ , bytestring , constraints , containers , data-default@@ -187,6 +186,7 @@ QuickCheck , aeson , base >=4.7 && <5+ , bytestring , constraints , containers , data-default@@ -275,6 +275,7 @@ QuickCheck , aeson , base >=4.7 && <5+ , bytestring , constraints , containers , data-default
src/Servant/Util/Combinators/Filtering/Base.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeInType #-} @@ -20,8 +21,10 @@ , AreAutoFilters (..) , FilteringValueParser (..) , OpsDescriptions+ , EncodedQueryParam , parseFilteringValueAsIs , unsupportedFilteringValue+ , encodeQueryParam , autoFiltersParsers , FilteringParamTypesOf@@ -37,6 +40,10 @@ import GHC.Exts (IsList) import Servant (FromHttpApiData (..), ToHttpApiData (..)) import Servant.API (NoContent)+#if MIN_VERSION_servant(0,19,0)+import Data.ByteString.Builder (toLazyByteString)+import qualified Data.ByteString.Lazy as BL+#endif import Servant.Util.Common @@ -90,13 +97,25 @@ -- This is not a 'Map' to prevent developer-defined entries order. type OpsDescriptions = [(Text, Text)] +-- | Specify the encoding type and function for query parameters.+-- It's required due to this https://github.com/haskell-servant/servant/pull/1432+#if MIN_VERSION_servant(0,19,0)+type EncodedQueryParam = ByteString+encodeQueryParam :: ToHttpApiData a => a -> EncodedQueryParam+encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece+#else+type EncodedQueryParam = Text+encodeQueryParam :: ToHttpApiData a => a -> EncodedQueryParam+encodeQueryParam = toQueryParam+#endif+ -- | How auto filters appear in logging. class BuildableAutoFilter (filter :: Type -> Type) where buildAutoFilter :: Buildable a => Text -> filter a -> Builder -- | Application of a filter type to Servant API.-class (Typeable filter, BuildableAutoFilter filter) =>+class (Typeable filter, Functor filter, BuildableAutoFilter filter) => IsAutoFilter (filter :: Type -> Type) where -- | For each supported filtering operation specifies a short plain-english@@ -112,13 +131,7 @@ -- | Encode a filter to query parameter value. autoFilterEncode :: ToHttpApiData a- => filter a -> (Text, Text)-- mapAutoFilterValue- :: (a -> b) -> filter a -> filter b- default mapAutoFilterValue- :: Functor filter => (a -> b) -> filter a -> filter b- mapAutoFilterValue = fmap+ => filter a -> (Text, EncodedQueryParam) -- | Multi-version of 'IsFilter'. class AreAutoFilters (filters :: [Type -> Type]) where@@ -152,7 +165,7 @@ forall filter. IsAutoFilter filter => SomeTypeAutoFilter (filter a) instance Functor SomeTypeAutoFilter where- fmap f (SomeTypeAutoFilter filtr) = SomeTypeAutoFilter (mapAutoFilterValue f filtr)+ fmap f (SomeTypeAutoFilter filtr) = SomeTypeAutoFilter (fmap f filtr) instance Buildable a => Buildable (Text, SomeTypeAutoFilter a) where build (name, SomeTypeAutoFilter f) = buildAutoFilter name f
src/Servant/Util/Combinators/Filtering/Client.hs view
@@ -6,7 +6,7 @@ import Data.Typeable (cast) import GHC.TypeLits (KnownSymbol)-import Servant (ToHttpApiData (..), toQueryParam, (:>))+import Servant (ToHttpApiData (..), (:>)) import Servant.Client (HasClient (..)) import Servant.Client.Core.Request (Request, appendToQueryString) @@ -19,10 +19,10 @@ ------------------------------------------------------------------------- -- | For given filter return operation name and encoded value.-typeFilterToReq :: ToHttpApiData a => TypeFilter fk a -> (Text, Text)+typeFilterToReq :: ToHttpApiData a => TypeFilter fk a -> (Text, EncodedQueryParam) typeFilterToReq = \case TypeAutoFilter (SomeTypeAutoFilter filter) -> autoFilterEncode filter- TypeManualFilter val -> (DefFilteringCmd, toQueryParam val)+ TypeManualFilter val -> (DefFilteringCmd, encodeQueryParam val) -- | Apply filter to a client request being built. class SomeFilterToReq params where
src/Servant/Util/Combinators/Filtering/Construction.hs view
@@ -7,6 +7,8 @@ module Servant.Util.Combinators.Filtering.Construction ( noFilters , mkFilteringSpec++ , MkSomeFilter , (?/) , (?/=) , (?/<)@@ -90,33 +92,39 @@ mkTypeFilter = TypeManualFilter -- | Safely construct 'SomeFilter'.-class MkSomeFilter name filter (origParams :: [TyNamedFilter]) (params :: [TyNamedFilter]) where+class MkSomeFilter' name filter (origParams :: [TyNamedFilter]) (params :: [TyNamedFilter]) where mkSomeFilter :: filter -> SomeFilter params instance TypeError ('Text "Unknown filter " ':<>: 'ShowType name ':$$: 'Text "Allowed ones here: " ':<>: 'ShowType (TyNamedParamsNames origParams)) =>- MkSomeFilter name filter origParams '[] where+ MkSomeFilter' name filter origParams '[] where mkSomeFilter = error ":shrug:" instance {-# OVERLAPPING #-} (MkTypeFilter filter fk a, KnownSymbol name, Typeable fk, Typeable a) =>- MkSomeFilter name filter origParams ('TyNamedParam name (fk a) ': params) where+ MkSomeFilter' name filter origParams ('TyNamedParam name (fk a) ': params) where mkSomeFilter filter = SomeFilter { sfName = symbolValT @name , sfFilter = mkTypeFilter @filter @fk @a filter } -instance MkSomeFilter name filter origParams params =>- MkSomeFilter name filter origParams (param ': params) where+instance MkSomeFilter' name filter origParams params =>+ MkSomeFilter' name filter origParams (param ': params) where mkSomeFilter filter = coerce $ mkSomeFilter @name @filter @origParams @params filter +-- | A constraint required by smart filter constructors based on '?/' operator.+--+-- This constraint is satisfied when @SomeFilter params@ allows a filter of type+-- @filter@ under the name @name@.+type MkSomeFilter name filter params = MkSomeFilter' name filter params params+ -- | "Filter by" operation. -- Wraps a filter corresponding to the given name into 'SomeFilter' which can later be -- passed to 'mkSomeFilter'. (?/) :: forall name params filter.- MkSomeFilter name filter params params+ MkSomeFilter name filter params => NameLabel name -> filter -> SomeFilter params (?/) _ = mkSomeFilter @name @_ @params infixr 0 ?/@@ -124,7 +132,7 @@ -- | "Filter by matching" operation. (?/=) :: forall name params filter.- MkSomeFilter name (FilterMatching filter) params params+ MkSomeFilter name (FilterMatching filter) params => NameLabel name -> filter -> SomeFilter params l ?/= f = l ?/ FilterMatching f infixr 0 ?/=@@ -132,7 +140,7 @@ -- | Make a comparing filter. (?/>), (?/<), (?/>=), (?/<=) :: forall name params filter.- MkSomeFilter name (FilterComparing filter) params params+ MkSomeFilter name (FilterComparing filter) params => NameLabel name -> filter -> SomeFilter params l ?/> f = l ?/ FilterGT f l ?/< f = l ?/ FilterLT f@@ -146,7 +154,7 @@ -- | Make a simple POSIX regex filter. textLike :: forall name params text.- (MkSomeFilter name (FilterLike text) params params, HasCallStack)+ (MkSomeFilter name (FilterLike text) params, HasCallStack) => NameLabel name -> LText -> SomeFilter params l `textLike` p = l ?/ FilterLike @text (CaseSensitivity True) (mkLikePatternUnsafe p) infixr 0 `textLike`@@ -154,7 +162,7 @@ -- | Make a simple POSIX regex case-insensitive filter. textILike :: forall name params text.- (MkSomeFilter name (FilterLike text) params params, HasCallStack)+ (MkSomeFilter name (FilterLike text) params, HasCallStack) => NameLabel name -> LText -> SomeFilter params l `textILike` p = l ?/ FilterLike @text (CaseSensitivity False) (mkLikePatternUnsafe p) infixr 0 `textILike`@@ -162,7 +170,7 @@ -- | Make a filter that checks whether the given text is included. textContains :: forall name params text.- MkSomeFilter name (FilterLike text) params params+ MkSomeFilter name (FilterLike text) params => NameLabel name -> Text -> SomeFilter params l `textContains` p = l ?/ filterContains @text (CaseSensitivity True) p infixr 0 `textContains`@@ -171,7 +179,7 @@ -- case-insensitive. textIContains :: forall name params text.- MkSomeFilter name (FilterLike text) params params+ MkSomeFilter name (FilterLike text) params => NameLabel name -> Text -> SomeFilter params l `textIContains` p = l ?/ filterContains @text (CaseSensitivity False) p infixr 0 `textIContains`@@ -180,7 +188,7 @@ -- Helpful when newtypes are heavely used in API parameters. (?/~) :: forall name filter' params filter.- (MkSomeFilter name filter' params params, Coercible filter filter')+ (MkSomeFilter name filter' params, Coercible filter filter') => NameLabel name -> filter -> SomeFilter params l ?/~ f = l ?/ coerce @_ @filter' f
src/Servant/Util/Combinators/Filtering/Filters/General.hs view
@@ -10,7 +10,7 @@ import qualified Data.Map as M import qualified Data.Text as T import Fmt (build, listF)-import Servant (FromHttpApiData (..), ToHttpApiData (..))+import Servant (FromHttpApiData (..)) import Servant.Util.Combinators.Filtering.Base @@ -57,10 +57,12 @@ mapM parseUrlPiece vals autoFilterEncode = \case- FilterMatching v -> (DefFilteringCmd, toQueryParam v)- FilterNotMatching v -> ("neq", toQueryParam v)- FilterItemsIn vs -> ("in", "[" <> T.intercalate "," (map toQueryParam vs) <> "]")-+ FilterMatching v -> (DefFilteringCmd, encodeQueryParam v)+ FilterNotMatching v -> ("neq", encodeQueryParam v)+ FilterItemsIn vs -> ("in", encodeFilterItems vs)+ where+ encodeFilterItems vs =+ "[" <> mconcat (intersperse "," $ map encodeQueryParam vs) <> "]" -- | Support for @(<)@, @(>)@, @(<=)@ and @(>=)@ operations. data FilterComparing a@@ -101,10 +103,10 @@ ] autoFilterEncode = \case- FilterGT v -> ("gt", toQueryParam v)- FilterLT v -> ("lt", toQueryParam v)- FilterGTE v -> ("gte", toQueryParam v)- FilterLTE v -> ("lte", toQueryParam v)+ FilterGT v -> ("gt", encodeQueryParam v)+ FilterLT v -> ("lt", encodeQueryParam v)+ FilterGTE v -> ("gte", encodeQueryParam v)+ FilterLTE v -> ("lte", encodeQueryParam v) -------------------------------------------------------------------------
src/Servant/Util/Combinators/Filtering/Filters/Like.hs view
@@ -15,7 +15,7 @@ import qualified Data.Map as M import qualified Data.Text.Lazy as LT import Fmt (Buildable (..), (+|), (|+))-import Servant (FromHttpApiData (..), ToHttpApiData (..))+import Servant (FromHttpApiData (..)) import System.Console.Pretty (Color (..), Style (..), color, style) import Servant.Util.Combinators.Filtering.Base@@ -117,6 +117,6 @@ autoFilterEncode = \case FilterLike cs (unLikePattern -> pat) | CaseSensitivity True <- cs- -> ("like", toQueryParam pat)+ -> ("like", encodeQueryParam pat) | otherwise- -> ("ilike", toQueryParam pat)+ -> ("ilike", encodeQueryParam pat)
src/Servant/Util/Combinators/Sorting/Construction.hs view
@@ -11,7 +11,8 @@ import Universum import Data.Default (Default (..))-import GHC.Exts (IsList (..))+import qualified GHC.Exts+import GHC.Exts (IsList) import GHC.TypeLits (ErrorMessage (..), KnownSymbol, Symbol, TypeError) import Servant.Util.Combinators.Sorting.Base@@ -79,7 +80,7 @@ mkSortingSpec :: ReifySortingItems base => [SortingRequestItem provided] -> SortingSpec provided base-mkSortingSpec = fromList+mkSortingSpec = GHC.Exts.fromList -- | By default 'noSorting' is used. instance ReifySortingItems base => Default (SortingSpec provided base) where