diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.4.2 +----- + +* Add instances for `Const` and `Identity` + 0.4.1.1 ------- diff --git a/http-api-data.cabal b/http-api-data.cabal --- a/http-api-data.cabal +++ b/http-api-data.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: http-api-data -version: 0.4.1.1 +version: 0.4.2 synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters. category: Web @@ -30,7 +30,8 @@ GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, - GHC==8.8.1 + GHC==8.8.4, + GHC==8.10.2 flag use-text-show description: Use text-show library for efficient ToHttpApiData implementations. @@ -42,10 +43,11 @@ include-dirs: include/ -- GHC bundled - build-depends: base >= 4.7 && < 4.14 + build-depends: base >= 4.7 && < 4.15 , bytestring >= 0.10.4.0 && < 0.11 , containers >= 0.5.5.1 && < 0.7 , text >= 1.2.3.0 && < 1.3 + , transformers >= 0.3 && < 0.6 -- so Semigroup Builder exists if impl(ghc >= 8.0) @@ -110,7 +112,7 @@ build-depends: HUnit >= 1.6.0.0 && <1.7 , hspec >= 2.7.1 && <2.8 - , QuickCheck >= 2.13.1 && <2.14 + , QuickCheck >= 2.13.1 && <2.15 , quickcheck-instances >= 0.3.21 && <0.4 source-repository head diff --git a/src/Web/Internal/FormUrlEncoded.hs b/src/Web/Internal/FormUrlEncoded.hs --- a/src/Web/Internal/FormUrlEncoded.hs +++ b/src/Web/Internal/FormUrlEncoded.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-} @@ -20,6 +20,7 @@ import Prelude () import Prelude.Compat +import Control.Applicative (Const(Const)) import Control.Arrow ((***)) import Control.Monad ((<=<)) import Data.ByteString.Builder (shortByteString, toLazyByteString) @@ -27,6 +28,7 @@ import qualified Data.ByteString.Lazy.Char8 as BSL8 import Data.Coerce (coerce) import qualified Data.Foldable as F +import Data.Functor.Identity (Identity(Identity)) import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap @@ -130,6 +132,13 @@ instance ToFormKey a => ToFormKey (Tagged b a) where toFormKey = coerce (toFormKey :: a -> Text) +-- | @since 0.4.2 +instance ToFormKey a => ToFormKey (Identity a) where toFormKey = coerce (toFormKey :: a -> Text) + +-- | @since 0.4.2 +instance ToFormKey a => ToFormKey (Const a b) where + toFormKey = coerce (toFormKey :: a -> Text) + instance ToFormKey Void where toFormKey = toQueryParam instance ToFormKey Natural where toFormKey = toQueryParam @@ -181,6 +190,13 @@ instance FromFormKey a => FromFormKey (Semi.Last a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a) instance FromFormKey a => FromFormKey (Tagged b a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a) + +-- | @since 0.4.2 +instance FromFormKey a => FromFormKey (Identity a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a) + +-- | @since 0.4.2 +instance FromFormKey a => FromFormKey (Const a b) where + parseFormKey = coerce (parseFormKey :: Text -> Either Text a) instance FromFormKey Void where parseFormKey = parseQueryParam instance FromFormKey Natural where parseFormKey = parseQueryParam diff --git a/src/Web/Internal/HttpApiData.hs b/src/Web/Internal/HttpApiData.hs --- a/src/Web/Internal/HttpApiData.hs +++ b/src/Web/Internal/HttpApiData.hs @@ -5,7 +5,9 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} -- | @@ -16,6 +18,7 @@ import Prelude () import Prelude.Compat +import Control.Applicative (Const(Const)) import Control.Arrow (left, (&&&)) import Control.Monad ((<=<)) import qualified Data.Attoparsec.Text as Atto @@ -27,6 +30,7 @@ import Data.Coerce (coerce) import Data.Data (Data) import qualified Data.Fixed as F +import Data.Functor.Identity (Identity(Identity)) import Data.Int (Int16, Int32, Int64, Int8) import qualified Data.Map as Map import Data.Monoid (All (..), Any (..), Dual (..), @@ -64,14 +68,16 @@ import Web.Cookie (SetCookie, parseSetCookie, renderSetCookie) +#if MIN_VERSION_base(4,9,0) +import Data.Kind (Type) +#else +#define Type * +#endif #if USE_TEXT_SHOW import TextShow (TextShow, showt) #endif - - - -- $setup -- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show) -- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p @@ -334,7 +340,7 @@ -- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool -- Right True -- --- For case sensitive parser see 'parseBoundedEnumOfI'. +-- For case insensitive parser see 'parseBoundedEnumOfI'. parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf @@ -455,7 +461,8 @@ instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece -instance F.HasResolution a => ToHttpApiData (F.Fixed a) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +-- | Note: this instance is not polykinded +instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece -- | -- >>> toUrlPiece (fromGregorian 2015 10 03) @@ -592,12 +599,27 @@ toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie -- toEncodedUrlPiece = renderSetCookie -- doesn't do things. -instance ToHttpApiData a => ToHttpApiData (Tagged b a) where +-- | Note: this instance is not polykinded +instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where toUrlPiece = coerce (toUrlPiece :: a -> Text) toHeader = coerce (toHeader :: a -> ByteString) toQueryParam = coerce (toQueryParam :: a -> Text) toEncodedUrlPiece = coerce (toEncodedUrlPiece :: 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) + +-- | @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) + -- | -- >>> parseUrlPiece "_" :: Either Text () -- Right () @@ -650,7 +672,8 @@ instance FromHttpApiData Text where parseUrlPiece = Right instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict -instance F.HasResolution a => FromHttpApiData (F.Fixed a) where +-- | Note: this instance is not polykinded +instance F.HasResolution a => FromHttpApiData (F.Fixed (a :: Type)) where parseUrlPiece = runReader rational -- | @@ -755,7 +778,20 @@ parseUrlPiece = parseHeader . encodeUtf8 parseHeader = Right . parseSetCookie -instance FromHttpApiData a => FromHttpApiData (Tagged b a) where +-- | Note: this instance is not polykinded +instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) a) where + parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a) + parseHeader = coerce (parseHeader :: ByteString -> Either Text a) + parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a) + +-- | @since 0.4.2 +instance FromHttpApiData a => FromHttpApiData (Const a b) where + parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a) + parseHeader = coerce (parseHeader :: ByteString -> Either Text a) + parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a) + +-- | @since 0.4.2 +instance FromHttpApiData a => FromHttpApiData (Identity a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a) parseHeader = coerce (parseHeader :: ByteString -> Either Text a) parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)