6dc4849 · typeable/http-api-data

git.iko.soy/typeable/http-api-data

on master help sign in

Add optional use-text-show flag

6dc4849Nickolay Kudasov11 years ago

Web/HttpApiData/Internal.hs+63−1

compare with master

unifiedsplit

@@ -34,6 +34,14 @@ import Data.Void

34import Text.Read (readMaybe)

35import Text.ParserCombinators.ReadP (readP_to_S)

37+#if USE_TEXT_SHOW

38+import TextShow (TextShow, showt)

39+#endif

40+

41+-- $setup

42+-- >>> :set -XDeriveGeneric

43+-- >>> import TextShow.Generic

44+

37-- | Convert value to HTTP API data.

45-- | Convert value to HTTP API data.

38class ToHttpApiData a where

46class ToHttpApiData a where

39 {-# MINIMAL toUrlPiece | toQueryParam #-}

47 {-# MINIMAL toUrlPiece | toQueryParam #-}

@@ -96,6 +104,22 @@ parseMaybeTextData parse input =

96 Nothing -> defaultParseError input

104 Nothing -> defaultParseError input

97 Just val -> Right val

105 Just val -> Right val

106

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

99-- | Convert to URL piece using @'Show'@ instance.

123-- | Convert to URL piece using @'Show'@ instance.

100-- The result is always lower cased.

124-- The result is always lower cased.

101--

125--

@@ -110,6 +134,7 @@ parseMaybeTextData parse input =

110-- "foo"

134-- "foo"

111showTextData :: Show a => a -> Text

135showTextData :: Show a => a -> Text

112showTextData = T.toLower . T.pack . show

136showTextData = T.toLower . T.pack . show

137+#endif

113

138

114-- | Parse given text case insensitive and return the rest of the input.

139-- | Parse given text case insensitive and return the rest of the input.

115--

140--

@@ -131,6 +156,23 @@ parseUrlPieceWithPrefix pattern input

131 where

156 where

132 (prefix, rest) = T.splitAt (T.length pattern) input

157 (prefix, rest) = T.splitAt (T.length pattern) input

133

158

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

134-- | Parse values case insensitively based on @'Show'@ instance.

176-- | Parse values case insensitively based on @'Show'@ instance.

135--

177--

136-- >>> parseBoundedCaseInsensitiveTextData "true" :: Either Text Bool

178-- >>> parseBoundedCaseInsensitiveTextData "true" :: Either Text Bool

@@ -145,6 +187,7 @@ parseUrlPieceWithPrefix pattern input

145-- >>> parseUrlPiece "foo" :: Either Text MyData

187-- >>> parseUrlPiece "foo" :: Either Text MyData

146-- Right Foo

188-- Right Foo

147parseBoundedCaseInsensitiveTextData :: forall a. (Show a, Bounded a, Enum a) => Text -> Either Text a

189parseBoundedCaseInsensitiveTextData :: forall a. (Show a, Bounded a, Enum a) => Text -> Either Text a

190+#endif

148parseBoundedCaseInsensitiveTextData = parseMaybeTextData (flip lookup values . T.toLower)

191parseBoundedCaseInsensitiveTextData = parseMaybeTextData (flip lookup values . T.toLower)

149 where

192 where

150 values = map (showTextData &&& id) [minBound..maxBound :: a]

193 values = map (showTextData &&& id) [minBound..maxBound :: a]

@@ -201,6 +244,23 @@ instance ToHttpApiData Void where

201

244

202instance ToHttpApiData Bool where toUrlPiece = showTextData

245instance ToHttpApiData Bool where toUrlPiece = showTextData

203instance ToHttpApiData Ordering where toUrlPiece = showTextData

246instance 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

204instance ToHttpApiData Double where toUrlPiece = showTextData

264instance ToHttpApiData Double where toUrlPiece = showTextData

205instance ToHttpApiData Float where toUrlPiece = showTextData

265instance ToHttpApiData Float where toUrlPiece = showTextData

206instance ToHttpApiData Int where toUrlPiece = showTextData

266instance ToHttpApiData Int where toUrlPiece = showTextData

@@ -214,10 +274,12 @@ instance ToHttpApiData Word8 where toUrlPiece = showTextData

214instance ToHttpApiData Word16 where toUrlPiece = showTextData

274instance ToHttpApiData Word16 where toUrlPiece = showTextData

215instance ToHttpApiData Word32 where toUrlPiece = showTextData

275instance ToHttpApiData Word32 where toUrlPiece = showTextData

216instance ToHttpApiData Word64 where toUrlPiece = showTextData

276instance ToHttpApiData Word64 where toUrlPiece = showTextData

277+instance ToHttpApiData Day where toUrlPiece = showTextData

278+#endif

279+

217instance ToHttpApiData String where toUrlPiece = T.pack

280instance ToHttpApiData String where toUrlPiece = T.pack

218instance ToHttpApiData Text where toUrlPiece = id

281instance ToHttpApiData Text where toUrlPiece = id

219instance ToHttpApiData L.Text where toUrlPiece = L.toStrict

282instance ToHttpApiData L.Text where toUrlPiece = L.toStrict

220−instance ToHttpApiData Day where toUrlPiece = showTextData

221

283

222instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll

284instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll

223instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny

285instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny

http-api-data.cabal+7

@@ -16,11 +16,18 @@ extra-source-files:

16 CHANGELOG.md

17 README.md

19+flag use-text-show

20+ description: Use @text-show@ library for efficient @'ToHttpApiData'@ implementations.

21+ default: False

22+

19library

23library

20 build-depends: base >= 4 && < 5

24 build-depends: base >= 4 && < 5

21 , text >= 0.5

25 , text >= 0.5

22 , bytestring

26 , bytestring

23 , time

27 , time

28+ if flag(use-text-show)

29+ cpp-options: -DUSE_TEXT_SHOW

30+ build-depends: text-show >= 2

24 exposed-modules:

31 exposed-modules:

25 Web.HttpApiData

32 Web.HttpApiData

26 Web.HttpApiData.Internal

33 Web.HttpApiData.Internal