Merge pull request #120 from fizruk/toEncodedQueryParam

Add toEncodedQueryParam

Author: fizruk

CHANGELOG.md

@@ -1,3 +1,10 @@
+0.5.1
+-----
+
+* Add `toEncodedQueryParam` to `ToHttpApiData` type class. It has default
+  implementation using `toQueryParam`, but may be overriden with more efficient
+  one.
+
 0.5
 ---
 

http-api-data.cabal

@@ -1,7 +1,6 @@
 cabal-version:   >= 1.10
 name:            http-api-data
-version:         0.5
-x-revision:      1
+version:         0.5.1
 
 synopsis:        Converting to/from HTTP API data like URL pieces, headers and query parameters.
 category:        Web

src/Web/Internal/HttpApiData.hs

@@ -93,10 +93,10 @@ class ToHttpApiData a where
   toUrlPiece = toQueryParam
 
   -- | Convert to a URL path piece, making sure to encode any special chars.
-  -- The default definition uses 'H.encodePathSegmentsRelative',
+  -- The default definition uses @'H.urlEncodeBuilder' 'False'@
   -- but this may be overriden with a more efficient version.
   toEncodedUrlPiece :: a -> BS.Builder
-  toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece
+  toEncodedUrlPiece = H.urlEncodeBuilder False . encodeUtf8 . toUrlPiece
 
   -- | Convert to HTTP header value.
   toHeader :: a -> ByteString
@@ -106,6 +106,14 @@ class ToHttpApiData a where
   toQueryParam :: a -> Text
   toQueryParam = toUrlPiece
 
+  -- | Convert to URL query param,
+  -- The default definition uses @'H.urlEncodeBuilder' 'True'@
+  -- but this may be overriden with a more efficient version.
+  --
+  -- @since 0.5.1
+  toEncodedQueryParam :: a -> BS.Builder
+  toEncodedQueryParam = H.urlEncodeBuilder True . encodeUtf8 . toQueryParam
+
 -- | Parse value from HTTP API data.
 --
 -- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated
@@ -422,12 +430,21 @@ parseBounded reader input = do
 unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder
 unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece
 
+-- | Convert to a URL-encoded query param using 'toQueryParam'.
+-- /Note/: this function does not check if the result contains unescaped characters!
+--
+-- @since 0.5.1
+unsafeToEncodedQueryParam :: ToHttpApiData a => a -> BS.Builder
+unsafeToEncodedQueryParam = BS.byteString . encodeUtf8 . toQueryParam
+
 -- |
 -- >>> toUrlPiece ()
 -- "_"
 instance ToHttpApiData () where
-  toUrlPiece () = "_"
-  toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  toUrlPiece _          = "_"
+  toHeader _            = "_"
+  toEncodedUrlPiece _   = "_"
+  toEncodedQueryParam _ = "_"
 
 instance ToHttpApiData Char where
   toUrlPiece = T.singleton
@@ -438,36 +455,38 @@ instance ToHttpApiData Char where
 instance ToHttpApiData Version where
   toUrlPiece = T.pack . showVersion
   toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  toEncodedQueryParam = unsafeToEncodedQueryParam
 
 instance ToHttpApiData Void    where toUrlPiece = absurd
-instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-
-instance ToHttpApiData Bool     where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-
-instance ToHttpApiData Double   where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Float    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Int      where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Int8     where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Int16    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Int32    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Int64    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Integer  where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Word     where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Word8    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Word16   where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Word32   where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
-instance ToHttpApiData Word64   where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
+instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+
+instance ToHttpApiData Bool     where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+
+instance ToHttpApiData Double   where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Float    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Int      where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Int8     where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Int16    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Int32    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Int64    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Integer  where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Word     where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Word8    where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Word16   where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Word32   where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
+instance ToHttpApiData Word64   where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
 
 -- | Note: this instance is not polykinded
-instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
+instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece; toEncodedQueryParam = unsafeToEncodedQueryParam
 
 -- |
 -- >>> toUrlPiece (fromGregorian 2015 10 03)
 -- "2015-10-03"
 instance ToHttpApiData Day where
   toUrlPiece = T.pack . show
   toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  toEncodedQueryParam = unsafeToEncodedQueryParam
 
 timeToUrlPiece :: FormatTime t => String -> t -> Text
 timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
@@ -478,27 +497,31 @@ timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (J
 instance ToHttpApiData TimeOfDay where
   toUrlPiece = T.pack . formatTime defaultTimeLocale "%H:%M:%S%Q"
   toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  -- no toEncodedQueryParam as : is unsafe char.
 
 -- |
 -- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 21.687)
 -- "2015-10-03T14:55:21.687"
 instance ToHttpApiData LocalTime where
   toUrlPiece = timeToUrlPiece "%H:%M:%S%Q"
   toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  -- no toEncodedQueryParam as : is unsafe char.
 
 -- |
 -- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) utc
 -- "2015-10-03T14:55:51.001+0000"
 instance ToHttpApiData ZonedTime where
   toUrlPiece = timeToUrlPiece "%H:%M:%S%Q%z"
   toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  -- no toEncodedQueryParam as : is unsafe char.
 
 -- |
 -- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864.5
 -- "2015-10-03T00:14:24.5Z"
 instance ToHttpApiData UTCTime where
   toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"
   toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  -- no toEncodedQueryParam as : is unsafe char.
 
 -- |
 -- >>> toUrlPiece Monday
@@ -513,8 +536,9 @@ instance ToHttpApiData DayOfWeek where
   toUrlPiece Sunday    = "sunday"
 
   toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  toEncodedQueryParam = unsafeToEncodedQueryParam
 
--- | 
+-- |
 -- >>> toUrlPiece Q4
 -- "q4"
 instance ToHttpApiData QuarterOfYear where
@@ -523,6 +547,9 @@ instance ToHttpApiData QuarterOfYear where
   toUrlPiece Q3 = "q3"
   toUrlPiece Q4 = "q4"
 
+  toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  toEncodedQueryParam = unsafeToEncodedQueryParam
+
 -- |
 -- >>> import Data.Time.Calendar.Quarter.Compat (Quarter (..))
 -- >>> MkQuarter 8040
@@ -540,6 +567,9 @@ instance ToHttpApiData Quarter where
       f Q3 = "q3"
       f Q4 = "q4"
 
+  toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  toEncodedQueryParam = unsafeToEncodedQueryParam
+
 -- |
 -- >>> import Data.Time.Calendar.Month.Compat (Month (..))
 -- >>> MkMonth 24482
@@ -551,8 +581,13 @@ instance ToHttpApiData Quarter where
 instance ToHttpApiData Month where
   toUrlPiece = T.pack . formatTime defaultTimeLocale "%Y-%m"
 
+  toEncodedUrlPiece = unsafeToEncodedUrlPiece
+  toEncodedQueryParam = unsafeToEncodedQueryParam
+
 instance ToHttpApiData NominalDiffTime where
   toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
+
+  toEncodedQueryParam = unsafeToEncodedQueryParam
   toEncodedUrlPiece = unsafeToEncodedUrlPiece
 
 instance ToHttpApiData String   where toUrlPiece = T.pack
@@ -562,46 +597,57 @@ instance ToHttpApiData L.Text   where toUrlPiece = L.toStrict
 instance ToHttpApiData All where
   toUrlPiece        = coerce (toUrlPiece :: Bool -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: Bool -> BS.Builder)
 
 instance ToHttpApiData Any where
   toUrlPiece        = coerce (toUrlPiece :: Bool -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: Bool -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (Dual a) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (Sum a) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (Product a) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (First a) where
   toUrlPiece        = coerce (toUrlPiece :: Maybe a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: Maybe a -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (Last a) where
   toUrlPiece        = coerce (toUrlPiece :: Maybe a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: Maybe a -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (Semi.Min a) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (Semi.First a) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 instance ToHttpApiData a => ToHttpApiData (Semi.Last a) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 -- |
 -- >>> toUrlPiece (Just "Hello")
@@ -639,20 +685,23 @@ instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where
   toHeader          = coerce (toHeader :: a -> ByteString)
   toQueryParam      = coerce (toQueryParam :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece ::  a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 -- | @since 0.4.2
 instance ToHttpApiData a => ToHttpApiData (Const a b) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toHeader          = coerce (toHeader :: a -> ByteString)
   toQueryParam      = coerce (toQueryParam :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece ::  a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 -- | @since 0.4.2
 instance ToHttpApiData a => ToHttpApiData (Identity a) where
   toUrlPiece        = coerce (toUrlPiece :: a -> Text)
   toHeader          = coerce (toHeader :: a -> ByteString)
   toQueryParam      = coerce (toQueryParam :: a -> Text)
   toEncodedUrlPiece = coerce (toEncodedUrlPiece ::  a -> BS.Builder)
+  toEncodedQueryParam = coerce (toEncodedQueryParam :: a -> BS.Builder)
 
 -- |
 -- >>> parseUrlPiece "_" :: Either Text ()

test/Web/Internal/HttpApiDataSpec.hs

@@ -46,6 +46,9 @@ import           Web.Internal.TestInstances
 encodedUrlPieceProp :: ToHttpApiData a => a -> Property
 encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x)
 
+encodedQueryParamProp :: ToHttpApiData a => a -> Property
+encodedQueryParamProp x = toLazyByteString (toEncodedQueryParam (toQueryParam x)) === toLazyByteString (toEncodedQueryParam x)
+
 -- | Check 'ToHttpApiData' and 'FromHttpApiData' compatibility
 checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec
 checkUrlPiece _ = checkUrlPiece' (arbitrary :: Gen a)
@@ -56,6 +59,7 @@ checkUrlPiece' gen name = describe name $ do
     prop "toQueryParam <=> parseQueryParam" $ forAll gen (toQueryParam <=> parseQueryParam :: a -> Property)
     prop "toHeader <=> parseHeader" $ forAll gen (toHeader <=> parseHeader :: a -> Property)
     prop "toEncodedUrlPiece encodes correctly" $ forAll gen encodedUrlPieceProp
+    prop "toEncodedQueryParam encodes correctly" $ forAll gen encodedQueryParamProp
 
 -- | Check case insensitivity for @parseUrlPiece@.
 checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec