git.iko.soy/typeable/http-api-data
on a10979b help sign in
typeable/http-api-data/src/Web/Internal/HttpApiData.hs
615 lines 23 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DeriveFunctor #-}
5{-# LANGUAGE DeriveFoldable #-}
6{-# LANGUAGE DeriveTraversable #-}
7{-# LANGUAGE FlexibleInstances #-}
8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeSynonymInstances #-}
11-- |
12-- Convert Haskell values to and from HTTP API data
13-- such as URL pieces, headers and query parameters.
14module Web.Internal.HttpApiData where
16#if __GLASGOW_HASKELL__ < 710
17import Control.Applicative
18import Data.Foldable (Foldable)
19import Data.Traversable (Traversable(traverse))
20#endif
22import Control.Arrow ((&&&), left)
23import Control.Monad ((<=<))
25import Data.Monoid
26import Data.ByteString (ByteString)
27import qualified Data.ByteString as BS
29import Data.Int
30import Data.Word
32import Data.Text (Text)
33import Data.Text.Encoding (encodeUtf8, decodeUtf8')
34import Data.Text.Read (signed, decimal, rational, Reader)
35import qualified Data.Text as T
36import qualified Data.Text.Lazy as L
38import Data.Time.Locale.Compat
39import Data.Time
40import Data.Version
42#if MIN_VERSION_base(4,8,0)
43import Data.Void
44import Numeric.Natural
45#endif
47import Text.Read (readMaybe)
48import Text.ParserCombinators.ReadP (readP_to_S)
50#if USE_TEXT_SHOW
51import TextShow (TextShow, showt)
52#endif
54import qualified Data.UUID.Types as UUID
56import Data.Typeable (Typeable)
57import Data.Data (Data)
58import qualified Data.ByteString.Builder as BS
59import qualified Network.HTTP.Types as H
62-- $setup
63-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
64-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
66-- | Convert value to HTTP API data.
67--
68-- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated
69-- instance will loop indefinitely.
70class ToHttpApiData a where
71 {-# MINIMAL toUrlPiece | toQueryParam #-}
72 -- | Convert to URL path piece.
73 toUrlPiece :: a -> Text
74 toUrlPiece = toQueryParam
76 -- | Convert to a URL path piece, making sure to encode any special chars
77 toEncodedUrlPiece :: a -> BS.Builder
78 toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece
80 -- | Convert to HTTP header value.
81 toHeader :: a -> ByteString
82 toHeader = encodeUtf8 . toUrlPiece
84 -- | Convert to query param value.
85 toQueryParam :: a -> Text
86 toQueryParam = toUrlPiece
88-- | Parse value from HTTP API data.
89--
90-- __WARNING__: Do not derive this using @DeriveAnyClass@ as the generated
91-- instance will loop indefinitely.
92class FromHttpApiData a where
93 {-# MINIMAL parseUrlPiece | parseQueryParam #-}
94 -- | Parse URL path piece.
95 parseUrlPiece :: Text -> Either Text a
96 parseUrlPiece = parseQueryParam
98 -- | Parse HTTP header value.
99 parseHeader :: ByteString -> Either Text a
100 parseHeader = parseUrlPiece <=< (left (T.pack . show) . decodeUtf8')
102 -- | Parse query param value.
103 parseQueryParam :: Text -> Either Text a
104 parseQueryParam = parseUrlPiece
106-- | Convert multiple values to a list of URL pieces.
107--
108-- >>> toUrlPieces [1, 2, 3] :: [Text]
109-- ["1","2","3"]
110toUrlPieces :: (Functor t, ToHttpApiData a) => t a -> t Text
111toUrlPieces = fmap toUrlPiece
113-- | Parse multiple URL pieces.
114--
115-- >>> parseUrlPieces ["true", "false"] :: Either Text [Bool]
116-- Right [True,False]
117-- >>> parseUrlPieces ["123", "hello", "world"] :: Either Text [Int]
118-- Left "could not parse: `hello' (input does not start with a digit)"
119parseUrlPieces :: (Traversable t, FromHttpApiData a) => t Text -> Either Text (t a)
120parseUrlPieces = traverse parseUrlPiece
122-- | Convert multiple values to a list of query parameter values.
123--
124-- >>> toQueryParams [fromGregorian 2015 10 03, fromGregorian 2015 12 01] :: [Text]
125-- ["2015-10-03","2015-12-01"]
126toQueryParams :: (Functor t, ToHttpApiData a) => t a -> t Text
127toQueryParams = fmap toQueryParam
129-- | Parse multiple query parameters.
130--
131-- >>> parseQueryParams ["1", "2", "3"] :: Either Text [Int]
132-- Right [1,2,3]
133-- >>> parseQueryParams ["64", "128", "256"] :: Either Text [Word8]
134-- Left "out of bounds: `256' (should be between 0 and 255)"
135parseQueryParams :: (Traversable t, FromHttpApiData a) => t Text -> Either Text (t a)
136parseQueryParams = traverse parseQueryParam
138-- | Parse URL path piece in a @'Maybe'@.
139--
140-- >>> parseUrlPieceMaybe "12" :: Maybe Int
141-- Just 12
142parseUrlPieceMaybe :: FromHttpApiData a => Text -> Maybe a
143parseUrlPieceMaybe = either (const Nothing) Just . parseUrlPiece
145-- | Parse HTTP header value in a @'Maybe'@.
146--
147-- >>> parseHeaderMaybe "hello" :: Maybe Text
148-- Just "hello"
149parseHeaderMaybe :: FromHttpApiData a => ByteString -> Maybe a
150parseHeaderMaybe = either (const Nothing) Just . parseHeader
152-- | Parse query param value in a @'Maybe'@.
153--
154-- >>> parseQueryParamMaybe "true" :: Maybe Bool
155-- Just True
156parseQueryParamMaybe :: FromHttpApiData a => Text -> Maybe a
157parseQueryParamMaybe = either (const Nothing) Just . parseQueryParam
159-- | Default parsing error.
160defaultParseError :: Text -> Either Text a
161defaultParseError input = Left ("could not parse: `" <> input <> "'")
163-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
164parseMaybeTextData :: (Text -> Maybe a) -> (Text -> Either Text a)
165parseMaybeTextData parse input =
166 case parse input of
167 Nothing -> defaultParseError input
168 Just val -> Right val
170#if USE_TEXT_SHOW
171-- | /Lower case/.
172--
173-- Convert to URL piece using @'TextShow'@ instance.
174-- The result is always lower cased.
175--
176-- >>> showTextData True
177-- "true"
178--
179-- This can be used as a default implementation for enumeration types:
180--
181-- @
182-- data MyData = Foo | Bar | Baz deriving (Generic)
183--
184-- instance TextShow MyData where
185-- showt = genericShowt
186--
187-- instance ToHttpApiData MyData where
188-- toUrlPiece = showTextData
189-- @
190showTextData :: TextShow a => a -> Text
191showTextData = T.toLower . showt
192#else
193-- | /Lower case/.
194--
195-- Convert to URL piece using @'Show'@ instance.
196-- The result is always lower cased.
197--
198-- >>> showTextData True
199-- "true"
200--
201-- This can be used as a default implementation for enumeration types:
202--
203-- >>> data MyData = Foo | Bar | Baz deriving (Show)
204-- >>> instance ToHttpApiData MyData where toUrlPiece = showTextData
205-- >>> toUrlPiece Foo
206-- "foo"
207showTextData :: Show a => a -> Text
208showTextData = T.toLower . showt
210-- | Like @'show'@, but returns @'Text'@.
211showt :: Show a => a -> Text
212showt = T.pack . show
213#endif
215-- | /Case insensitive/.
216--
217-- Parse given text case insensitive and then parse the rest of the input
218-- using @'parseUrlPiece'@.
219--
220-- >>> parseUrlPieceWithPrefix "Just " "just 10" :: Either Text Int
221-- Right 10
222-- >>> parseUrlPieceWithPrefix "Left " "left" :: Either Text Bool
223-- Left "could not parse: `left'"
224--
225-- This can be used to implement @'FromHttpApiData'@ for single field constructors:
226--
227-- >>> data Foo = Foo Int deriving (Show)
228-- >>> instance FromHttpApiData Foo where parseUrlPiece s = Foo <$> parseUrlPieceWithPrefix "Foo " s
229-- >>> parseUrlPiece "foo 1" :: Either Text Foo
230-- Right (Foo 1)
231parseUrlPieceWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a
232parseUrlPieceWithPrefix pattern input
233 | T.toLower pattern == T.toLower prefix = parseUrlPiece rest
234 | otherwise = defaultParseError input
235 where
236 (prefix, rest) = T.splitAt (T.length pattern) input
238-- | Parse given bytestring then parse the rest of the input using @'parseHeader'@.
239--
240-- @
241-- data BasicAuthToken = BasicAuthToken Text deriving (Show)
242--
243-- instance FromHttpApiData BasicAuthToken where
244-- parseHeader h = BasicAuthToken \<$\> parseHeaderWithPrefix "Basic " h
245-- parseQueryParam p = BasicAuthToken \<$\> parseQueryParam p
246-- @
247--
248-- >>> parseHeader "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" :: Either Text BasicAuthToken
249-- Right (BasicAuthToken "QWxhZGRpbjpvcGVuIHNlc2FtZQ==")
250parseHeaderWithPrefix :: FromHttpApiData a => ByteString -> ByteString -> Either Text a
251parseHeaderWithPrefix pattern input
252 | pattern `BS.isPrefixOf` input = parseHeader (BS.drop (BS.length pattern) input)
253 | otherwise = defaultParseError (showt input)
255-- | /Case insensitive/.
256--
257-- Parse given text case insensitive and then parse the rest of the input
258-- using @'parseQueryParam'@.
259--
260-- >>> parseQueryParamWithPrefix "z" "z10" :: Either Text Int
261-- Right 10
262parseQueryParamWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a
263parseQueryParamWithPrefix pattern input
264 | T.toLower pattern == T.toLower prefix = parseQueryParam rest
265 | otherwise = defaultParseError input
266 where
267 (prefix, rest) = T.splitAt (T.length pattern) input
269#if USE_TEXT_SHOW
270-- | /Case insensitive/.
271--
272-- Parse values case insensitively based on @'TextShow'@ instance.
273--
274-- >>> parseBoundedTextData "true" :: Either Text Bool
275-- Right True
276-- >>> parseBoundedTextData "FALSE" :: Either Text Bool
277-- Right False
278--
279-- This can be used as a default implementation for enumeration types:
280--
281-- @
282-- data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum, Generic)
283--
284-- instance TextShow MyData where
285-- showt = genericShowt
286--
287-- instance FromHttpApiData MyData where
288-- parseUrlPiece = parseBoundedTextData
289-- @
290parseBoundedTextData :: (TextShow a, Bounded a, Enum a) => Text -> Either Text a
291#else
292-- | /Case insensitive/.
293--
294-- Parse values case insensitively based on @'Show'@ instance.
295--
296-- >>> parseBoundedTextData "true" :: Either Text Bool
297-- Right True
298-- >>> parseBoundedTextData "FALSE" :: Either Text Bool
299-- Right False
300--
301-- This can be used as a default implementation for enumeration types:
302--
303-- >>> data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum)
304-- >>> instance FromHttpApiData MyData where parseUrlPiece = parseBoundedTextData
305-- >>> parseUrlPiece "foo" :: Either Text MyData
306-- Right Foo
307parseBoundedTextData :: (Show a, Bounded a, Enum a) => Text -> Either Text a
308#endif
309parseBoundedTextData = parseBoundedEnumOfI showTextData
311-- | Lookup values based on a precalculated mapping of their representations.
312lookupBoundedEnumOf :: (Bounded a, Enum a, Eq b) => (a -> b) -> b -> Maybe a
313lookupBoundedEnumOf f = flip lookup (map (f &&& id) [minBound..maxBound])
315-- | Parse values based on a precalculated mapping of their @'Text'@ representation.
316--
317-- >>> parseBoundedEnumOf toUrlPiece "true" :: Either Text Bool
318-- Right True
319--
320-- For case sensitive parser see 'parseBoundedEnumOfI'.
321parseBoundedEnumOf :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
322parseBoundedEnumOf = parseMaybeTextData . lookupBoundedEnumOf
324-- | /Case insensitive/.
325--
326-- Parse values case insensitively based on a precalculated mapping
327-- of their @'Text'@ representations.
328--
329-- >>> parseBoundedEnumOfI toUrlPiece "FALSE" :: Either Text Bool
330-- Right False
331--
332-- For case sensitive parser see 'parseBoundedEnumOf'.
333parseBoundedEnumOfI :: (Bounded a, Enum a) => (a -> Text) -> Text -> Either Text a
334parseBoundedEnumOfI f = parseBoundedEnumOf (T.toLower . f) . T.toLower
336-- | /Case insensitive/.
337--
338-- Parse values case insensitively based on @'ToHttpApiData'@ instance.
339-- Uses @'toUrlPiece'@ to get possible values.
340parseBoundedUrlPiece :: (ToHttpApiData a, Bounded a, Enum a) => Text -> Either Text a
341parseBoundedUrlPiece = parseBoundedEnumOfI toUrlPiece
343-- | /Case insensitive/.
344--
345-- Parse values case insensitively based on @'ToHttpApiData'@ instance.
346-- Uses @'toQueryParam'@ to get possible values.
347parseBoundedQueryParam :: (ToHttpApiData a, Bounded a, Enum a) => Text -> Either Text a
348parseBoundedQueryParam = parseBoundedEnumOfI toQueryParam
350-- | Parse values based on @'ToHttpApiData'@ instance.
351-- Uses @'toHeader'@ to get possible values.
352parseBoundedHeader :: (ToHttpApiData a, Bounded a, Enum a) => ByteString -> Either Text a
353parseBoundedHeader bs = case lookupBoundedEnumOf toHeader bs of
354 Nothing -> defaultParseError $ T.pack $ show bs
355 Just x -> return x
357-- | Parse URL piece using @'Read'@ instance.
358--
359-- Use for types which do not involve letters:
360--
361-- >>> readTextData "1991-06-02" :: Either Text Day
362-- Right 1991-06-02
363--
364-- This parser is case sensitive and will not match @'showTextData'@
365-- in presense of letters:
366--
367-- >>> readTextData (showTextData True) :: Either Text Bool
368-- Left "could not parse: `true'"
369--
370-- See @'parseBoundedTextData'@.
371readTextData :: Read a => Text -> Either Text a
372readTextData = parseMaybeTextData (readMaybe . T.unpack)
374-- | Run @'Reader'@ as HTTP API data parser.
375runReader :: Reader a -> Text -> Either Text a
376runReader reader input =
377 case reader input of
378 Left err -> Left ("could not parse: `" <> input <> "' (" <> T.pack err <> ")")
379 Right (x, rest)
380 | T.null rest -> Right x
381 | otherwise -> defaultParseError input
383-- | Run @'Reader'@ to parse bounded integral value with bounds checking.
384--
385-- >>> parseBounded decimal "256" :: Either Text Word8
386-- Left "out of bounds: `256' (should be between 0 and 255)"
387parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a
388parseBounded reader input = do
389 n <- runReader reader input
390 if (n > h || n < l)
391 then Left ("out of bounds: `" <> input <> "' (should be between " <> showt l <> " and " <> showt h <> ")")
392 else Right (fromInteger n)
393 where
394 l = toInteger (minBound :: a)
395 h = toInteger (maxBound :: a)
397-- |
398-- >>> toUrlPiece ()
399-- "_"
400instance ToHttpApiData () where
401 toUrlPiece () = "_"
403instance ToHttpApiData Char where toUrlPiece = T.singleton
405-- |
406-- >>> toUrlPiece (Version [1, 2, 3] [])
407-- "1.2.3"
408instance ToHttpApiData Version where
409 toUrlPiece = T.pack . showVersion
411#if MIN_VERSION_base(4,8,0)
412instance ToHttpApiData Void where toUrlPiece = absurd
413instance ToHttpApiData Natural where toUrlPiece = showt
414#endif
416instance ToHttpApiData Bool where toUrlPiece = showTextData
417instance ToHttpApiData Ordering where toUrlPiece = showTextData
419instance ToHttpApiData Double where toUrlPiece = showt
420instance ToHttpApiData Float where toUrlPiece = showt
421instance ToHttpApiData Int where toUrlPiece = showt
422instance ToHttpApiData Int8 where toUrlPiece = showt
423instance ToHttpApiData Int16 where toUrlPiece = showt
424instance ToHttpApiData Int32 where toUrlPiece = showt
425instance ToHttpApiData Int64 where toUrlPiece = showt
426instance ToHttpApiData Integer where toUrlPiece = showt
427instance ToHttpApiData Word where toUrlPiece = showt
428instance ToHttpApiData Word8 where toUrlPiece = showt
429instance ToHttpApiData Word16 where toUrlPiece = showt
430instance ToHttpApiData Word32 where toUrlPiece = showt
431instance ToHttpApiData Word64 where toUrlPiece = showt
433-- |
434-- >>> toUrlPiece (fromGregorian 2015 10 03)
435-- "2015-10-03"
436instance ToHttpApiData Day where toUrlPiece = T.pack . show
438timeToUrlPiece :: FormatTime t => String -> t -> Text
439timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))
441-- |
442-- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)
443-- "2015-10-03T14:55:01"
444instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S"
446-- |
447-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc
448-- "2015-10-03T14:55:01+0000"
449instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z"
451-- |
452-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864
453-- "2015-10-03T00:14:24Z"
454instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ"
456instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer)
458instance ToHttpApiData String where toUrlPiece = T.pack
459instance ToHttpApiData Text where toUrlPiece = id
460instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
462instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
463instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
465instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual
466instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum
467instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct
468instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst
469instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast
471-- |
472-- >>> toUrlPiece (Just "Hello")
473-- "just Hello"
474instance ToHttpApiData a => ToHttpApiData (Maybe a) where
475 toUrlPiece (Just x) = "just " <> toUrlPiece x
476 toUrlPiece Nothing = "nothing"
478-- |
479-- >>> toUrlPiece (Left "err" :: Either String Int)
480-- "left err"
481-- >>> toUrlPiece (Right 3 :: Either String Int)
482-- "right 3"
483instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
484 toUrlPiece (Left x) = "left " <> toUrlPiece x
485 toUrlPiece (Right x) = "right " <> toUrlPiece x
487-- |
488-- >>> parseUrlPiece "_" :: Either Text ()
489-- Right ()
490instance FromHttpApiData () where
491 parseUrlPiece "_" = pure ()
492 parseUrlPiece s = defaultParseError s
494instance FromHttpApiData Char where
495 parseUrlPiece s =
496 case T.uncons s of
497 Just (c, s') | T.null s' -> pure c
498 _ -> defaultParseError s
500-- |
501-- >>> showVersion <$> parseUrlPiece "1.2.3"
502-- Right "1.2.3"
503instance FromHttpApiData Version where
504 parseUrlPiece s =
505 case reverse (readP_to_S parseVersion (T.unpack s)) of
506 ((x, ""):_) -> pure x
507 _ -> defaultParseError s
509#if MIN_VERSION_base(4,8,0)
510-- | Parsing a @'Void'@ value is always an error, considering @'Void'@ as a data type with no constructors.
511instance FromHttpApiData Void where
512 parseUrlPiece _ = Left "Void cannot be parsed!"
514instance FromHttpApiData Natural where
515 parseUrlPiece s = do
516 n <- runReader (signed decimal) s
517 if n < 0
518 then Left ("underflow: " <> s <> " (should be a non-negative integer)")
519 else Right (fromInteger n)
520#endif
522instance FromHttpApiData Bool where parseUrlPiece = parseBoundedUrlPiece
523instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedUrlPiece
524instance FromHttpApiData Double where parseUrlPiece = runReader rational
525instance FromHttpApiData Float where parseUrlPiece = runReader rational
526instance FromHttpApiData Int where parseUrlPiece = parseBounded (signed decimal)
527instance FromHttpApiData Int8 where parseUrlPiece = parseBounded (signed decimal)
528instance FromHttpApiData Int16 where parseUrlPiece = parseBounded (signed decimal)
529instance FromHttpApiData Int32 where parseUrlPiece = parseBounded (signed decimal)
530instance FromHttpApiData Int64 where parseUrlPiece = parseBounded (signed decimal)
531instance FromHttpApiData Integer where parseUrlPiece = runReader (signed decimal)
532instance FromHttpApiData Word where parseUrlPiece = parseBounded decimal
533instance FromHttpApiData Word8 where parseUrlPiece = parseBounded decimal
534instance FromHttpApiData Word16 where parseUrlPiece = parseBounded decimal
535instance FromHttpApiData Word32 where parseUrlPiece = parseBounded decimal
536instance FromHttpApiData Word64 where parseUrlPiece = parseBounded decimal
537instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
538instance FromHttpApiData Text where parseUrlPiece = Right
539instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
541-- |
542-- >>> toGregorian <$> parseUrlPiece "2016-12-01"
543-- Right (2016,12,1)
544instance FromHttpApiData Day where parseUrlPiece = readTextData
546timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t
547timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack)
548 where
549 timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt))
551-- |
552-- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime
553-- Right 2015-10-03 14:55:01
554instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S"
556-- |
557-- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime
558-- Right 2015-10-03 14:55:01 +0000
559instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z"
561-- |
562-- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime
563-- Right 2015-10-03 00:14:24 UTC
564instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ"
566instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece
568instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
569instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
571instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece
572instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece
573instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece
574instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece
575instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece
577-- |
578-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
579-- Right (Just 123)
580instance FromHttpApiData a => FromHttpApiData (Maybe a) where
581 parseUrlPiece s
582 | T.toLower (T.take 7 s) == "nothing" = pure Nothing
583 | otherwise = Just <$> parseUrlPieceWithPrefix "Just " s
585-- |
586-- >>> parseUrlPiece "Right 123" :: Either Text (Either String Int)
587-- Right (Right 123)
588instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b) where
589 parseUrlPiece s =
590 Right <$> parseUrlPieceWithPrefix "Right " s
591 <!> Left <$> parseUrlPieceWithPrefix "Left " s
592 where
593 infixl 3 <!>
594 Left _ <!> y = y
595 x <!> _ = x
597instance ToHttpApiData UUID.UUID where
598 toUrlPiece = UUID.toText
599 toHeader = UUID.toASCIIBytes
601instance FromHttpApiData UUID.UUID where
602 parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText
603 parseHeader = maybe (Left "invalid UUID") Right . UUID.fromASCIIBytes
606-- | Lenient parameters. 'FromHttpApiData' combinators always return `Right`.
607--
608-- @since 0.3.5
609newtype LenientData a = LenientData { getLenientData :: Either Text a }
610 deriving (Eq, Ord, Show, Read, Typeable, Data, Functor, Foldable, Traversable)
612instance FromHttpApiData a => FromHttpApiData (LenientData a) where
613 parseUrlPiece = Right . LenientData . parseUrlPiece
614 parseHeader = Right . LenientData . parseHeader
615 parseQueryParam = Right . LenientData . parseQueryParam