@@ -1,86 +1,56 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
2+{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFoldable #-}
5−{-# LANGUAGE DeriveFunctor #-}
6−{-# LANGUAGE DeriveTraversable #-}
7−{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FlexibleInstances #-}
8−{-# LANGUAGE KindSignatures #-}
9−{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TypeSynonymInstances #-}
6{-# LANGUAGE TypeSynonymInstances #-}
14-- Convert Haskell values to and from HTTP API data
8-- Convert Haskell values to and from HTTP API data
15-- such as URL pieces, headers and query parameters.
9-- such as URL pieces, headers and query parameters.
16module Web.Internal.HttpApiData where
10module Web.Internal.HttpApiData where
18−import Prelude ()
12+#if __GLASGOW_HASKELL__ < 710
21−import Control.Applicative (Const(Const))
13+import Control.Applicative
14+import Data.Traversable (Traversable(traverse))
22−import Control.Arrow (left, (&&&))
17+import Control.Arrow ((&&&), left)
23−import Control.Monad ((<=<))
18+import Control.Monad ((<=<))
24−import qualified Data.Attoparsec.Text as Atto
19+
25−import qualified Data.Attoparsec.Time as Atto
20+import Data.Monoid
26−import Data.ByteString (ByteString)
21+import Data.ByteString (ByteString)
27−import qualified Data.ByteString as BS
22+import qualified Data.ByteString as BS
28−import qualified Data.ByteString.Builder as BS
23+
29−import qualified Data.ByteString.Lazy as LBS
24+import Data.Int
30−import Data.Coerce (coerce)
25+import Data.Word
31−import Data.Data (Data)
26+
32−import qualified Data.Fixed as F
27+import Data.Text (Text)
33−import Data.Functor.Identity (Identity(Identity))
34−import Data.Int (Int16, Int32, Int64, Int8)
35−import Data.Kind (Type)
36−import qualified Data.Map as Map
37−import Data.Monoid (All (..), Any (..), Dual (..),
38− First (..), Last (..),
39− Product (..), Sum (..))
40−import Data.Semigroup (Semigroup (..))
41−import qualified Data.Semigroup as Semi
42−import Data.Tagged (Tagged (..))
43−import Data.Text (Text)
44−import qualified Data.Text as T
28+import Data.Text.Encoding (encodeUtf8, decodeUtf8')
45−import Data.Text.Encoding (decodeUtf8', decodeUtf8With,
47−import Data.Text.Encoding.Error (lenientDecode)
48−import qualified Data.Text.Lazy as L
49−import Data.Text.Read (Reader, decimal, rational,
29+import Data.Text.Read (signed, decimal, rational, Reader)
50− signed)
30+import qualified Data.Text as T
51−import Data.Time.Compat (Day, FormatTime, LocalTime,
31+import qualified Data.Text.Lazy as L
52− NominalDiffTime, TimeOfDay,
32+
53− UTCTime, ZonedTime, formatTime,
55− nominalDiffTimeToSeconds,
56− secondsToNominalDiffTime)
57−import Data.Time.Format.Compat (defaultTimeLocale,
59−import Data.Time.Calendar.Month.Compat (Month)
33+import Data.Time.Locale.Compat
60−import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
34+import Data.Time
62−import Data.Typeable (Typeable)
63−import qualified Data.UUID.Types as UUID
64−import Data.Version (Version, parseVersion,
35+import Data.Version
66−import Data.Void (Void, absurd)
37+#if MIN_VERSION_base(4,8,0)
67−import Data.Word (Word16, Word32, Word64, Word8)
38+import Data.Void
68−import qualified Network.HTTP.Types as H
69−import Numeric.Natural (Natural)
39+import Numeric.Natural
42+import Text.Read (readMaybe)
70−import Text.ParserCombinators.ReadP (readP_to_S)
43+import Text.ParserCombinators.ReadP (readP_to_S)
71−import Text.Read (readMaybe)
72−import Web.Cookie (SetCookie, parseSetCookie,
75#if USE_TEXT_SHOW
45#if USE_TEXT_SHOW
76−import TextShow (TextShow, showt)
46+import TextShow (TextShow, showt)
49+import qualified Data.UUID.Types as UUID
80-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
52-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
81-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
53-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
82−-- >>> import Data.Time.Compat
83−-- >>> import Data.Version
85-- | Convert value to HTTP API data.
55-- | Convert value to HTTP API data.
@@ -92,12 +62,6 @@ class ToHttpApiData a where
92 toUrlPiece :: a -> Text
62 toUrlPiece :: a -> Text
93 toUrlPiece = toQueryParam
63 toUrlPiece = toQueryParam
95− -- | Convert to a URL path piece, making sure to encode any special chars.
96− -- The default definition uses 'H.encodePathSegmentsRelative',
97− -- but this may be overriden with a more efficient version.
98− toEncodedUrlPiece :: a -> BS.Builder
99− toEncodedUrlPiece = H.urlEncodeBuilder True . encodeUtf8 . toUrlPiece
101 -- | Convert to HTTP header value.
65 -- | Convert to HTTP header value.
102 toHeader :: a -> ByteString
66 toHeader :: a -> ByteString
103 toHeader = encodeUtf8 . toUrlPiece
67 toHeader = encodeUtf8 . toUrlPiece
@@ -338,7 +302,7 @@ lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound])
338-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
302-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
339-- Right True
303-- Right True
341−-- For case insensitive parser see 'parseBoundedEnumOfI'.
305+-- For case sensitive parser see 'parseBoundedEnumOfI'.
342parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
306parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
343parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
307parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
@@ -383,7 +347,7 @@ parseBoundedHeader bs = case lookupBoundedEnumOf toHeader bs of
383-- Right 1991-06-02
347-- Right 1991-06-02
385-- This parser is case sensitive and will not match @'showTextData'@
349-- This parser is case sensitive and will not match @'showTextData'@
386−-- in presence of letters:
350+-- in presense of letters:
388-- >>> readTextData (showTextData True) :: Either Text Bool
352-- >>> readTextData (showTextData True) :: Either Text Bool
389-- Left "could not parse: `true'"
353-- Left "could not parse: `true'"
@@ -415,193 +379,79 @@ parseBounded reader input = do
415 l = toInteger (minBound :: a)
379 l = toInteger (minBound :: a)
416 h = toInteger (maxBound :: a)
380 h = toInteger (maxBound :: a)
418−-- | Convert to a URL-encoded path piece using 'toUrlPiece'.
419−-- /Note/: this function does not check if the result contains unescaped characters!
420−-- This function can be used to override 'toEncodedUrlPiece' as a more efficient implementation
421−-- when the resulting URL piece /never/ has to be escaped.
422−unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder
423−unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece
426-- >>> toUrlPiece ()
383-- >>> toUrlPiece ()
428instance ToHttpApiData () where
385instance ToHttpApiData () where
429 toUrlPiece () = "_"
386 toUrlPiece () = "_"
430− toEncodedUrlPiece = unsafeToEncodedUrlPiece
432−instance ToHttpApiData Char where
388+instance ToHttpApiData Char where toUrlPiece = T.singleton
433− toUrlPiece = T.singleton
436-- >>> toUrlPiece (Version [1, 2, 3] [])
391-- >>> toUrlPiece (Version [1, 2, 3] [])
437-- "1.2.3"
392-- "1.2.3"
438instance ToHttpApiData Version where
393instance ToHttpApiData Version where
439 toUrlPiece = T.pack . showVersion
394 toUrlPiece = T.pack . showVersion
440− toEncodedUrlPiece = unsafeToEncodedUrlPiece
396+#if MIN_VERSION_base(4,8,0)
442instance ToHttpApiData Void where toUrlPiece = absurd
397instance ToHttpApiData Void where toUrlPiece = absurd
443−instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
398+instance ToHttpApiData Natural where toUrlPiece = showt
445−instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
401+instance ToHttpApiData Bool where toUrlPiece = showTextData
446−instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece
402+instance ToHttpApiData Ordering where toUrlPiece = showTextData
448−instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
404+instance ToHttpApiData Double where toUrlPiece = showt
449−instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
405+instance ToHttpApiData Float where toUrlPiece = showt
450−instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
406+instance ToHttpApiData Int where toUrlPiece = showt
451−instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
407+instance ToHttpApiData Int8 where toUrlPiece = showt
452−instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
408+instance ToHttpApiData Int16 where toUrlPiece = showt
453−instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
409+instance ToHttpApiData Int32 where toUrlPiece = showt
454−instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
410+instance ToHttpApiData Int64 where toUrlPiece = showt
455−instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
411+instance ToHttpApiData Integer where toUrlPiece = showt
456−instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
412+instance ToHttpApiData Word where toUrlPiece = showt
457−instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
413+instance ToHttpApiData Word8 where toUrlPiece = showt
458−instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
414+instance ToHttpApiData Word16 where toUrlPiece = showt
459−instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
415+instance ToHttpApiData Word32 where toUrlPiece = showt
460−instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
416+instance ToHttpApiData Word64 where toUrlPiece = showt
462−-- | Note: this instance is not polykinded
463−instance F.HasResolution a => ToHttpApiData (F.Fixed (a :: Type)) where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece
466-- >>> toUrlPiece (fromGregorian 2015 10 03)
419-- >>> toUrlPiece (fromGregorian 2015 10 03)
467-- "2015-10-03"
420-- "2015-10-03"
468−instance ToHttpApiData Day where
421+instance ToHttpApiData Day where toUrlPiece = T.pack . show
469− toUrlPiece = T.pack . show
470− toEncodedUrlPiece = unsafeToEncodedUrlPiece
472timeToUrlPiece :: FormatTime t => String -> t -> Text
423timeToUrlPiece :: FormatTime t => String -> t -> Text
473timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
424timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
476−-- >>> toUrlPiece $ TimeOfDay 14 55 23.1
478−instance ToHttpApiData TimeOfDay where
479− toUrlPiece = T.pack . formatTime defaultTimeLocale "%H:%M:%S%Q"
480− toEncodedUrlPiece = unsafeToEncodedUrlPiece
483−-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 21.687)
427+-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)
484−-- "2015-10-03T14:55:21.687"
428+-- "2015-10-03T14:55:01"
485−instance ToHttpApiData LocalTime where
429+instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S"
486− toUrlPiece = timeToUrlPiece "%H:%M:%S%Q"
487− toEncodedUrlPiece = unsafeToEncodedUrlPiece
490−-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) utc
432+-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc
491−-- "2015-10-03T14:55:51.001+0000"
433+-- "2015-10-03T14:55:01+0000"
492−instance ToHttpApiData ZonedTime where
434+instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z"
493− toUrlPiece = timeToUrlPiece "%H:%M:%S%Q%z"
494− toEncodedUrlPiece = unsafeToEncodedUrlPiece
497−-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864.5
437+-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864
498−-- "2015-10-03T00:14:24.5Z"
438+-- "2015-10-03T00:14:24Z"
499−instance ToHttpApiData UTCTime where
439+instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ"
500− toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"
501− toEncodedUrlPiece = unsafeToEncodedUrlPiece
503−-- |
441+instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)
504−-- >>> toUrlPiece 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"
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)
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"
554−instance ToHttpApiData NominalDiffTime where
555− toUrlPiece = toUrlPiece . nominalDiffTimeToSeconds
556− toEncodedUrlPiece = unsafeToEncodedUrlPiece
558instance ToHttpApiData String where toUrlPiece = T.pack
443instance ToHttpApiData String where toUrlPiece = T.pack
559instance ToHttpApiData Text where toUrlPiece = id
444instance ToHttpApiData Text where toUrlPiece = id
560instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
445instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
562−instance ToHttpApiData All where
447+instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
563− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
564− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
566−instance ToHttpApiData Any where
448+instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
567− toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
568− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
570−instance ToHttpApiData a => ToHttpApiData (Dual a) where
571− toUrlPiece = coerce (toUrlPiece :: a -> Text)
572− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
574−instance ToHttpApiData a => ToHttpApiData (Sum a) where
575− toUrlPiece = coerce (toUrlPiece :: a -> Text)
576− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
578−instance ToHttpApiData a => ToHttpApiData (Product a) where
450+instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual
579− toUrlPiece = coerce (toUrlPiece :: a -> Text)
451+instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum
580− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
452+instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct
582−instance ToHttpApiData a => ToHttpApiData (First a) where
453+instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst
583− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
584− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
586−instance ToHttpApiData a => ToHttpApiData (Last a) where
587− toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
588− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
590−instance ToHttpApiData a => ToHttpApiData (Semi.Min a) where
591− toUrlPiece = coerce (toUrlPiece :: a -> Text)
592− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
594−instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where
454+instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast
595− toUrlPiece = coerce (toUrlPiece :: a -> Text)
596− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
598−instance ToHttpApiData a => ToHttpApiData (Semi.First a) where
599− toUrlPiece = coerce (toUrlPiece :: a -> Text)
600− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
602−instance ToHttpApiData a => ToHttpApiData (Semi.Last a) where
603− toUrlPiece = coerce (toUrlPiece :: a -> Text)
604− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
607-- >>> toUrlPiece (Just "Hello")
457-- >>> toUrlPiece (Just "Hello")
@@ -619,41 +469,6 @@ instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
619 toUrlPiece (Left x) = "left " <> toUrlPiece x
469 toUrlPiece (Left x) = "left " <> toUrlPiece x
620 toUrlPiece (Right x) = "right " <> toUrlPiece x
470 toUrlPiece (Right x) = "right " <> toUrlPiece x
622−-- | /Note:/ this instance works correctly for alphanumeric name and value
624−-- >>> let Right c = parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie
626−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"
629−-- "SESSID=r2t5uvjq435r4q7ib3vtdjq120"
631−instance ToHttpApiData SetCookie where
632− toUrlPiece = decodeUtf8With lenientDecode . toHeader
633− toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
634− -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
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)
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)
653− toHeader = coerce (toHeader :: a -> ByteString)
654− toQueryParam = coerce (toQueryParam :: a -> Text)
655− toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
658-- >>> parseUrlPiece "_" :: Either Text ()
473-- >>> parseUrlPiece "_" :: Either Text ()
659-- Right ()
474-- Right ()
@@ -665,7 +480,7 @@ instance FromHttpApiData Char where
665 parseUrlPiece s =
480 parseUrlPiece s =
666 case T.uncons s of
481 case T.uncons s of
667 Just (c, s') | T.null s' -> pure c
482 Just (c, s') | T.null s' -> pure c
668− _ -> defaultParseError s
483+ _ -> defaultParseError s
671-- >>> showVersion <$> parseUrlPiece "1.2.3"
486-- >>> showVersion <$> parseUrlPiece "1.2.3"
@@ -676,6 +491,7 @@ instance FromHttpApiData Version where
676 ((x, ""):_) -> pure x
491 ((x, ""):_) -> pure x
677 _ -> defaultParseError s
492 _ -> defaultParseError s
494+#if MIN_VERSION_base(4,8,0)
679-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
495-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
680instance FromHttpApiData Void where
496instance FromHttpApiData Void where
681 parseUrlPiece _ = Left "Void cannot be parsed!"
497 parseUrlPiece _ = Left "Void cannot be parsed!"
@@ -684,8 +500,9 @@ instance FromHttpApiData Natural where
684 parseUrlPiece s = do
500 parseUrlPiece s = do
685 n <- runReader (signed decimal) s
501 n <- runReader (signed decimal) s
687− then Left ("underflow: " <> s <> " (should be a non-negative integer)")
503+ then Left ("undeflow: " <> s <> " (should be a non-negative integer)")
688 else Right (fromInteger n)
504 else Right (fromInteger n)
690instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
507instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
691instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece
508instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece
@@ -706,89 +523,41 @@ instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
706instance FromHttpApiData Text where parseUrlPiece = Right
523instance FromHttpApiData Text where parseUrlPiece = Right
707instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
524instance 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
711− parseUrlPiece = runReader rational
714-- >>> toGregorian <$> parseUrlPiece "2016-12-01"
527-- >>> toGregorian <$> parseUrlPiece "2016-12-01"
715-- Right (2016,12,1)
528-- Right (2016,12,1)
716−instance FromHttpApiData Day where parseUrlPiece = runAtto Atto.day
529+instance FromHttpApiData Day where parseUrlPiece = readTextData
718−-- |
531+timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t
719−-- >>> parseUrlPiece "14:55:01.333" :: Either Text TimeOfDay
532+timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack)
720−-- Right 14:55:01.333
533+ where
721−instance FromHttpApiData TimeOfDay where parseUrlPiece = runAtto Atto.timeOfDay
534+ timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt))
724-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime
537-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime
725-- Right 2015-10-03 14:55:01
538-- Right 2015-10-03 14:55:01
726−instance FromHttpApiData LocalTime where parseUrlPiece = runAtto Atto.localTime
539+instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S"
729-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime
542-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime
730-- Right 2015-10-03 14:55:01 +0000
543-- Right 2015-10-03 14:55:01 +0000
732−-- >>> parseQueryParam "2016-12-31T01:00:00Z" :: Either Text ZonedTime
733−-- Right 2016-12-31 01:00:00 +0000
734−instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime
544+instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z"
737-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime
547-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime
738-- Right 2015-10-03 00:14:24 UTC
548-- Right 2015-10-03 00:14:24 UTC
739−instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
549+instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ"
742−-- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek
744−instance FromHttpApiData DayOfWeek where
551+instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece
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] ]
553+instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
554+instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
753−instance 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"
779−instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
780−instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
782−instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
783−instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
556+instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece
784−instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
557+instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece
785−instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
558+instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece
786−instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
788−instance FromHttpApiData a => FromHttpApiData (Semi.Min a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
789−instance FromHttpApiData a => FromHttpApiData (Semi.Max a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
559+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece
790−instance FromHttpApiData a => FromHttpApiData (Semi.First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
791−instance FromHttpApiData a => FromHttpApiData (Semi.Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
560+instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece
794-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
563-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
@@ -813,55 +582,7 @@ instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b)
813instance ToHttpApiData UUID.UUID where
582instance ToHttpApiData UUID.UUID where
814 toUrlPiece = UUID.toText
583 toUrlPiece = UUID.toText
815 toHeader = UUID.toASCIIBytes
584 toHeader = UUID.toASCIIBytes
816− toEncodedUrlPiece = unsafeToEncodedUrlPiece
818instance FromHttpApiData UUID.UUID where
586instance FromHttpApiData UUID.UUID where
819 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
587 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
820 parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
588 parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
823−-- | Lenient parameters. 'FromHttpApiData' combinators always return `Right`.
826−newtype LenientData a = LenientData { getLenientData :: Either Text a }
827− deriving (Eq, Ord, Show, Read, Typeable, Data, Functor, Foldable, Traversable)
829−instance FromHttpApiData a => FromHttpApiData (LenientData a) where
830− parseUrlPiece = Right . LenientData . parseUrlPiece
831− parseHeader = Right . LenientData . parseHeader
832− parseQueryParam = Right . LenientData . parseQueryParam
834−-- | /Note:/ this instance works correctly for alphanumeric name and value
836−-- >>> parseUrlPiece "SESSID=r2t5uvjq435r4q7ib3vtdjq120" :: Either Text SetCookie
837−-- Right (SetCookie {setCookieName = "SESSID", setCookieValue = "r2t5uvjq435r4q7ib3vtdjq120", setCookiePath = Nothing, setCookieExpires = Nothing, setCookieMaxAge = Nothing, setCookieDomain = Nothing, setCookieHttpOnly = False, setCookieSecure = False, setCookieSameSite = Nothing})
838−instance FromHttpApiData SetCookie where
839− parseUrlPiece = parseHeader . encodeUtf8
840− parseHeader = Right . parseSetCookie
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)
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)
857− parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
858− parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
860−-------------------------------------------------------------------------------
861−-- Attoparsec helpers
862−-------------------------------------------------------------------------------
864−runAtto :: Atto.Parser a -> Text -> Either Text a
865−runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
866− Left err -> Left (T.pack err)