git.iko.soy/typeable/http-api-data
on master help sign in
Encode in lowercase, decode case insensitive
61926eaNickolay Kudasov
Web/HttpApiData.hs+74−50
compare with master
unifiedsplit
@@ -16,13 +16,14 @@ module Web.HttpApiData (
16 FromHttpApiData (..),
16 FromHttpApiData (..),
17
17
18 -- * Utility functions
18 -- * Utility functions
19− parseMaybeHttpApiData,
19+ parseMaybeTextData,
20− showUrlPiece,
20+ showTextData,
21− readMaybeUrlPiece,
21+ readMaybeTextData,
22− readEitherUrlPiece,
22+ readEitherTextData,
23) where
23) where
24
24
25import Control.Applicative
25import Control.Applicative
26+import Control.Arrow ((&&&))
26
27
27import Data.Monoid
28import Data.Monoid
28import Data.ByteString (ByteString)
29import Data.ByteString (ByteString)
@@ -87,23 +88,47 @@ defaultParseError :: Text -> Either Text a
87defaultParseError input = Left ("could not convert: `" <> input <> "'")
88defaultParseError input = Left ("could not convert: `" <> input <> "'")
88
89
89-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
90-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
90−parseMaybeHttpApiData :: (Text -> Maybe a) -> (Text -> Either Text a)
91+parseMaybeTextData :: (Text -> Maybe a) -> (Text -> Either Text a)
91−parseMaybeHttpApiData parse input =
92+parseMaybeTextData parse input =
92 case parse input of
93 case parse input of
93 Nothing -> defaultParseError input
94 Nothing -> defaultParseError input
94 Just val -> Right val
95 Just val -> Right val
95
96
96-- | Convert to URL piece using @'Show'@ instance.
97-- | Convert to URL piece using @'Show'@ instance.
97−showUrlPiece :: Show a => a -> Text
98+showTextData :: Show a => a -> Text
98−showUrlPiece = T.pack . show
99+showTextData = T.toLower . T.pack . show
100+
101+-- | Parse given text case insensitive and return the rest of the input.
102+--
103+-- >>> parseUrlPieceWithPrefix "Just " "just 10" :: Either Text Int
104+-- Right 10
105+-- >>> parseUrlPieceWithPrefix "Left " "left" :: Either Text Bool
106+-- Left "could not convert: `left'"
107+parseUrlPieceWithPrefix :: FromHttpApiData a => Text -> Text -> Either Text a
108+parseUrlPieceWithPrefix pattern input
109+ | T.toLower pattern == T.toLower prefix = parseUrlPiece rest
110+ | otherwise = defaultParseError input
111+ where
112+ (prefix, rest) = T.splitAt (T.length pattern) input
113+
114+-- | Parse values case insensitively based on @'Show'@ instance.
115+--
116+-- >>> parseBoundedCaseInsensitiveTextData "true" :: Either Text Bool
117+-- Right True
118+-- >>> parseBoundedCaseInsensitiveTextData "FALSE" :: Either Text Bool
119+-- Right False
120+parseBoundedCaseInsensitiveTextData :: forall a. (Show a, Bounded a, Enum a) => Text -> Either Text a
121+parseBoundedCaseInsensitiveTextData = parseMaybeTextData (flip lookup values . T.toLower)
122+ where
123+ values = map (showTextData &&& id) [minBound..maxBound :: a]
99
124
100-- | Parse URL piece using @'Read'@ instance.
125-- | Parse URL piece using @'Read'@ instance.
101−readMaybeUrlPiece :: Read a => Text -> Maybe a
126+readMaybeTextData :: Read a => Text -> Maybe a
102−readMaybeUrlPiece = readMaybe . T.unpack
127+readMaybeTextData = readMaybe . T.unpack
103
128
104-- | Parse URL piece using @'Read'@ instance.
129-- | Parse URL piece using @'Read'@ instance.
105−readEitherUrlPiece :: Read a => Text -> Either Text a
130+readEitherTextData :: Read a => Text -> Either Text a
106−readEitherUrlPiece = parseMaybeHttpApiData readMaybeUrlPiece
131+readEitherTextData = parseMaybeTextData readMaybeTextData
107
132
108-- | Run @'Reader'@ as HTTP API data parser.
133-- | Run @'Reader'@ as HTTP API data parser.
109runReader :: Reader a -> Text -> Either Text a
134runReader :: Reader a -> Text -> Either Text a
@@ -144,25 +169,25 @@ instance ToHttpApiData Void where
144 toUrlPiece = absurd
169 toUrlPiece = absurd
145#endif
170#endif
146
171
147−instance ToHttpApiData Bool where toUrlPiece = showUrlPiece
172+instance ToHttpApiData Bool where toUrlPiece = showTextData
148−instance ToHttpApiData Ordering where toUrlPiece = showUrlPiece
173+instance ToHttpApiData Ordering where toUrlPiece = showTextData
149−instance ToHttpApiData Double where toUrlPiece = showUrlPiece
174+instance ToHttpApiData Double where toUrlPiece = showTextData
150−instance ToHttpApiData Float where toUrlPiece = showUrlPiece
175+instance ToHttpApiData Float where toUrlPiece = showTextData
151−instance ToHttpApiData Int where toUrlPiece = showUrlPiece
176+instance ToHttpApiData Int where toUrlPiece = showTextData
152−instance ToHttpApiData Int8 where toUrlPiece = showUrlPiece
177+instance ToHttpApiData Int8 where toUrlPiece = showTextData
153−instance ToHttpApiData Int16 where toUrlPiece = showUrlPiece
178+instance ToHttpApiData Int16 where toUrlPiece = showTextData
154−instance ToHttpApiData Int32 where toUrlPiece = showUrlPiece
179+instance ToHttpApiData Int32 where toUrlPiece = showTextData
155−instance ToHttpApiData Int64 where toUrlPiece = showUrlPiece
180+instance ToHttpApiData Int64 where toUrlPiece = showTextData
156−instance ToHttpApiData Integer where toUrlPiece = showUrlPiece
181+instance ToHttpApiData Integer where toUrlPiece = showTextData
157−instance ToHttpApiData Word where toUrlPiece = showUrlPiece
182+instance ToHttpApiData Word where toUrlPiece = showTextData
158−instance ToHttpApiData Word8 where toUrlPiece = showUrlPiece
183+instance ToHttpApiData Word8 where toUrlPiece = showTextData
159−instance ToHttpApiData Word16 where toUrlPiece = showUrlPiece
184+instance ToHttpApiData Word16 where toUrlPiece = showTextData
160−instance ToHttpApiData Word32 where toUrlPiece = showUrlPiece
185+instance ToHttpApiData Word32 where toUrlPiece = showTextData
161−instance ToHttpApiData Word64 where toUrlPiece = showUrlPiece
186+instance ToHttpApiData Word64 where toUrlPiece = showTextData
162instance ToHttpApiData String where toUrlPiece = T.pack
187instance ToHttpApiData String where toUrlPiece = T.pack
163instance ToHttpApiData Text where toUrlPiece = id
188instance ToHttpApiData Text where toUrlPiece = id
164instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
189instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
165−instance ToHttpApiData Day where toUrlPiece = showUrlPiece
190+instance ToHttpApiData Day where toUrlPiece = showTextData
166
191
167instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
192instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
168instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
193instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
@@ -175,19 +200,19 @@ instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPi
175
200
176-- |
201-- |
177-- >>> toUrlPiece (Just "Hello")
202-- >>> toUrlPiece (Just "Hello")
178−-- "Just Hello"
203+-- "just Hello"
179instance ToHttpApiData a => ToHttpApiData (Maybe a) where
204instance ToHttpApiData a => ToHttpApiData (Maybe a) where
180− toUrlPiece (Just x) = "Just " <> toUrlPiece x
205+ toUrlPiece (Just x) = "just " <> toUrlPiece x
181− toUrlPiece Nothing = "Nothing"
206+ toUrlPiece Nothing = "nothing"
182
207
183-- |
208-- |
184-- >>> toUrlPiece (Left "err" :: Either String Int)
209-- >>> toUrlPiece (Left "err" :: Either String Int)
185−-- "Left err"
210+-- "left err"
186-- >>> toUrlPiece (Right 3 :: Either String Int)
211-- >>> toUrlPiece (Right 3 :: Either String Int)
187−-- "Right 3"
212+-- "right 3"
188instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
213instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
189− toUrlPiece (Left x) = "Left " <> toUrlPiece x
214+ toUrlPiece (Left x) = "left " <> toUrlPiece x
190− toUrlPiece (Right x) = "Right " <> toUrlPiece x
215+ toUrlPiece (Right x) = "right " <> toUrlPiece x
191
216
192-- |
217-- |
193-- >>> parseUrlPiece "_" :: Either Text ()
218-- >>> parseUrlPiece "_" :: Either Text ()
@@ -216,8 +241,8 @@ instance FromHttpApiData Void where
216 parseUrlPiece _ = Left "Void cannot be parsed!"
241 parseUrlPiece _ = Left "Void cannot be parsed!"
217#endif
242#endif
218
243
219−instance FromHttpApiData Bool where parseUrlPiece = readEitherUrlPiece
244+instance FromHttpApiData Bool where parseUrlPiece = parseBoundedCaseInsensitiveTextData
220−instance FromHttpApiData Ordering where parseUrlPiece = readEitherUrlPiece
245+instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedCaseInsensitiveTextData
221instance FromHttpApiData Double where parseUrlPiece = runReader rational
246instance FromHttpApiData Double where parseUrlPiece = runReader rational
222instance FromHttpApiData Float where parseUrlPiece = runReader rational
247instance FromHttpApiData Float where parseUrlPiece = runReader rational
223instance FromHttpApiData Int where parseUrlPiece = parseBounded (signed decimal)
248instance FromHttpApiData Int where parseUrlPiece = parseBounded (signed decimal)
@@ -234,7 +259,7 @@ instance FromHttpApiData Word64 where parseUrlPiece = parseBounded decimal
234instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
259instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
235instance FromHttpApiData Text where parseUrlPiece = Right
260instance FromHttpApiData Text where parseUrlPiece = Right
236instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
261instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
237−instance FromHttpApiData Day where parseUrlPiece = readEitherUrlPiece
262+instance FromHttpApiData Day where parseUrlPiece = readEitherTextData
238
263
239instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
264instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
240instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
265instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
@@ -249,30 +274,29 @@ instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece =
249-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
274-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
250-- Right (Just 123)
275-- Right (Just 123)
251instance FromHttpApiData a => FromHttpApiData (Maybe a) where
276instance FromHttpApiData a => FromHttpApiData (Maybe a) where
252− parseUrlPiece "Nothing" = return Nothing
277+ parseUrlPiece s
253− parseUrlPiece s =
278+ | T.toLower (T.take 7 s) == "nothing" = return Nothing
254− case T.stripPrefix "Just " s of
279+ | otherwise = Just <$> parseUrlPieceWithPrefix "Just " s
255− Nothing -> defaultParseError s
256− Just x -> Just <$> parseUrlPiece x
257
280
258-- |
281-- |
259-- >>> parseUrlPiece "Right 123" :: Either Text (Either String Int)
282-- >>> parseUrlPiece "Right 123" :: Either Text (Either String Int)
260-- Right (Right 123)
283-- Right (Right 123)
261instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b) where
284instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b) where
262 parseUrlPiece s =
285 parseUrlPiece s =
263− case T.stripPrefix "Right " s of
286+ Right <$> parseUrlPieceWithPrefix "Right " s
264− Just r -> Right <$> parseUrlPiece r
287+ <!> Left <$> parseUrlPieceWithPrefix "Left " s
265− _ -> case T.stripPrefix "Left " s of
288+ where
266− Just l -> Left <$> parseUrlPiece l
289+ infixl 3 <!>
267− _ -> defaultParseError s
290+ Left _ <!> y = y
291+ x <!> _ = x
268
292
269-- $examples
293-- $examples
270--
294--
271-- Booleans:
295-- Booleans:
272--
296--
273-- >>> toUrlPiece True
297-- >>> toUrlPiece True
274−-- "True"
298+-- "true"
275−-- >>> parseUrlPiece "False" :: Either Text Bool
299+-- >>> parseUrlPiece "false" :: Either Text Bool
276-- Right False
300-- Right False
277-- >>> parseUrlPiece "something else" :: Either Text Bool
301-- >>> parseUrlPiece "something else" :: Either Text Bool
278-- Left "could not convert: `something else'"
302-- Left "could not convert: `something else'"
Web/PathPieces.hs+1−1
@@ -109,7 +109,7 @@ instance PathPiece a => ToHttpApiData (WrappedPathPiece a) where
109 toUrlPiece = toPathPiece . unwrapPathPiece
109 toUrlPiece = toPathPiece . unwrapPathPiece
110
110
111instance PathPiece a => FromHttpApiData (WrappedPathPiece a) where
111instance PathPiece a => FromHttpApiData (WrappedPathPiece a) where
112− parseUrlPiece = fmap WrappedPathPiece . parseMaybeHttpApiData fromPathPiece
112+ parseUrlPiece = fmap WrappedPathPiece . parseMaybeTextData fromPathPiece
113
113
114-- | Convert value to route piece using @'PathPiece'@ instance for its parameter.
114-- | Convert value to route piece using @'PathPiece'@ instance for its parameter.
115toPathPiece1 :: forall f a. (PathPiece a, ToHttpApiData (f (WrappedPathPiece a))) => f a -> S.Text
115toPathPiece1 :: forall f a. (PathPiece a, ToHttpApiData (f (WrappedPathPiece a))) => f a -> S.Text