Merge pull request #40 from marinelli/servant-0.19

Add servant 0.19 support to servant-util

Author: Martoon-00

cabal.project

@@ -0,0 +1,3 @@
+packages:
+  ./servant-util
+  ./servant-util-beam-pg

servant-util/CHANGES.md

@@ -1,6 +1,8 @@
 Unreleased
 =====
 
+* Added support for building the project with `servant` version >= 0.19.
+
 0.3
 ===
 

servant-util/package.yaml

@@ -9,6 +9,7 @@ category:            Servant, Web
 dependencies:
 - aeson
 - base >= 4.7 && < 5
+- bytestring
 - constraints
 - containers
 - data-default

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

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

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

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)
 
 
 -------------------------------------------------------------------------

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)

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