@@ -1,9 +1,3 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE TypeSynonymInstances #-}
71-- |
82-- Convert Haskell values to and from HTTP API data
93-- such as URL pieces, headers and query parameters.
@@ -14,281 +8,19 @@ module Web.HttpApiData (
148 -- * Classes
159 ToHttpApiData (..),
1610 FromHttpApiData (..),
17−
18− -- * Utility functions
19− parseMaybeTextData,
20− showTextData,
21− readMaybeTextData,
22− readEitherTextData,
2311) where
2412
25−import Control.Applicative
26−import Control.Arrow ((&&&))
27−
28−import Data.Monoid
29−import Data.ByteString (ByteString)
30−
31−import Data.Int
32−import Data.Word
33−
34−import Data.Text (Text)
35−import Data.Text.Encoding (encodeUtf8, decodeUtf8)
36−import Data.Text.Read (signed, decimal, rational, Reader)
37−import qualified Data.Text as T
38−import qualified Data.Text.Lazy as L
39−
40−import Data.Time (Day)
41−import Data.Version
42−
43−#if MIN_VERSION_base(4,8,0)
44−import Data.Void
45−#endif
46−
47−import Text.Read (readMaybe)
48−import Text.ParserCombinators.ReadP (readP_to_S)
13+import Web.HttpApiData.Internal
4914
5015-- $setup
5116--
5217-- >>> :set -XOverloadedStrings
5318-- >>> import Control.Applicative
5419-- >>> import Data.Time
55−
56−-- | Convert value to HTTP API data.
57−class ToHttpApiData a where
58− {-# MINIMAL toUrlPiece | toQueryParam #-}
59− -- | Convert to URL path piece.
60− toUrlPiece :: a -> Text
61− toUrlPiece = toQueryParam
62−
63− -- | Convert to HTTP header value.
64− toHeader :: a -> ByteString
65− toHeader = encodeUtf8 . toUrlPiece
66−
67− -- | Convert to query param value.
68− toQueryParam :: a -> Text
69− toQueryParam = toUrlPiece
70−
71−-- | Convert value from HTTP API data.
72−class FromHttpApiData a where
73− {-# MINIMAL parseUrlPiece | parseQueryParam #-}
74− -- | Parse URL path piece.
75− parseUrlPiece :: Text -> Either Text a
76− parseUrlPiece = parseQueryParam
77−
78− -- | Parse HTTP header value.
79− parseHeader :: ByteString -> Either Text a
80− parseHeader = parseUrlPiece . decodeUtf8
81−
82− -- | Parse query param value.
83− parseQueryParam :: Text -> Either Text a
84− parseQueryParam = parseUrlPiece
85−
86−-- | Default parsing error.
87−defaultParseError :: Text -> Either Text a
88−defaultParseError input = Left ("could not convert: `" <> input <> "'")
89−
90−-- | Convert @'Maybe'@ parser into @'Either' 'Text'@ parser with default error message.
91−parseMaybeTextData :: (Text -> Maybe a) -> (Text -> Either Text a)
92−parseMaybeTextData parse input =
93− case parse input of
94− Nothing -> defaultParseError input
95− Just val -> Right val
96−
97−-- | Convert to URL piece using @'Show'@ instance.
98−showTextData :: Show a => a -> Text
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]
124−
125−-- | Parse URL piece using @'Read'@ instance.
126−readMaybeTextData :: Read a => Text -> Maybe a
127−readMaybeTextData = readMaybe . T.unpack
128−
129−-- | Parse URL piece using @'Read'@ instance.
130−readEitherTextData :: Read a => Text -> Either Text a
131−readEitherTextData = parseMaybeTextData readMaybeTextData
132−
133−-- | Run @'Reader'@ as HTTP API data parser.
134−runReader :: Reader a -> Text -> Either Text a
135−runReader reader input =
136− case reader input of
137− Left err -> Left (T.pack err)
138− Right (x, rest)
139− | T.null rest -> Right x
140− | otherwise -> defaultParseError input
141−
142−-- | Run @'Reader'@ to parse bounded integral value with bounds checking.
143−parseBounded :: forall a. (Bounded a, Integral a) => Reader Integer -> Text -> Either Text a
144−parseBounded reader input = do
145− n <- runReader reader input
146− if (n > h || n < l)
147− then Left ("out of bounds: `" <> input <> "' (should be between " <> T.pack (show l) <> " and " <> T.pack (show h) <> ")")
148− else Right (fromInteger n)
149− where
150− l = toInteger (minBound :: a)
151− h = toInteger (maxBound :: a)
152−
153−-- |
154−-- >>> toUrlPiece ()
155−-- "_"
156−instance ToHttpApiData () where
157− toUrlPiece () = "_"
158−
159−instance ToHttpApiData Char where toUrlPiece = T.singleton
160−
161−-- |
162−-- >>> toUrlPiece (Version [1, 2, 3] [])
163−-- "1.2.3"
164−instance ToHttpApiData Version where
165− toUrlPiece = T.pack . showVersion
166−
167−#if MIN_VERSION_base(4,8,0)
168−instance ToHttpApiData Void where
169− toUrlPiece = absurd
170−#endif
171−
172−instance ToHttpApiData Bool where toUrlPiece = showTextData
173−instance ToHttpApiData Ordering where toUrlPiece = showTextData
174−instance ToHttpApiData Double where toUrlPiece = showTextData
175−instance ToHttpApiData Float where toUrlPiece = showTextData
176−instance ToHttpApiData Int where toUrlPiece = showTextData
177−instance ToHttpApiData Int8 where toUrlPiece = showTextData
178−instance ToHttpApiData Int16 where toUrlPiece = showTextData
179−instance ToHttpApiData Int32 where toUrlPiece = showTextData
180−instance ToHttpApiData Int64 where toUrlPiece = showTextData
181−instance ToHttpApiData Integer where toUrlPiece = showTextData
182−instance ToHttpApiData Word where toUrlPiece = showTextData
183−instance ToHttpApiData Word8 where toUrlPiece = showTextData
184−instance ToHttpApiData Word16 where toUrlPiece = showTextData
185−instance ToHttpApiData Word32 where toUrlPiece = showTextData
186−instance ToHttpApiData Word64 where toUrlPiece = showTextData
187−instance ToHttpApiData String where toUrlPiece = T.pack
188−instance ToHttpApiData Text where toUrlPiece = id
189−instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
190−instance ToHttpApiData Day where toUrlPiece = showTextData
191−
192−instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
193−instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
194−
195−instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual
196−instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum
197−instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct
198−instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst
199−instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast
200−
201−-- |
202−-- >>> toUrlPiece (Just "Hello")
203−-- "just Hello"
204−instance ToHttpApiData a => ToHttpApiData (Maybe a) where
205− toUrlPiece (Just x) = "just " <> toUrlPiece x
206− toUrlPiece Nothing = "nothing"
207−
208−-- |
209−-- >>> toUrlPiece (Left "err" :: Either String Int)
210−-- "left err"
211−-- >>> toUrlPiece (Right 3 :: Either String Int)
212−-- "right 3"
213−instance (ToHttpApiData a, ToHttpApiData b) => ToHttpApiData (Either a b) where
214− toUrlPiece (Left x) = "left " <> toUrlPiece x
215− toUrlPiece (Right x) = "right " <> toUrlPiece x
216−
217−-- |
218−-- >>> parseUrlPiece "_" :: Either Text ()
219−-- Right ()
220−instance FromHttpApiData () where
221− parseUrlPiece "_" = return ()
222− parseUrlPiece s = defaultParseError s
223−
224−instance FromHttpApiData Char where
225− parseUrlPiece s =
226− case T.uncons s of
227− Just (c, s') | T.null s' -> return c
228− _ -> defaultParseError s
229−
230−-- |
231−-- >>> showVersion <$> parseUrlPiece "1.2.3"
232−-- Right "1.2.3"
233−instance FromHttpApiData Version where
234− parseUrlPiece s =
235− case reverse (readP_to_S parseVersion (T.unpack s)) of
236− ((x, ""):_) -> return x
237− _ -> defaultParseError s
238−
239−#if MIN_VERSION_base(4,8,0)
240−instance FromHttpApiData Void where
241− parseUrlPiece _ = Left "Void cannot be parsed!"
242−#endif
243−
244−instance FromHttpApiData Bool where parseUrlPiece = parseBoundedCaseInsensitiveTextData
245−instance FromHttpApiData Ordering where parseUrlPiece = parseBoundedCaseInsensitiveTextData
246−instance FromHttpApiData Double where parseUrlPiece = runReader rational
247−instance FromHttpApiData Float where parseUrlPiece = runReader rational
248−instance FromHttpApiData Int where parseUrlPiece = parseBounded (signed decimal)
249−instance FromHttpApiData Int8 where parseUrlPiece = parseBounded (signed decimal)
250−instance FromHttpApiData Int16 where parseUrlPiece = parseBounded (signed decimal)
251−instance FromHttpApiData Int32 where parseUrlPiece = parseBounded (signed decimal)
252−instance FromHttpApiData Int64 where parseUrlPiece = parseBounded (signed decimal)
253−instance FromHttpApiData Integer where parseUrlPiece = runReader (signed decimal)
254−instance FromHttpApiData Word where parseUrlPiece = parseBounded decimal
255−instance FromHttpApiData Word8 where parseUrlPiece = parseBounded decimal
256−instance FromHttpApiData Word16 where parseUrlPiece = parseBounded decimal
257−instance FromHttpApiData Word32 where parseUrlPiece = parseBounded decimal
258−instance FromHttpApiData Word64 where parseUrlPiece = parseBounded decimal
259−instance FromHttpApiData String where parseUrlPiece = Right . T.unpack
260−instance FromHttpApiData Text where parseUrlPiece = Right
261−instance FromHttpApiData L.Text where parseUrlPiece = Right . L.fromStrict
262−instance FromHttpApiData Day where parseUrlPiece = readEitherTextData
263−
264−instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
265−instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
266−
267−instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece
268−instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece
269−instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece
270−instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece
271−instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece
272−
273−-- |
274−-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
275−-- Right (Just 123)
276−instance FromHttpApiData a => FromHttpApiData (Maybe a) where
277− parseUrlPiece s
278− | T.toLower (T.take 7 s) == "nothing" = return Nothing
279− | otherwise = Just <$> parseUrlPieceWithPrefix "Just " s
280−
281−-- |
282−-- >>> parseUrlPiece "Right 123" :: Either Text (Either String Int)
283−-- Right (Right 123)
284−instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b) where
285− parseUrlPiece s =
286− Right <$> parseUrlPieceWithPrefix "Right " s
287− <!> Left <$> parseUrlPieceWithPrefix "Left " s
288− where
289− infixl 3 <!>
290− Left _ <!> y = y
291− x <!> _ = x
20+-- >>> import Data.Int
21+-- >>> import Data.Text (Text)
22+-- >>> import Data.Time (Day)
23+-- >>> import Data.Version
29224
29325-- $examples
29426--