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