@@ -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,10 +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)
36−import qualified Data.Map as Map
37import Data.Monoid (All (..), Any (..), Dual (..),
31import Data.Monoid (All (..), Any (..), Dual (..),
38 First (..), Last (..),
32 First (..), Last (..),
39 Product (..), Sum (..))
33 Product (..), Sum (..))
@@ -48,17 +42,11 @@ import Data.Text.Encoding.Error (lenientDecode)
48import qualified Data.Text.Lazy as L
42import qualified Data.Text.Lazy as L
49import Data.Text.Read (Reader, decimal, rational,
43import Data.Text.Read (Reader, decimal, rational,
51−import Data.Time.Compat (Day, FormatTime, LocalTime,
45+import Data.Time (Day, FormatTime, LocalTime,
52 NominalDiffTime, TimeOfDay,
46 NominalDiffTime, TimeOfDay,
53− UTCTime, ZonedTime, formatTime,
47+ UTCTime, ZonedTime, formatTime)
55− nominalDiffTimeToSeconds,
56− secondsToNominalDiffTime)
57−import Data.Time.Format.Compat (defaultTimeLocale,
48+import Data.Time.Locale.Compat (defaultTimeLocale,
58 iso8601DateFormat)
49 iso8601DateFormat)
59−import Data.Time.Calendar.Month.Compat (Month)
60−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
62import Data.Typeable (Typeable)
50import Data.Typeable (Typeable)
63import qualified Data.UUID.Types as UUID
51import qualified Data.UUID.Types as UUID
64import Data.Version (Version, parseVersion,
52import Data.Version (Version, parseVersion,
@@ -72,14 +60,22 @@ import Text.Read (readMaybe)
72import Web.Cookie (SetCookie, parseSetCookie,
60import Web.Cookie (SetCookie, parseSetCookie,
73 renderSetCookie)
61 renderSetCookie)
63+#if MIN_VERSION_time(1,9,1)
64+import Data.Time (nominalDiffTimeToSeconds,
65+ secondsToNominalDiffTime)
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
82−-- >>> import Data.Time.Compat
78+-- >>> import Data.Time
83-- >>> import Data.Version
79-- >>> import Data.Version
85-- | Convert value to HTTP API data.
81-- | Convert value to HTTP API data.
@@ -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
@@ -338,7 +334,7 @@ lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound])
338-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
334-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
339-- Right True
335-- Right True
341−-- For case insensitive parser see 'parseBoundedEnumOfI'.
337+-- For case sensitive parser see 'parseBoundedEnumOfI'.
342parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
338parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
343parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
339parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
@@ -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)
@@ -500,59 +495,28 @@ instance ToHttpApiData UTCTime where
500 toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"
495 toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"
501 toEncodedUrlPiece = unsafeToEncodedUrlPiece
496 toEncodedUrlPiece = unsafeToEncodedUrlPiece
503−-- |
498+-- The CPP in both this function and the function after it are to avoid
504−-- >>> toUrlPiece Monday
499+-- exporting @nominalDiffTimeToSeconds@ and @secondsToNominalDiffTime@,
505−-- "monday"
500+-- since these names are already used by @Data.Time@ from the @time@ library
506−instance ToHttpApiData DayOfWeek where
501+-- starting in version @1.9.1@.
507− toUrlPiece Monday = "monday"
502+nominalDiffTimeToSecs :: NominalDiffTime -> F.Pico
508− toUrlPiece Tuesday = "tuesday"
503+nominalDiffTimeToSecs =
509− toUrlPiece Wednesday = "wednesday"
504+#if !MIN_VERSION_time(1,9,1)
510− toUrlPiece Thursday = "thursday"
505+ realToFrac
511− toUrlPiece Friday = "friday"
506+#else
512− toUrlPiece Saturday = "saturday"
507+ nominalDiffTimeToSeconds
513− toUrlPiece Sunday = "sunday"
508+#endif
515− 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)
543−-- |
510+secsToNominalDiffTime :: F.Pico -> NominalDiffTime
544−-- >>> import Data.Time.Calendar.Month.Compat (Month (..))
511+secsToNominalDiffTime =
545−-- >>> MkMonth 24482
512+#if !MIN_VERSION_time(1,9,1)
546−-- 2040-03
513+ realToFrac
548−-- >>> toUrlPiece $ MkMonth 24482
515+ secondsToNominalDiffTime
549−-- "2040-03"
516+#endif
551−instance ToHttpApiData Month where
552− toUrlPiece = T.pack . formatTime defaultTimeLocale "%Y-%m"
554instance ToHttpApiData NominalDiffTime where
518instance ToHttpApiData NominalDiffTime where
555− toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
519+ toUrlPiece = toUrlPiece . nominalDiffTimeToSecs
556 toEncodedUrlPiece = unsafeToEncodedUrlPiece
520 toEncodedUrlPiece = unsafeToEncodedUrlPiece
558instance ToHttpApiData String where toUrlPiece = T.pack
522instance ToHttpApiData String where toUrlPiece = T.pack
@@ -633,22 +597,7 @@ instance ToHttpApiData SetCookie where
633 toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
597 toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
634 -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
598 -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
636−-- | Note: this instance is not polykinded
637−instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) a) where
600+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)
601 toUrlPiece = coerce (toUrlPiece :: a -> Text)
653 toHeader = coerce (toHeader :: a -> ByteString)
602 toHeader = coerce (toHeader :: a -> ByteString)
654 toQueryParam = coerce (toQueryParam :: a -> Text)
603 toQueryParam = coerce (toQueryParam :: a -> Text)
@@ -706,8 +655,7 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
706instance FromHttpApiData Text where parseUrlPiece = Right
655instance FromHttpApiData Text where parseUrlPiece = Right
707instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
656instance 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
658+instance F.HasResolution a => FromHttpApiData (F.Fixed a) where
711 parseUrlPiece = runReader rational
659 parseUrlPiece = runReader rational
@@ -738,43 +686,7 @@ instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime
738-- Right 2015-10-03 00:14:24 UTC
686-- Right 2015-10-03 00:14:24 UTC
739instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
687instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
742−-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek
744−instance FromHttpApiData DayOfWeek where
745− parseUrlPiece t = case Map.lookup (T.toLower t) m of
746− Just dow -> Right dow
747− Nothing -> Left $ "Incorrect DayOfWeek: " <> T.take 10 t
749− m :: Map.Map Text DayOfWeek
750− m = Map.fromList [ (toUrlPiece dow, dow) | dow <- [Monday .. Sunday] ]
753−instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece
689+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secsToNominalDiffTime . 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)
691instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
780instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
692instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
@@ -839,20 +751,7 @@ instance FromHttpApiData SetCookie where
839 parseUrlPiece = parseHeader . encodeUtf8
751 parseUrlPiece = parseHeader . encodeUtf8
840 parseHeader = Right . parseSetCookie
752 parseHeader = Right . parseSetCookie
842−-- | Note: this instance is not polykinded
843−instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) a) where
754+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)
755 parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
857 parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
756 parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
858 parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
757 parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
@@ -865,3 +764,5 @@ runAtto :: Atto.Parser a -> Text -> Either Text a
865runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
764runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
866 Left err -> Left (T.pack err)
765 Left err -> Left (T.pack err)
867 Right x -> Right x
766 Right x -> Right x