@@ -5,9 +5,7 @@
55{-# LANGUAGE DeriveFunctor #-}
66{-# LANGUAGE DeriveTraversable #-}
77{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE KindSignatures #-}
98{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
119{-# LANGUAGE ScopedTypeVariables #-}
1210{-# LANGUAGE TypeSynonymInstances #-}
1311-- |
@@ -18,7 +16,6 @@ module Web.Internal.HttpApiData where
1816import Prelude ()
1917import Prelude.Compat
2018
21−import Control.Applicative (Const(Const))
2219import Control.Arrow (left, (&&&))
2320import Control.Monad ((<=<))
2421import qualified Data.Attoparsec.Text as Atto
@@ -30,10 +27,7 @@ import qualified Data.ByteString.Lazy as LBS
3027import Data.Coerce (coerce)
3128import Data.Data (Data)
3229import qualified Data.Fixed as F
33−import Data.Functor.Identity (Identity(Identity))
3430import Data.Int (Int16, Int32, Int64, Int8)
35−import Data.Kind (Type)
36−import qualified Data.Map as Map
3731import Data.Monoid (All (..), Any (..), Dual (..),
3832 First (..), Last (..),
3933 Product (..), Sum (..))
@@ -48,17 +42,11 @@ import Data.Text.Encoding.Error (lenientDecode)
4842import qualified Data.Text.Lazy as L
4943import Data.Text.Read (Reader, decimal, rational,
5044 signed)
51−import Data.Time.Compat (Day, FormatTime, LocalTime,
45+import Data.Time (Day, FormatTime, LocalTime,
5246 NominalDiffTime, TimeOfDay,
53− UTCTime, ZonedTime, formatTime,
54− DayOfWeek (..),
55− nominalDiffTimeToSeconds,
56− secondsToNominalDiffTime)
57−import Data.Time.Format.Compat (defaultTimeLocale,
47+ UTCTime, ZonedTime, formatTime)
48+import Data.Time.Locale.Compat (defaultTimeLocale,
5849 iso8601DateFormat)
59−import Data.Time.Calendar.Month.Compat (Month)
60−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
61− toYearQuarter)
6250import Data.Typeable (Typeable)
6351import qualified Data.UUID.Types as UUID
6452import Data.Version (Version, parseVersion,
@@ -72,14 +60,22 @@ import Text.Read (readMaybe)
7260import Web.Cookie (SetCookie, parseSetCookie,
7361 renderSetCookie)
7462
63+#if MIN_VERSION_time(1,9,1)
64+import Data.Time (nominalDiffTimeToSeconds,
65+ secondsToNominalDiffTime)
66+#endif
67+
7568#if USE_TEXT_SHOW
7669import TextShow (TextShow, showt)
7770#endif
7871
72+
73+
74+
7975-- $setup
8076-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
8177-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
82−-- >>> import Data.Time.Compat
78+-- >>> import Data.Time
8379-- >>> import Data.Version
8480
8581-- | Convert value to HTTP API data.
@@ -96,7 +92,7 @@ class ToHttpApiData a where
9692 -- The default definition uses 'H.encodePathSegmentsRelative',
9793 -- but this may be overriden with a more efficient version.
9894 toEncodedUrlPiece :: a -> BS.Builder
99− toEncodedUrlPiece = H.urlEncodeBuilder True . encodeUtf8 . toUrlPiece
95+ toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece
10096
10197 -- | Convert to HTTP header value.
10298 toHeader :: a -> ByteString
@@ -338,7 +334,7 @@ lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound])
338334-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
339335-- Right True
340336--
341−-- For case insensitive parser see 'parseBoundedEnumOfI'.
337+-- For case sensitive parser see 'parseBoundedEnumOfI'.
342338parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
343339parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
344340
@@ -459,8 +455,7 @@ instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = un
459455instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
460456instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
461457
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
464459
465460-- |
466461-- >>> toUrlPiece (fromGregorian 2015 10 03)
@@ -500,59 +495,28 @@ instance ToHttpApiData UTCTime where
500495 toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"
501496 toEncodedUrlPiece = unsafeToEncodedUrlPiece
502497
503−-- |
504−-- >>> toUrlPiece Monday
505−-- "monday"
506−instance ToHttpApiData DayOfWeek where
507− toUrlPiece Monday = "monday"
508− toUrlPiece Tuesday = "tuesday"
509− toUrlPiece Wednesday = "wednesday"
510− toUrlPiece Thursday = "thursday"
511− toUrlPiece Friday = "friday"
512− toUrlPiece Saturday = "saturday"
513− toUrlPiece Sunday = "sunday"
514−
515− toEncodedUrlPiece = unsafeToEncodedUrlPiece
516−
517−-- |
518−-- >>> toUrlPiece Q4
519−-- "q4"
520−instance ToHttpApiData QuarterOfYear where
521− toUrlPiece Q1 = "q1"
522− toUrlPiece Q2 = "q2"
523− toUrlPiece Q3 = "q3"
524− toUrlPiece Q4 = "q4"
525−
526−-- |
527−-- >>> import Data.Time.Calendar.Quarter.Compat (Quarter (..))
528−-- >>> MkQuarter 8040
529−-- 2010-Q1
530−--
531−-- >>> toUrlPiece $ MkQuarter 8040
532−-- "2010-q1"
533−--
534−instance ToHttpApiData Quarter where
535− toUrlPiece q = case toYearQuarter q of
536− (y, qoy) -> T.pack (show y ++ "-" ++ f qoy)
537− where
538− f Q1 = "q1"
539− f Q2 = "q2"
540− f Q3 = "q3"
541− f Q4 = "q4"
498+-- The CPP in both this function and the function after it are to avoid
499+-- exporting @nominalDiffTimeToSeconds@ and @secondsToNominalDiffTime@,
500+-- since these names are already used by @Data.Time@ from the @time@ library
501+-- starting in version @1.9.1@.
502+nominalDiffTimeToSecs :: NominalDiffTime -> F.Pico
503+nominalDiffTimeToSecs =
504+#if !MIN_VERSION_time(1,9,1)
505+ realToFrac
506+#else
507+ nominalDiffTimeToSeconds
508+#endif
542509
543−-- |
544−-- >>> import Data.Time.Calendar.Month.Compat (Month (..))
545−-- >>> MkMonth 24482
546−-- 2040-03
547−--
548−-- >>> toUrlPiece $ MkMonth 24482
549−-- "2040-03"
550−--
551−instance ToHttpApiData Month where
552− toUrlPiece = T.pack . formatTime defaultTimeLocale "%Y-%m"
510+secsToNominalDiffTime :: F.Pico -> NominalDiffTime
511+secsToNominalDiffTime =
512+#if !MIN_VERSION_time(1,9,1)
513+ realToFrac
514+#else
515+ secondsToNominalDiffTime
516+#endif
553517
554518instance ToHttpApiData NominalDiffTime where
555− toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
519+ toUrlPiece = toUrlPiece . nominalDiffTimeToSecs
556520 toEncodedUrlPiece = unsafeToEncodedUrlPiece
557521
558522instance ToHttpApiData String where toUrlPiece = T.pack
@@ -633,22 +597,7 @@ instance ToHttpApiData SetCookie where
633597 toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
634598 -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
635599
636−-- | Note: this instance is not polykinded
637−instance ToHttpApiData a => ToHttpApiData (Tagged (b :: Type) 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)
642−
643−-- | @since 0.4.2
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)
649−
650−-- | @since 0.4.2
651−instance ToHttpApiData a => ToHttpApiData (Identity a) where
600+instance ToHttpApiData a => ToHttpApiData (Tagged b a) where
652601 toUrlPiece = coerce (toUrlPiece :: a -> Text)
653602 toHeader = coerce (toHeader :: a -> ByteString)
654603 toQueryParam = coerce (toQueryParam :: a -> Text)
@@ -706,8 +655,7 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
706655instance FromHttpApiData Text where parseUrlPiece = Right
707656instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
708657
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
711659 parseUrlPiece = runReader rational
712660
713661-- |
@@ -738,43 +686,7 @@ instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime
738686-- Right 2015-10-03 00:14:24 UTC
739687instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
740688
741−-- |
742−-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek
743−-- Right Monday
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
748− where
749− m :: Map.Map Text DayOfWeek
750− m = Map.fromList [ (toUrlPiece dow, dow) | dow <- [Monday .. Sunday] ]
751−
752−
753−instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secondsToNominalDiffTime . parseUrlPiece
754−
755−-- |
756−-- >>> parseUrlPiece "2021-01" :: Either Text Month
757−-- Right 2021-01
758−instance FromHttpApiData Month where parseUrlPiece = runAtto Atto.month
759−
760−-- |
761−-- >>> parseUrlPiece "2021-q1" :: Either Text Quarter
762−-- Right 2021-Q1
763−instance FromHttpApiData Quarter where parseUrlPiece = runAtto Atto.quarter
764−
765−-- |
766−-- >>> parseUrlPiece "q2" :: Either Text QuarterOfYear
767−-- Right Q2
768−--
769−-- >>> parseUrlPiece "Q3" :: Either Text QuarterOfYear
770−-- Right Q3
771−instance FromHttpApiData QuarterOfYear where
772− parseUrlPiece t = case T.toLower t of
773− "q1" -> return Q1
774− "q2" -> return Q2
775− "q3" -> return Q3
776− "q4" -> return Q4
777− _ -> Left "Invalid quarter of year"
689+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secsToNominalDiffTime . parseUrlPiece
778690
779691instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
780692instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
@@ -839,20 +751,7 @@ instance FromHttpApiData SetCookie where
839751 parseUrlPiece = parseHeader . encodeUtf8
840752 parseHeader = Right . parseSetCookie
841753
842−-- | Note: this instance is not polykinded
843−instance FromHttpApiData a => FromHttpApiData (Tagged (b :: Type) 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)
847−
848−-- | @since 0.4.2
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)
853−
854−-- | @since 0.4.2
855−instance FromHttpApiData a => FromHttpApiData (Identity a) where
754+instance FromHttpApiData a => FromHttpApiData (Tagged b a) where
856755 parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
857756 parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
858757 parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
@@ -865,3 +764,5 @@ runAtto :: Atto.Parser a -> Text -> Either Text a
865764runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
866765 Left err -> Left (T.pack err)
867766 Right x -> Right x
767+
768+