git.iko.soy/typeable/http-api-data
on master help sign in
Add optional use-text-show flag
commit6dc4849415e66ba973c6f4381b4f835d1b9c7976 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateWed 7 Oct 2015, 20:21 (11 years ago) parent5fdac00
2 files changed+70−1
Web/HttpApiData/Internal.hs+63−1 http-api-data.cabal+7
Web/HttpApiData/Internal.hs+63−1
@@ -34,6 +34,14 @@ import Data.Void
3434import Text.Read (readMaybe)
3535import Text.ParserCombinators.ReadP (readP_to_S)
3636
37+#if USE_TEXT_SHOW
38+import TextShow (TextShow, showt)
39+#endif
40+
41+-- $setup
42+-- >>> :set -XDeriveGeneric
43+-- >>> import TextShow.Generic
44+
3745-- | Convert value to HTTP API data.
3846class ToHttpApiData a where
3947 {-# MINIMAL toUrlPiece | toQueryParam #-}
@@ -96,6 +104,22 @@ parseMaybeTextData parse input =
96104 Nothing -> defaultParseError input
97105 Just val -> Right val
98106
107+#if USE_TEXT_SHOW
108+-- | Convert to URL piece using @'TextShow'@ instance.
109+-- The result is always lower cased.
110+--
111+-- >>> showTextData True
112+-- "true"
113+--
114+-- This can be used as a default implementation for enumeration types:
115+--
116+-- >>> data MyData = Foo | Bar | Baz deriving (Show)
117+-- >>> instance ToHttpApiData MyData where toUrlPiece = showTextData
118+-- >>> toUrlPiece Foo
119+-- "foo"
120+showTextData :: TextShow a => a -> Text
121+showTextData = T.toLower . showt
122+#else
99123-- | Convert to URL piece using @'Show'@ instance.
100124-- The result is always lower cased.
101125--
@@ -110,6 +134,7 @@ parseMaybeTextData parse input =
110134-- "foo"
111135showTextData :: Show a => a -> Text
112136showTextData = T.toLower . T.pack . show
137+#endif
113138
114139-- | Parse given text case insensitive and return the rest of the input.
115140--
@@ -131,6 +156,23 @@ parseUrlPieceWithPrefix pattern input
131156 where
132157 (prefix, rest) = T.splitAt (T.length pattern) input
133158
159+#if USE_TEXT_SHOW
160+-- | Parse values case insensitively based on @'TextShow'@ instance.
161+--
162+-- >>> parseBoundedCaseInsensitiveTextData "true" :: Either Text Bool
163+-- Right True
164+-- >>> parseBoundedCaseInsensitiveTextData "FALSE" :: Either Text Bool
165+-- Right False
166+--
167+-- This can be used as a default implementation for enumeration types:
168+--
169+-- >>> data MyData = Foo | Bar | Baz deriving (Show, Bounded, Enum, Generic)
170+-- >>> instance TextShow MyData where showt = genericShowt
171+-- >>> instance FromHttpApiData MyData where parseUrlPiece = parseBoundedCaseInsensitiveTextData
172+-- >>> parseUrlPiece "foo" :: Either Text MyData
173+-- Right Foo
174+parseBoundedCaseInsensitiveTextData :: forall a. (TextShow a, Bounded a, Enum a) => Text -> Either Text a
175+#else
134176-- | Parse values case insensitively based on @'Show'@ instance.
135177--
136178-- >>> parseBoundedCaseInsensitiveTextData "true" :: Either Text Bool
@@ -145,6 +187,7 @@ parseUrlPieceWithPrefix pattern input
145187-- >>> parseUrlPiece "foo" :: Either Text MyData
146188-- Right Foo
147189parseBoundedCaseInsensitiveTextData :: forall a. (Show a, Bounded a, Enum a) => Text -> Either Text a
190+#endif
148191parseBoundedCaseInsensitiveTextData = parseMaybeTextData (flip lookup values . T.toLower)
149192 where
150193 values = map (showTextData &&& id) [minBound..maxBound :: a]
@@ -201,6 +244,23 @@ instance ToHttpApiData Void where
201244
202245instance ToHttpApiData Bool where toUrlPiece = showTextData
203246instance ToHttpApiData Ordering where toUrlPiece = showTextData
247+
248+#if USE_TEXT_SHOW
249+instance ToHttpApiData Double where toUrlPiece = showt
250+instance ToHttpApiData Float where toUrlPiece = showt
251+instance ToHttpApiData Int where toUrlPiece = showt
252+instance ToHttpApiData Int8 where toUrlPiece = showt
253+instance ToHttpApiData Int16 where toUrlPiece = showt
254+instance ToHttpApiData Int32 where toUrlPiece = showt
255+instance ToHttpApiData Int64 where toUrlPiece = showt
256+instance ToHttpApiData Integer where toUrlPiece = showt
257+instance ToHttpApiData Word where toUrlPiece = showt
258+instance ToHttpApiData Word8 where toUrlPiece = showt
259+instance ToHttpApiData Word16 where toUrlPiece = showt
260+instance ToHttpApiData Word32 where toUrlPiece = showt
261+instance ToHttpApiData Word64 where toUrlPiece = showt
262+instance ToHttpApiData Day where toUrlPiece = T.pack . show
263+#else
204264instance ToHttpApiData Double where toUrlPiece = showTextData
205265instance ToHttpApiData Float where toUrlPiece = showTextData
206266instance ToHttpApiData Int where toUrlPiece = showTextData
@@ -214,10 +274,12 @@ instance ToHttpApiData Word8 where toUrlPiece = showTextData
214274instance ToHttpApiData Word16 where toUrlPiece = showTextData
215275instance ToHttpApiData Word32 where toUrlPiece = showTextData
216276instance ToHttpApiData Word64 where toUrlPiece = showTextData
277+instance ToHttpApiData Day where toUrlPiece = showTextData
278+#endif
279+
217280instance ToHttpApiData String where toUrlPiece = T.pack
218281instance ToHttpApiData Text where toUrlPiece = id
219282instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
220−instance ToHttpApiData Day where toUrlPiece = showTextData
221283
222284instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll
223285instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny
http-api-data.cabal+7
@@ -16,11 +16,18 @@ extra-source-files:
1616 CHANGELOG.md
1717 README.md
1818
19+flag use-text-show
20+ description: Use @text-show@ library for efficient @'ToHttpApiData'@ implementations.
21+ default: False
22+
1923library
2024 build-depends: base >= 4 && < 5
2125 , text >= 0.5
2226 , bytestring
2327 , time
28+ if flag(use-text-show)
29+ cpp-options: -DUSE_TEXT_SHOW
30+ build-depends: text-show >= 2
2431 exposed-modules:
2532 Web.HttpApiData
2633 Web.HttpApiData.Internal