diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..f630550 --- /dev/null +++ b/cabal.project @@ -0,0 +1,3 @@ +packages: + ./servant-util + ./servant-util-beam-pg diff --git a/servant-util/CHANGES.md b/servant-util/CHANGES.md index 6c0cf40..b3f8365 100644 --- a/servant-util/CHANGES.md +++ b/servant-util/CHANGES.md @@ -1,6 +1,8 @@ Unreleased ===== +* Added support for building the project with `servant` version >= 0.19. + 0.3 === diff --git a/servant-util/package.yaml b/servant-util/package.yaml index ddcd85f..867ea49 100644 --- a/servant-util/package.yaml +++ b/servant-util/package.yaml @@ -9,6 +9,7 @@ category: Servant, Web dependencies: - aeson - base >= 4.7 && < 5 +- bytestring - constraints - containers - data-default diff --git a/servant-util/servant-util.cabal b/servant-util/servant-util.cabal index 419bbaa..c32ea4e 100644 --- a/servant-util/servant-util.cabal +++ b/servant-util/servant-util.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: f0ae0577e7cde4002a074bd5fada6d918ea3dc45baee134d38fa8e002ad66d9f +-- hash: 16c019b25a3f668898f483828ea8a0de802a4155bb4601f08b6fe4e095358e04 name: servant-util version: 0.3 @@ -111,6 +111,7 @@ library QuickCheck , aeson , base >=4.7 && <5 + , bytestring , constraints , containers , data-default @@ -187,6 +188,7 @@ executable servant-util-examples QuickCheck , aeson , base >=4.7 && <5 + , bytestring , constraints , containers , data-default @@ -275,6 +277,7 @@ test-suite servant-util-test QuickCheck , aeson , base >=4.7 && <5 + , bytestring , constraints , containers , data-default diff --git a/servant-util/src/Servant/Util/Combinators/Filtering/Base.hs b/servant-util/src/Servant/Util/Combinators/Filtering/Base.hs index e4768e0..4436013 100644 --- a/servant-util/src/Servant/Util/Combinators/Filtering/Base.hs +++ b/servant-util/src/Servant/Util/Combinators/Filtering/Base.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeInType #-} @@ -20,8 +21,10 @@ module Servant.Util.Combinators.Filtering.Base , AreAutoFilters (..) , FilteringValueParser (..) , OpsDescriptions + , EncodedQueryParam , parseFilteringValueAsIs , unsupportedFilteringValue + , encodeQueryParam , autoFiltersParsers , FilteringParamTypesOf @@ -37,6 +40,10 @@ import Fmt (Buildable (..), Builder) 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,6 +97,18 @@ unsupportedFilteringValue errMsg = FilteringValueParser (\_ -> Left errMsg) -- 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 @@ -112,7 +131,7 @@ class (Typeable filter, BuildableAutoFilter filter) => -- | Encode a filter to query parameter value. autoFilterEncode :: ToHttpApiData a - => filter a -> (Text, Text) + => filter a -> (Text, EncodedQueryParam) mapAutoFilterValue :: (a -> b) -> filter a -> filter b diff --git a/servant-util/src/Servant/Util/Combinators/Filtering/Client.hs b/servant-util/src/Servant/Util/Combinators/Filtering/Client.hs index a298029..00820f4 100644 --- a/servant-util/src/Servant/Util/Combinators/Filtering/Client.hs +++ b/servant-util/src/Servant/Util/Combinators/Filtering/Client.hs @@ -6,7 +6,7 @@ import Universum hiding (filter) 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 @@ import Servant.Util.Common ------------------------------------------------------------------------- -- | 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 diff --git a/servant-util/src/Servant/Util/Combinators/Filtering/Filters/General.hs b/servant-util/src/Servant/Util/Combinators/Filtering/Filters/General.hs index 231c8ff..e8d5eaf 100644 --- a/servant-util/src/Servant/Util/Combinators/Filtering/Filters/General.hs +++ b/servant-util/src/Servant/Util/Combinators/Filtering/Filters/General.hs @@ -10,7 +10,7 @@ import Universum 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 @@ instance IsAutoFilter FilterMatching where 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 @@ instance IsAutoFilter FilterComparing where ] 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) ------------------------------------------------------------------------- diff --git a/servant-util/src/Servant/Util/Combinators/Filtering/Filters/Like.hs b/servant-util/src/Servant/Util/Combinators/Filtering/Filters/Like.hs index 3b6b745..41315ba 100644 --- a/servant-util/src/Servant/Util/Combinators/Filtering/Filters/Like.hs +++ b/servant-util/src/Servant/Util/Combinators/Filtering/Filters/Like.hs @@ -15,7 +15,7 @@ import Universum 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 @@ instance IsAutoFilter FilterLike where autoFilterEncode = \case FilterLike cs (unLikePattern -> pat) | CaseSensitivity True <- cs - -> ("like", toQueryParam pat) + -> ("like", encodeQueryParam pat) | otherwise - -> ("ilike", toQueryParam pat) + -> ("ilike", encodeQueryParam pat) diff --git a/servant-util/src/Servant/Util/Combinators/Sorting/Construction.hs b/servant-util/src/Servant/Util/Combinators/Sorting/Construction.hs index c0dd9f7..fec2ffd 100644 --- a/servant-util/src/Servant/Util/Combinators/Sorting/Construction.hs +++ b/servant-util/src/Servant/Util/Combinators/Sorting/Construction.hs @@ -11,7 +11,8 @@ module Servant.Util.Combinators.Sorting.Construction 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 @@ sortingSpec = mkSortingSpec [asc #id] 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