http-api-data 0.5.1 → 0.6
raw patch · 7 files changed
+75/−112 lines, 7 filesdep +text-iso8601dep −attoparsecdep −attoparsec-iso8601dep −base-compatdep ~basedep ~bytestringdep ~containers
Dependencies added: text-iso8601
Dependencies removed: attoparsec, attoparsec-iso8601, base-compat, nats
Dependency ranges changed: base, bytestring, containers, hspec, text
Files
- CHANGELOG.md +13/−0
- http-api-data.cabal +10/−19
- include/overlapping-compat.h +0/−8
- src/Web/Internal/FormUrlEncoded.hs +8/−20
- src/Web/Internal/HttpApiData.hs +44/−56
- test/Web/Internal/FormUrlEncodedSpec.hs +0/−6
- test/Web/Internal/HttpApiDataSpec.hs +0/−3
CHANGELOG.md view
@@ -1,3 +1,16 @@+0.6+---++* Use [`text-iso8601`](https://hackage.haskell.org/package/text-iso8601)+ to parse and serialise `time` types. (Instead of `attoparsec-iso8601`).+ Due this change some formats are slightly changed:++ - Space between timezone is not accepted+ - Timezone offset can be between -23:59..23:59+ - Timezone offset is output with colon between hours and minutes++* Require at least GHC-8.2+ 0.5.1 -----
http-api-data.cabal view
@@ -1,6 +1,6 @@-cabal-version: >= 1.10+cabal-version: 1.12 name: http-api-data-version: 0.5.1+version: 0.6 synopsis: Converting to/from HTTP API data like URL pieces, headers and query parameters. category: Web@@ -18,22 +18,20 @@ build-type: Simple extra-source-files:- include/overlapping-compat.h test/*.hs CHANGELOG.md README.md tested-with:- GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2,- GHC==9.2.7,- GHC==9.4.4,- GHC==9.6.1+ GHC==9.2.8,+ GHC==9.4.5,+ GHC==9.6.2 flag use-text-show description: Use text-show library for efficient ToHttpApiData implementations.@@ -42,23 +40,20 @@ library hs-source-dirs: src/- include-dirs: include/ -- GHC bundled- build-depends: base >= 4.9 && < 4.19- , bytestring >= 0.10.8.1 && < 0.12- , containers >= 0.5.7.1 && < 0.7+ build-depends: base >= 4.10.1.0 && < 4.19+ , bytestring >= 0.10.8.2 && < 0.12+ , containers >= 0.5.10.2 && < 0.7 , text >= 1.2.3.0 && < 1.3 || >=2.0 && <2.1 , transformers >= 0.5.2.0 && < 0.7 -- other-dependencies build-depends:- attoparsec >= 0.13.2.2 && < 0.15- , attoparsec-iso8601 >= 1.1.0.0 && < 1.2- , base-compat >= 0.10.5 && < 0.14- , cookie >= 0.4.3 && < 0.5+ cookie >= 0.4.3 && < 0.5 , hashable >= 1.2.7.0 && < 1.5 , http-types >= 0.12.3 && < 0.13+ , text-iso8601 >= 0.1 && < 0.2 , tagged >= 0.8.5 && < 0.9 , time-compat >= 1.9.5 && < 1.10 , unordered-containers >= 0.2.10.0 && < 0.3@@ -90,7 +85,6 @@ -- inherited depndencies build-depends: base- , base-compat , bytestring , cookie , http-api-data@@ -98,9 +92,6 @@ , time-compat , unordered-containers , uuid-types-- if !impl(ghc >= 7.10)- build-depends: nats build-depends: HUnit >= 1.6.0.0 && <1.7 , hspec >= 2.7.1 && <2.11
− include/overlapping-compat.h
@@ -1,8 +0,0 @@-#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#define OVERLAPPING_ {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPABLE_-#define OVERLAPPING_-#endif
src/Web/Internal/FormUrlEncoded.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-}@@ -14,12 +13,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-#include "overlapping-compat.h" module Web.Internal.FormUrlEncoded where -import Prelude ()-import Prelude.Compat- import Control.Applicative (Const(Const)) import Control.Arrow ((***)) import Control.Monad ((<=<))@@ -64,13 +59,11 @@ import Web.Internal.HttpApiData -- $setup--- >>> :set -XDeriveGeneric--- >>> :set -XOverloadedLists--- >>> :set -XOverloadedStrings--- >>> :set -XFlexibleContexts--- >>> :set -XScopedTypeVariables--- >>> :set -XTypeFamilies+-- >>> :set -XDeriveGeneric -XOverloadedLists -XOverloadedStrings -XFlexibleContexts -XScopedTypeVariables -XTypeFamilies+-- >>> import GHC.Generics (Generic) -- >>> import Data.Char (toLower)+-- >>> import Data.Text (Text)+-- >>> import Data.Word (Word8) -- -- >>> data Person = Person { name :: String, age :: Int } deriving (Show, Generic) -- >>> instance ToForm Person@@ -296,16 +289,11 @@ data Proxy3 a b c = Proxy3 type family NotSupported (cls :: k1) (a :: k2) (reason :: Symbol) :: Constraint where-#if __GLASGOW_HASKELL__ < 800- -- this is just a placeholder case for older GHCs to not freak out on an empty closed type family- NotSupported cls a "this type family is actually empty" = ()-#else NotSupported cls a reason = TypeError ( 'Text "Cannot derive a Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instance for " ':<>: 'ShowType a ':<>: 'Text "." ':$$: 'ShowType a ':<>: 'Text " " ':<>: 'Text reason ':<>: 'Text "," ':$$: 'Text "but Generic-based " ':<>: 'ShowType cls ':<>: 'Text " instances can be derived only for records" ':$$: 'Text "(i.e. product types with named fields)." )-#endif -- | A 'Generic'-based implementation of 'toForm'. -- This is used as a default implementation in 'ToForm'.@@ -357,7 +345,7 @@ instance (GToForm t f) => GToForm t (M1 C x f) where gToForm p opts (M1 a) = gToForm p opts a -instance OVERLAPPABLE_ (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where+instance {-# OVERLAPPABLE #-} (Selector s, ToHttpApiData c) => GToForm t (M1 S s (K1 i c)) where gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)] where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)@@ -375,7 +363,7 @@ where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p) -instance OVERLAPPING_ (Selector s) => GToForm t (M1 S s (K1 i String)) where+instance {-# OVERLAPPING #-} (Selector s) => GToForm t (M1 S s (K1 i String)) where gToForm _ opts (M1 (K1 c)) = fromList [(key, toQueryParam c)] where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)@@ -505,7 +493,7 @@ instance GFromForm t f => GFromForm t (M1 C x f) where gFromForm p opts f = M1 <$> gFromForm p opts f -instance OVERLAPPABLE_ (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where+instance {-# OVERLAPPABLE #-} (Selector s, FromHttpApiData c) => GFromForm t (M1 S s (K1 i c)) where gFromForm _ opts form = M1 . K1 <$> parseUnique key form where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)@@ -520,7 +508,7 @@ where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p) -instance OVERLAPPING_ (Selector s) => GFromForm t (M1 S s (K1 i String)) where+instance {-# OVERLAPPING #-} (Selector s) => GFromForm t (M1 S s (K1 i String)) where gFromForm _ opts form = M1 . K1 <$> parseUnique key form where key = Text.pack $ fieldLabelModifier opts $ selName (Proxy3 :: Proxy3 s g p)
src/Web/Internal/HttpApiData.hs view
@@ -15,14 +15,9 @@ -- such as URL pieces, headers and query parameters. module Web.Internal.HttpApiData where -import Prelude ()-import Prelude.Compat- import Control.Applicative (Const(Const)) import Control.Arrow (left, (&&&)) import Control.Monad ((<=<))-import qualified Data.Attoparsec.Text as Atto-import qualified Data.Attoparsec.Time as Atto import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BS@@ -46,19 +41,18 @@ encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as L+import Data.Text.Lazy.Builder (Builder, toLazyText) import Data.Text.Read (Reader, decimal, rational, signed)-import Data.Time.Compat (Day, FormatTime, LocalTime,+import qualified Data.Time.ToText as TT+import qualified Data.Time.FromText as FT+import Data.Time.Compat (Day, LocalTime, NominalDiffTime, TimeOfDay,- UTCTime, ZonedTime, formatTime,- DayOfWeek (..),+ UTCTime, ZonedTime, DayOfWeek (..), nominalDiffTimeToSeconds, secondsToNominalDiffTime)-import Data.Time.Format.Compat (defaultTimeLocale,- iso8601DateFormat) import Data.Time.Calendar.Month.Compat (Month)-import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),- toYearQuarter)+import Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..)) import Data.Typeable (Typeable) import qualified Data.UUID.Types as UUID import Data.Version (Version, parseVersion,@@ -77,10 +71,17 @@ #endif -- $setup--- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)--- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p+-- >>> :set -XOverloadedStrings+-- >>> import Data.Text (Text)+-- >>> import Data.Word (Word8)+-- >>> import Data.Text.Read (decimal) -- >>> import Data.Time.Compat+-- >>> import Data.Time.Calendar.Month.Compat+-- >>> import Data.Time.Calendar.Quarter.Compat -- >>> import Data.Version+-- >>> import Web.Cookie (SetCookie)+-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)+-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p -- | Convert value to HTTP API data. --@@ -484,18 +485,15 @@ -- >>> toUrlPiece (fromGregorian 2015 10 03) -- "2015-10-03" instance ToHttpApiData Day where- toUrlPiece = T.pack . show+ toUrlPiece = runTT TT.buildDay toEncodedUrlPiece = unsafeToEncodedUrlPiece toEncodedQueryParam = unsafeToEncodedQueryParam -timeToUrlPiece :: FormatTime t => String -> t -> Text-timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt))- -- | -- >>> toUrlPiece $ TimeOfDay 14 55 23.1--- "14:55:23.1"+-- "14:55:23.100" instance ToHttpApiData TimeOfDay where- toUrlPiece = T.pack . formatTime defaultTimeLocale "%H:%M:%S%Q"+ toUrlPiece = runTT TT.buildTimeOfDay toEncodedUrlPiece = unsafeToEncodedUrlPiece -- no toEncodedQueryParam as : is unsafe char. @@ -503,23 +501,27 @@ -- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 21.687) -- "2015-10-03T14:55:21.687" instance ToHttpApiData LocalTime where- toUrlPiece = timeToUrlPiece "%H:%M:%S%Q"+ toUrlPiece = runTT TT.buildLocalTime toEncodedUrlPiece = unsafeToEncodedUrlPiece -- no toEncodedQueryParam as : is unsafe char. -- | -- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) utc--- "2015-10-03T14:55:51.001+0000"+-- "2015-10-03T14:55:51.001Z"+--+-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) (TimeZone 120 True "EET")+-- "2015-10-03T14:55:51.001+02:00"+-- instance ToHttpApiData ZonedTime where- toUrlPiece = timeToUrlPiece "%H:%M:%S%Q%z"+ toUrlPiece = runTT TT.buildZonedTime toEncodedUrlPiece = unsafeToEncodedUrlPiece -- no toEncodedQueryParam as : is unsafe char. -- | -- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864.5--- "2015-10-03T00:14:24.5Z"+-- "2015-10-03T00:14:24.500Z" instance ToHttpApiData UTCTime where- toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ"+ toUrlPiece = runTT TT.buildUTCTime toEncodedUrlPiece = unsafeToEncodedUrlPiece -- no toEncodedQueryParam as : is unsafe char. @@ -542,10 +544,7 @@ -- >>> toUrlPiece Q4 -- "q4" instance ToHttpApiData QuarterOfYear where- toUrlPiece Q1 = "q1"- toUrlPiece Q2 = "q2"- toUrlPiece Q3 = "q3"- toUrlPiece Q4 = "q4"+ toUrlPiece = runTT TT.buildQuarterOfYear toEncodedUrlPiece = unsafeToEncodedUrlPiece toEncodedQueryParam = unsafeToEncodedQueryParam@@ -559,13 +558,7 @@ -- "2010-q1" -- instance ToHttpApiData Quarter where- toUrlPiece q = case toYearQuarter q of- (y, qoy) -> T.pack (show y ++ "-" ++ f qoy)- where- f Q1 = "q1"- f Q2 = "q2"- f Q3 = "q3"- f Q4 = "q4"+ toUrlPiece = runTT TT.buildQuarter toEncodedUrlPiece = unsafeToEncodedUrlPiece toEncodedQueryParam = unsafeToEncodedQueryParam@@ -579,7 +572,7 @@ -- "2040-03" -- instance ToHttpApiData Month where- toUrlPiece = T.pack . formatTime defaultTimeLocale "%Y-%m"+ toUrlPiece = runTT TT.buildMonth toEncodedUrlPiece = unsafeToEncodedUrlPiece toEncodedQueryParam = unsafeToEncodedQueryParam@@ -762,17 +755,17 @@ -- | -- >>> toGregorian <$> parseUrlPiece "2016-12-01" -- Right (2016,12,1)-instance FromHttpApiData Day where parseUrlPiece = runAtto Atto.day+instance FromHttpApiData Day where parseUrlPiece = runFT FT.parseDay -- | -- >>> parseUrlPiece "14:55:01.333" :: Either Text TimeOfDay -- Right 14:55:01.333-instance FromHttpApiData TimeOfDay where parseUrlPiece = runAtto Atto.timeOfDay+instance FromHttpApiData TimeOfDay where parseUrlPiece = runFT FT.parseTimeOfDay -- | -- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime -- Right 2015-10-03 14:55:01-instance FromHttpApiData LocalTime where parseUrlPiece = runAtto Atto.localTime+instance FromHttpApiData LocalTime where parseUrlPiece = runFT FT.parseLocalTime -- | -- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime@@ -780,12 +773,12 @@ -- -- >>> parseQueryParam "2016-12-31T01:00:00Z" :: Either Text ZonedTime -- Right 2016-12-31 01:00:00 +0000-instance FromHttpApiData ZonedTime where parseUrlPiece = runAtto Atto.zonedTime+instance FromHttpApiData ZonedTime where parseUrlPiece = runFT FT.parseZonedTime -- | -- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime -- Right 2015-10-03 00:14:24 UTC-instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime+instance FromHttpApiData UTCTime where parseUrlPiece = runFT FT.parseUTCTime -- | -- >>> parseUrlPiece "Monday" :: Either Text DayOfWeek@@ -804,12 +797,12 @@ -- | -- >>> parseUrlPiece "2021-01" :: Either Text Month -- Right 2021-01-instance FromHttpApiData Month where parseUrlPiece = runAtto Atto.month+instance FromHttpApiData Month where parseUrlPiece = runFT FT.parseMonth -- | -- >>> parseUrlPiece "2021-q1" :: Either Text Quarter -- Right 2021-Q1-instance FromHttpApiData Quarter where parseUrlPiece = runAtto Atto.quarter+instance FromHttpApiData Quarter where parseUrlPiece = runFT FT.parseQuarter -- | -- >>> parseUrlPiece "q2" :: Either Text QuarterOfYear@@ -817,13 +810,7 @@ -- -- >>> parseUrlPiece "Q3" :: Either Text QuarterOfYear -- Right Q3-instance FromHttpApiData QuarterOfYear where- parseUrlPiece t = case T.toLower t of- "q1" -> return Q1- "q2" -> return Q2- "q3" -> return Q3- "q4" -> return Q4- _ -> Left "Invalid quarter of year"+instance FromHttpApiData QuarterOfYear where parseUrlPiece = runFT FT.parseQuarterOfYear instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool) instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)@@ -907,12 +894,13 @@ parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a) ---------------------------------------------------------------------------------- Attoparsec helpers+-- Helpers ------------------------------------------------------------------------------- -runAtto :: Atto.Parser a -> Text -> Either Text a-runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of+runTT :: (a -> Builder) -> a -> Text+runTT f x = L.toStrict (toLazyText (f x))++runFT :: (Text -> Either String a) -> Text -> Either Text a+runFT f t = case f t of Left err -> Left (T.pack err) Right x -> Right x--
test/Web/Internal/FormUrlEncodedSpec.hs view
@@ -1,12 +1,6 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Web.Internal.FormUrlEncodedSpec (spec) where--#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-import Data.Monoid-#endif import Control.Monad ((<=<)) import qualified Data.ByteString.Lazy.Char8 as BSL
test/Web/Internal/HttpApiDataSpec.hs view
@@ -2,9 +2,6 @@ module Web.Internal.HttpApiDataSpec (spec) where -import Prelude ()-import Prelude.Compat- import qualified Data.ByteString as BS import Data.ByteString.Builder (toLazyByteString) import Data.Char