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