diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 ----- diff --git a/http-api-data.cabal b/http-api-data.cabal --- a/http-api-data.cabal +++ b/http-api-data.cabal @@ -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 diff --git a/include/overlapping-compat.h b/include/overlapping-compat.h deleted file mode 100644 --- a/include/overlapping-compat.h +++ /dev/null @@ -1,8 +0,0 @@ -#if __GLASGOW_HASKELL__ >= 710 -#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} -#define OVERLAPPING_ {-# OVERLAPPING #-} -#else -{-# LANGUAGE OverlappingInstances #-} -#define OVERLAPPABLE_ -#define OVERLAPPING_ -#endif diff --git a/src/Web/Internal/FormUrlEncoded.hs b/src/Web/Internal/FormUrlEncoded.hs --- a/src/Web/Internal/FormUrlEncoded.hs +++ b/src/Web/Internal/FormUrlEncoded.hs @@ -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) diff --git a/src/Web/Internal/HttpApiData.hs b/src/Web/Internal/HttpApiData.hs --- a/src/Web/Internal/HttpApiData.hs +++ b/src/Web/Internal/HttpApiData.hs @@ -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 - - diff --git a/test/Web/Internal/FormUrlEncodedSpec.hs b/test/Web/Internal/FormUrlEncodedSpec.hs --- a/test/Web/Internal/FormUrlEncodedSpec.hs +++ b/test/Web/Internal/FormUrlEncodedSpec.hs @@ -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 diff --git a/test/Web/Internal/HttpApiDataSpec.hs b/test/Web/Internal/HttpApiDataSpec.hs --- a/test/Web/Internal/HttpApiDataSpec.hs +++ b/test/Web/Internal/HttpApiDataSpec.hs @@ -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