Skip to content

Add servant 0.19 support to servant-util #40

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 8 commits into from
May 20, 2022
Merged

Add servant 0.19 support to servant-util #40

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
0a6a41d
Fix build with servant v0.19
marinelli Feb 25, 2022
5ccce73
Properly encode query parameter
marinelli Feb 28, 2022
d361806
Remove extra import
marinelli Feb 28, 2022
f7b494b
Small refactoring
marinelli Mar 1, 2022
862fec2
Add cabal.project file
marinelli May 19, 2022
3b29e86
Upgrade package.yaml files and regenerate cabal files
marinelli May 19, 2022
814fb12
Fix build with universum-1.7.3
marinelli May 19, 2022
69c3a3e
Update servant-util/CHANGES.md
marinelli May 20, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions cabal.project
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
packages:
./servant-util
./servant-util-beam-pg
2 changes: 2 additions & 0 deletions servant-util/CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
Unreleased
=====

* Added support for building the project with `servant` version >= 0.19.

0.3
===

Expand Down
1 change: 1 addition & 0 deletions servant-util/package.yaml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ category: Servant, Web
dependencies:
- aeson
- base >= 4.7 && < 5
- bytestring
- constraints
- containers
- data-default
Expand Down
5 changes: 4 additions & 1 deletion servant-util/servant-util.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: f0ae0577e7cde4002a074bd5fada6d918ea3dc45baee134d38fa8e002ad66d9f
-- hash: 16c019b25a3f668898f483828ea8a0de802a4155bb4601f08b6fe4e095358e04

name: servant-util
version: 0.3
Expand Down Expand Up @@ -111,6 +111,7 @@ library
QuickCheck
, aeson
, base >=4.7 && <5
, bytestring
, constraints
, containers
, data-default
Expand Down Expand Up @@ -187,6 +188,7 @@ executable servant-util-examples
QuickCheck
, aeson
, base >=4.7 && <5
, bytestring
, constraints
, containers
, data-default
Expand Down Expand Up @@ -275,6 +277,7 @@ test-suite servant-util-test
QuickCheck
, aeson
, base >=4.7 && <5
, bytestring
, constraints
, containers
, data-default
Expand Down
21 changes: 20 additions & 1 deletion servant-util/src/Servant/Util/Combinators/Filtering/Base.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeInType #-}

Expand All @@ -20,8 +21,10 @@ module Servant.Util.Combinators.Filtering.Base
, AreAutoFilters (..)
, FilteringValueParser (..)
, OpsDescriptions
, EncodedQueryParam
, parseFilteringValueAsIs
, unsupportedFilteringValue
, encodeQueryParam
, autoFiltersParsers

, FilteringParamTypesOf
Expand All @@ -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

Expand Down Expand Up @@ -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
Copy link

@treeowl treeowl Mar 1, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This seems really awkward. How bad would it be to bump the dependency version?

Copy link
Contributor Author

@marinelli marinelli Mar 1, 2022 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I do not like this solution too. If supporting servant 0.18 is not required, let's remove it.
Btw, I'll create an other PR to export encodeQueryParam from the servant-client-core package.
Since this haskell-servant/servant#1549, it would not be required anymore to add the encodeQueryParam function, it might be used the encodeQueryParamValue function.

Copy link
Contributor Author

@marinelli marinelli Mar 10, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Did you were thinking something like this marinelli@a0dbeeb?

Copy link
Contributor Author

@marinelli marinelli Mar 14, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@Martoon-00 what do you think about it?

Copy link
Member

@Martoon-00 Martoon-00 May 18, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I apologize for the late reply 🙏 🙏

I don't like such tricks with CPP pragmas too, but in this case its scope is sufficiently limited and it seems like the least evil to me.

Let's go with the current solution to leave others some time if they need a recent feature of servant-util but cannot afford to switch to the servant-0.19. And after a couple of major releases of servant, or if this CPP turns out to hinder other features, we will strip the old behaviour.

I also asked our OPS team to make CI run both the old and new versions of servant-client-core (internal ticket for this).

@marinelli You are also very welcome to start using haskell-servant/servant#1549 here as soon as it appears in a release. Just leave a note in the changelog that we do not support servant-0.19, rather only < 0.19 and >= 0.19.X.

Thanks a lot for your work!

Copy link
Contributor Author

@marinelli marinelli May 19, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not sure anymore that re-exporting encodeQueryParamValue from servant-client-core is a good idea :)
We'll see.


-- | How auto filters appear in logging.
class BuildableAutoFilter (filter :: Type -> Type) where
buildAutoFilter
Expand All @@ -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
Expand Down
6 changes: 3 additions & 3 deletions servant-util/src/Servant/Util/Combinators/Filtering/Client.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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
Expand Down
20 changes: 11 additions & 9 deletions servant-util/src/Servant/Util/Combinators/Filtering/Filters/General.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)


-------------------------------------------------------------------------
Expand Down
6 changes: 3 additions & 3 deletions servant-util/src/Servant/Util/Combinators/Filtering/Filters/Like.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
5 changes: 3 additions & 2 deletions servant-util/src/Servant/Util/Combinators/Sorting/Construction.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down