114bd55 · typeable/http-api-data

git.iko.soy/typeable/http-api-data

Merge pull request #103 from phadej/pr-101-const-instances

Add To/FromHttpApiData and To/FromFormKey instances for Const

commit114bd55b8e241565b1de348a2106aaa39310722e authorOleg Grenrus <oleg.grenrus@iki.fi> dateFri 28 Aug 2020, 13:44 (6 years ago) parent32bb258 bcc6a31

3 files changed+61−8

compare with master

unifiedsplit

http-api-data.cabal+1 src/Web/Internal/FormUrlEncoded.hs+17−1 src/Web/Internal/HttpApiData.hs+43−7

http-api-data.cabal+1

@@ -48,6 +48,7 @@ library

4848 , bytestring >= 0.10.4.0 && < 0.11

4949 , containers >= 0.5.5.1 && < 0.7

5050 , text >= 1.2.3.0 && < 1.3

51+ , transformers >= 0.3 && < 0.6

5152

5253 -- so Semigroup Builder exists

5354 if impl(ghc >= 8.0)

src/Web/Internal/FormUrlEncoded.hs+17−1

@@ -1,5 +1,5 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE CPP #-}

33{-# LANGUAGE DataKinds #-}

44{-# LANGUAGE DefaultSignatures #-}

55{-# LANGUAGE DeriveGeneric #-}

@@ -20,6 +20,7 @@ module Web.Internal.FormUrlEncoded where

2020import Prelude ()

2121import Prelude.Compat

2222

23+import Control.Applicative (Const(Const))

2324import Control.Arrow ((***))

2425import Control.Monad ((<=<))

2526import Data.ByteString.Builder (shortByteString, toLazyByteString)

@@ -27,6 +28,7 @@ import qualified Data.ByteString.Lazy as BSL

2728import qualified Data.ByteString.Lazy.Char8 as BSL8

2829import Data.Coerce (coerce)

2930import qualified Data.Foldable as F

31+import Data.Functor.Identity (Identity(Identity))

3032import Data.Hashable (Hashable)

3133import Data.HashMap.Strict (HashMap)

3234import qualified Data.HashMap.Strict as HashMap

@@ -130,6 +132,13 @@ instance ToFormKey a => ToFormKey (Semi.Last a) where toFormKey = coerce (toFor

130132

131133instance ToFormKey a => ToFormKey (Tagged b a) where toFormKey = coerce (toFormKey :: a -> Text)

132134

135+-- | @since 0.4.2

136+instance ToFormKey a => ToFormKey (Identity a) where toFormKey = coerce (toFormKey :: a -> Text)

137+

138+-- | @since 0.4.2

139+instance ToFormKey a => ToFormKey (Const a b) where

140+ toFormKey = coerce (toFormKey :: a -> Text)

141+

133142instance ToFormKey Void where toFormKey = toQueryParam

134143instance ToFormKey Natural where toFormKey = toQueryParam

135144

@@ -182,6 +191,13 @@ instance FromFormKey a => FromFormKey (Semi.Last a) where parseFormKey = coerce

182191

183192instance FromFormKey a => FromFormKey (Tagged b a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

184193

194+-- | @since 0.4.2

195+instance FromFormKey a => FromFormKey (Identity a) where parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

196+

197+-- | @since 0.4.2

198+instance FromFormKey a => FromFormKey (Const a b) where

199+ parseFormKey = coerce (parseFormKey :: Text -> Either Text a)

200+

185201instance FromFormKey Void where parseFormKey = parseQueryParam

186202instance FromFormKey Natural where parseFormKey = parseQueryParam

187203

src/Web/Internal/HttpApiData.hs+43−7

@@ -5,7 +5,9 @@

55{-# LANGUAGE DeriveFunctor #-}

66{-# LANGUAGE DeriveTraversable #-}

77{-# LANGUAGE FlexibleInstances #-}

8+{-# LANGUAGE KindSignatures #-}

89{-# LANGUAGE OverloadedStrings #-}

10+{-# LANGUAGE PolyKinds #-}

911{-# LANGUAGE ScopedTypeVariables #-}

1012{-# LANGUAGE TypeSynonymInstances #-}

1113-- |

@@ -16,6 +18,7 @@ module Web.Internal.HttpApiData where

1618import Prelude ()

1719import Prelude.Compat

1820

21+import Control.Applicative (Const(Const))

1922import Control.Arrow (left, (&&&))

2023import Control.Monad ((<=<))

2124import qualified Data.Attoparsec.Text as Atto

@@ -27,6 +30,7 @@ import qualified Data.ByteString.Lazy as LBS

2730import Data.Coerce (coerce)

2831import Data.Data (Data)

2932import qualified Data.Fixed as F

33+import Data.Functor.Identity (Identity(Identity))

3034import Data.Int (Int16, Int32, Int64, Int8)

3135import qualified Data.Map as Map

3236import Data.Monoid (All (..), Any (..), Dual (..),

@@ -64,14 +68,16 @@ import Text.Read (readMaybe)

6468import Web.Cookie (SetCookie, parseSetCookie,

6569 renderSetCookie)

6670

71+#if MIN_VERSION_base(4,9,0)

72+import Data.Kind (Type)

73+#else

74+#define Type *

75+#endif

6776

6877#if USE_TEXT_SHOW

6978import TextShow (TextShow, showt)

7079#endif

7180

72−

73−

74−

7581-- $setup

7682-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)

7783-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p

@@ -455,7 +461,8 @@ instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = un

455461instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

456462instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

457463

458−instance F.HasResolution a => ToHttpApiData (F.Fixed a) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

464+-- | Note: this instance is not polykinded

465+instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece

459466

460467-- |

461468-- >>> toUrlPiece (fromGregorian 2015 10 03)

@@ -592,7 +599,22 @@ instance ToHttpApiData SetCookie where

592599 toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie

593600 -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.

594601

595−instance ToHttpApiData a => ToHttpApiData (Tagged b a) where

602+-- | Note: this instance is not polykinded

603+instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where

604+ toUrlPiece = coerce (toUrlPiece :: a -> Text)

605+ toHeader = coerce (toHeader :: a -> ByteString)

606+ toQueryParam = coerce (toQueryParam :: a -> Text)

607+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

608+

609+-- | @since 0.4.2

610+instance ToHttpApiData a => ToHttpApiData (Const a b) where

611+ toUrlPiece = coerce (toUrlPiece :: a -> Text)

612+ toHeader = coerce (toHeader :: a -> ByteString)

613+ toQueryParam = coerce (toQueryParam :: a -> Text)

614+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)

615+

616+-- | @since 0.4.2

617+instance ToHttpApiData a => ToHttpApiData (Identity a) where

596618 toUrlPiece = coerce (toUrlPiece :: a -> Text)

597619 toHeader = coerce (toHeader :: a -> ByteString)

598620 toQueryParam = coerce (toQueryParam :: a -> Text)

@@ -650,7 +672,8 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack

650672instance FromHttpApiData Text where parseUrlPiece = Right

651673instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict

652674

653−instance F.HasResolution a => FromHttpApiData (F.Fixed a) where

675+-- | Note: this instance is not polykinded

676+instance F.HasResolution a => FromHttpApiData (F.Fixed (a :: Type)) where

654677 parseUrlPiece = runReader rational

655678

656679-- |

@@ -755,7 +778,20 @@ instance FromHttpApiData SetCookie where

755778 parseUrlPiece = parseHeader . encodeUtf8

756779 parseHeader = Right . parseSetCookie

757780

758−instance FromHttpApiData a => FromHttpApiData (Tagged b a) where

781+-- | Note: this instance is not polykinded

782+instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) a) where

783+ parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

784+ parseHeader = coerce (parseHeader :: ByteString -> Either Text a)

785+ parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)

786+

787+-- | @since 0.4.2

788+instance FromHttpApiData a => FromHttpApiData (Const a b) where

789+ parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

790+ parseHeader = coerce (parseHeader :: ByteString -> Either Text a)

791+ parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)

792+

793+-- | @since 0.4.2

794+instance FromHttpApiData a => FromHttpApiData (Identity a) where

759795 parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)

760796 parseHeader = coerce (parseHeader :: ByteString -> Either Text a)

761797 parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)