@@ -5,9 +5,7 @@
5{-# LANGUAGE DeriveFunctor #-}
5{-# LANGUAGE DeriveFunctor #-}
6{-# LANGUAGE DeriveTraversable #-}
6{-# LANGUAGE DeriveTraversable #-}
7{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE KindSignatures #-}
9{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
11{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TypeSynonymInstances #-}
10{-# LANGUAGE TypeSynonymInstances #-}
@@ -18,7 +16,6 @@ module Web.Internal.HttpApiData where
18import Prelude ()
16import Prelude ()
19import Prelude.Compat
17import Prelude.Compat
21−import Control.Applicative (Const(Const))
22import Control.Arrow (left, (&&&))
19import Control.Arrow (left, (&&&))
23import Control.Monad ((<=<))
20import Control.Monad ((<=<))
24import qualified Data.Attoparsec.Text as Atto
21import qualified Data.Attoparsec.Text as Atto
@@ -30,9 +27,7 @@ import qualified Data.ByteString.Lazy as LBS
30import Data.Coerce (coerce)
27import Data.Coerce (coerce)
31import Data.Data (Data)
28import Data.Data (Data)
32import qualified Data.Fixed as F
29import qualified Data.Fixed as F
33−import Data.Functor.Identity (Identity(Identity))
34import Data.Int (Int16, Int32, Int64, Int8)
30import Data.Int (Int16, Int32, Int64, Int8)
35−import Data.Kind (Type)
36import qualified Data.Map as Map
31import qualified Data.Map as Map
37import Data.Monoid (All (..), Any (..), Dual (..),
32import Data.Monoid (All (..), Any (..), Dual (..),
38 First (..), Last (..),
33 First (..), Last (..),
@@ -56,9 +51,6 @@ import Data.Time.Compat (Day, FormatTime, LocalTime,
56 secondsToNominalDiffTime)
51 secondsToNominalDiffTime)
57import Data.Time.Format.Compat (defaultTimeLocale,
52import Data.Time.Format.Compat (defaultTimeLocale,
58 iso8601DateFormat)
53 iso8601DateFormat)
59−import Data.Time.Calendar.Month.Compat (Month)
60−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
62import Data.Typeable (Typeable)
54import Data.Typeable (Typeable)
63import qualified Data.UUID.Types as UUID
55import qualified Data.UUID.Types as UUID
64import Data.Version (Version, parseVersion,
56import Data.Version (Version, parseVersion,
@@ -72,10 +64,14 @@ import Text.Read (readMaybe)
72import Web.Cookie (SetCookie, parseSetCookie,
64import Web.Cookie (SetCookie, parseSetCookie,
73 renderSetCookie)
65 renderSetCookie)
75#if USE_TEXT_SHOW
68#if USE_TEXT_SHOW
76import TextShow (TextShow, showt)
69import TextShow (TextShow, showt)
80-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
76-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
81-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
77-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
@@ -96,7 +92,7 @@ class ToHttpApiData a where
96 -- The default definition uses 'H.encodePathSegmentsRelative',
92 -- The default definition uses 'H.encodePathSegmentsRelative',
97 -- but this may be overriden with a more efficient version.
93 -- but this may be overriden with a more efficient version.
98 toEncodedUrlPiece :: a -> BS.Builder
94 toEncodedUrlPiece :: a -> BS.Builder
99− toEncodedUrlPiece = H.urlEncodeBuilder True . encodeUtf8 . toUrlPiece
95+ toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece
101 -- | Convert to HTTP header value.
97 -- | Convert to HTTP header value.
102 toHeader :: a -> ByteString
98 toHeader :: a -> ByteString
@@ -459,8 +455,7 @@ instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = un
459instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
455instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
460instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
456instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
462−-- | Note: this instance is not polykinded
463−instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
458+instance F.HasResolution a => ToHttpApiData (F.Fixed a) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
466-- >>> toUrlPiece (fromGregorian 2015 10 03)
461-- >>> toUrlPiece (fromGregorian 2015 10 03)
@@ -514,42 +509,6 @@ instance ToHttpApiData DayOfWeek where
515 toEncodedUrlPiece = unsafeToEncodedUrlPiece
510 toEncodedUrlPiece = unsafeToEncodedUrlPiece
520−instance ToHttpApiData QuarterOfYear where
521− toUrlPiece Q1 = "q1"
522− toUrlPiece Q2 = "q2"
523− toUrlPiece Q3 = "q3"
524− toUrlPiece Q4 = "q4"
527−-- >>> import Data.Time.Calendar.Quarter.Compat (Quarter (..))
528−-- >>> MkQuarter 8040
531−-- >>> toUrlPiece $ MkQuarter 8040
534−instance ToHttpApiData Quarter where
535− toUrlPiece q = case toYearQuarter q of
536− (y, qoy) -> T.pack (show y ++ "-" ++ f qoy)
544−-- >>> import Data.Time.Calendar.Month.Compat (Month (..))
548−-- >>> toUrlPiece $ MkMonth 24482
551−instance ToHttpApiData Month where
552− toUrlPiece = T.pack . formatTime defaultTimeLocale "%Y-%m"
554instance ToHttpApiData NominalDiffTime where
513instance ToHttpApiData NominalDiffTime where
555 toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
514 toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
@@ -633,22 +592,7 @@ instance ToHttpApiData SetCookie where
633 toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
592 toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
634 -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
593 -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
636−-- | Note: this instance is not polykinded
637−instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where
595+instance ToHttpApiData a => ToHttpApiData (Tagged b a) where
638− toUrlPiece = coerce (toUrlPiece :: a -> Text)
639− toHeader = coerce (toHeader :: a -> ByteString)
640− toQueryParam = coerce (toQueryParam :: a -> Text)
641− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
644−instance ToHttpApiData a => ToHttpApiData (Const a b) where
645− toUrlPiece = coerce (toUrlPiece :: a -> Text)
646− toHeader = coerce (toHeader :: a -> ByteString)
647− toQueryParam = coerce (toQueryParam :: a -> Text)
648− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
651−instance ToHttpApiData a => ToHttpApiData (Identity a) where
652 toUrlPiece = coerce (toUrlPiece :: a -> Text)
596 toUrlPiece = coerce (toUrlPiece :: a -> Text)
653 toHeader = coerce (toHeader :: a -> ByteString)
597 toHeader = coerce (toHeader :: a -> ByteString)
654 toQueryParam = coerce (toQueryParam :: a -> Text)
598 toQueryParam = coerce (toQueryParam :: a -> Text)
@@ -706,8 +650,7 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
706instance FromHttpApiData Text where parseUrlPiece = Right
650instance FromHttpApiData Text where parseUrlPiece = Right
707instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
651instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
709−-- | Note: this instance is not polykinded
710−instance F.HasResolution a => FromHttpApiData (F.Fixed (a :: Type)) where
653+instance F.HasResolution a => FromHttpApiData (F.Fixed a) where
711 parseUrlPiece = runReader rational
654 parseUrlPiece = runReader rational
@@ -738,9 +681,6 @@ instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime
738-- Right 2015-10-03 00:14:24 UTC
681-- Right 2015-10-03 00:14:24 UTC
739instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
682instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
742−-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek
744instance FromHttpApiData DayOfWeek where
684instance FromHttpApiData DayOfWeek where
745 parseUrlPiece t = case Map.lookup (T.toLower t) m of
685 parseUrlPiece t = case Map.lookup (T.toLower t) m of
746 Just dow -> Right dow
686 Just dow -> Right dow
@@ -752,30 +692,6 @@ instance FromHttpApiData DayOfWeek where
753instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece
693instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece
756−-- >>> parseUrlPiece "2021-01" :: Either Text Month
758−instance FromHttpApiData Month where parseUrlPiece = runAtto Atto.month
761−-- >>> parseUrlPiece "2021-q1" :: Either Text Quarter
763−instance FromHttpApiData Quarter where parseUrlPiece = runAtto Atto.quarter
766−-- >>> parseUrlPiece "q2" :: Either Text QuarterOfYear
769−-- >>> parseUrlPiece "Q3" :: Either Text QuarterOfYear
771−instance FromHttpApiData QuarterOfYear where
772− parseUrlPiece t = case T.toLower t of
777− _ -> Left "Invalid quarter of year"
779instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
695instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
780instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
696instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
@@ -839,20 +755,7 @@ instance FromHttpApiData SetCookie where
839 parseUrlPiece = parseHeader . encodeUtf8
755 parseUrlPiece = parseHeader . encodeUtf8
840 parseHeader = Right . parseSetCookie
756 parseHeader = Right . parseSetCookie
842−-- | Note: this instance is not polykinded
843−instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) a) where
758+instance FromHttpApiData a => FromHttpApiData (Tagged b a) where
844− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
845− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
846− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
849−instance FromHttpApiData a => FromHttpApiData (Const a b) where
850− parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
851− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
852− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
855−instance FromHttpApiData a => FromHttpApiData (Identity a) where
856 parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
759 parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
857 parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
760 parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
858 parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
761 parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
@@ -865,3 +768,5 @@ runAtto :: Atto.Parser a -> Text -> Either Text a
865runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
768runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
866 Left err -> Left (T.pack err)
769 Left err -> Left (T.pack err)
867 Right x -> Right x
770 Right x -> Right x