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