Hello community, here is the log from the commit of package ghc-http-api-data for openSUSE:Factory checked in at 2017-06-12 15:28:31 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-http-api-data (Old) and /work/SRC/openSUSE:Factory/.ghc-http-api-data.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http-api-data" Mon Jun 12 15:28:31 2017 rev:8 rq:499707 version:0.3.7.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-http-api-data/ghc-http-api-data.changes 2017-04-14 13:36:28.817912678 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-http-api-data.new/ghc-http-api-data.changes 2017-06-12 15:28:32.169325342 +0200 @@ -1,0 +2,15 @@ +Thu May 18 09:52:26 UTC 2017 - [email protected] + +- Update to version 0.3.7.1 with cabal2obs. + +------------------------------------------------------------------- +Mon Apr 24 12:26:17 UTC 2017 - [email protected] + +- Update to version 0.3.7 with cabal2obs. + +------------------------------------------------------------------- +Wed Apr 19 13:32:14 UTC 2017 - [email protected] + +- Update to version 0.3.6 with cabal2obs. + +------------------------------------------------------------------- Old: ---- http-api-data-0.3.5.tar.gz New: ---- http-api-data-0.3.7.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http-api-data.spec ++++++ --- /var/tmp/diff_new_pack.9rSPcx/_old 2017-06-12 15:28:33.029204073 +0200 +++ /var/tmp/diff_new_pack.9rSPcx/_new 2017-06-12 15:28:33.033203508 +0200 @@ -19,7 +19,7 @@ %global pkg_name http-api-data %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.3.5 +Version: 0.3.7.1 Release: 0 Summary: Converting to/from HTTP API data like URL pieces, headers and query parameters License: BSD-2-Clause @@ -27,11 +27,13 @@ Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-attoparsec-devel +BuildRequires: ghc-attoparsec-iso8601-devel BuildRequires: ghc-bytestring-devel +BuildRequires: ghc-cabal-doctest-devel BuildRequires: ghc-containers-devel -BuildRequires: ghc-directory-devel -BuildRequires: ghc-filepath-devel BuildRequires: ghc-hashable-devel +BuildRequires: ghc-http-types-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel BuildRequires: ghc-time-devel @@ -43,7 +45,9 @@ %if %{with tests} BuildRequires: ghc-HUnit-devel BuildRequires: ghc-QuickCheck-devel +BuildRequires: ghc-directory-devel BuildRequires: ghc-doctest-devel +BuildRequires: ghc-filepath-devel BuildRequires: ghc-hspec-devel BuildRequires: ghc-quickcheck-instances-devel BuildRequires: ghc-uuid-devel ++++++ http-api-data-0.3.5.tar.gz -> http-api-data-0.3.7.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.3.5/CHANGELOG.md new/http-api-data-0.3.7.1/CHANGELOG.md --- old/http-api-data-0.3.5/CHANGELOG.md 2017-01-19 21:50:10.000000000 +0100 +++ new/http-api-data-0.3.7.1/CHANGELOG.md 2017-05-15 14:30:30.000000000 +0200 @@ -1,3 +1,25 @@ +0.3.7.1 +--- + +* GHC-8.2 support (see [#55](https://github.com/fizruk/http-api-data/pull/55)). + +0.3.7 +--- + +* Minor changes: + * Use [`attoparsec-iso8601`](http://hackage.haskell.org/package/attoparsec-iso8601) + for parsing of time types. Now the accepted formats are the same as by `aeson`, + i.e. parsers are more lenient + (see [#41](https://github.com/fizruk/http-api-data/pull/41)); + * Preserve fractions of a second in `ToHttpApiData` instances (see [#53](https://github.com/fizruk/http-api-data/pull/53)); + * Add `ToHttpApiData` and `FromHttpApiData` instances for `TimeOfDay` (see [#53](https://github.com/fizruk/http-api-data/pull/53)). + +0.3.6 +--- + +* Minor change: + * Add `toEncodedUrlPiece` class method for URL-encoded path segments (see [#50](https://github.com/fizruk/http-api-data/pull/50)); use efficient encoding for types whose values don't need URL-encoding. + 0.3.5 --- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.3.5/Setup.lhs new/http-api-data-0.3.7.1/Setup.lhs --- old/http-api-data-0.3.5/Setup.lhs 2017-01-17 16:20:22.000000000 +0100 +++ new/http-api-data-0.3.7.1/Setup.lhs 2017-05-15 14:28:55.000000000 +0200 @@ -1,165 +1,36 @@ \begin{code} {-# LANGUAGE CPP #-} -#ifndef MIN_VERSION_Cabal -#define MIN_VERSION_Cabal(x,y,z) 0 -#endif -#ifndef MIN_VERSION_directory -#define MIN_VERSION_directory(x,y,z) 0 -#endif -#if MIN_VERSION_Cabal(1,24,0) -#define InstalledPackageId UnitId -#endif +{-# OPTIONS_GHC -Wall #-} module Main (main) where -import Control.Monad ( when ) -import Data.List ( nub ) -import Distribution.Package ( InstalledPackageId ) -import Distribution.Package ( PackageId, Package (..), packageVersion ) -import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) -import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) -import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) -import Distribution.Simple.BuildPaths ( autogenModulesDir ) -import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag) -import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler ) -import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..)) -import Distribution.Text ( display , simpleParse ) -import System.FilePath ( (</>) ) - -#if MIN_VERSION_Cabal(1,25,0) -import Distribution.Simple.BuildPaths ( autogenComponentModulesDir ) +#ifndef MIN_VERSION_cabal_doctest +#define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif -#if MIN_VERSION_directory(1,2,2) -import System.Directory (makeAbsolute) -#else -import System.Directory (getCurrentDirectory) -import System.FilePath (isAbsolute) - -makeAbsolute :: FilePath -> IO FilePath -makeAbsolute p | isAbsolute p = return p - | otherwise = do - cwd <- getCurrentDirectory - return $ cwd </> p -#endif +#if MIN_VERSION_cabal_doctest(1,0,0) +import Distribution.Extra.Doctest ( defaultMainWithDoctests ) main :: IO () -main = defaultMainWithHooks simpleUserHooks - { buildHook = \pkg lbi hooks flags -> do - generateBuildModule flags pkg lbi - buildHook simpleUserHooks pkg lbi hooks flags - } - -generateBuildModule :: BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () -generateBuildModule flags pkg lbi = do - let verbosity = fromFlag (buildVerbosity flags) - let distPref = fromFlag (buildDistPref flags) - - -- Package DBs - let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ] - let dbFlags = "-hide-all-packages" : packageDbArgs dbStack - - withLibLBI pkg lbi $ \lib libcfg -> do - let libBI = libBuildInfo lib - - -- modules - let modules = exposedModules lib ++ otherModules libBI - -- it seems that doctest is happy to take in module names, not actual files! - let module_sources = modules - - -- We need the directory with library's cabal_macros.h! -#if MIN_VERSION_Cabal(1,25,0) - let libAutogenDir = autogenComponentModulesDir lbi libcfg -#else - let libAutogenDir = autogenModulesDir lbi -#endif +main = defaultMainWithDoctests "doctests" - -- Lib sources and includes - iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI - includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI - - -- CPP includes, i.e. include cabal_macros.h - let cppFlags = map ("-optP"++) $ - [ "-include", libAutogenDir ++ "/cabal_macros.h" ] - ++ cppOptions libBI - - -- Actually we need to check whether testName suite == "doctests" - -- pending https://github.com/haskell/cabal/pull/4229 getting into GHC HEAD tree - withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == testName suite) $ do - - -- get and create autogen dir -#if MIN_VERSION_Cabal(1,25,0) - let testAutogenDir = autogenComponentModulesDir lbi suitecfg #else - let testAutogenDir = autogenModulesDir lbi + +#ifdef MIN_VERSION_Cabal +-- If the macro is defined, we have new cabal-install, +-- but for some reason we don't have cabal-doctest in package-db +-- +-- Probably we are running cabal sdist, when otherwise using new-build +-- workflow +#warning You are configuring this package without cabal-doctest installed. \ + The doctests test-suite will not work as a result. \ + To fix this, install cabal-doctest before configuring. #endif - createDirectoryIfMissingVerbose verbosity True testAutogenDir - -- write autogen'd file - rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines - [ "module Build_doctests where" - , "" - -- -package-id etc. flags - , "pkgs :: [String]" - , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg) - , "" - , "flags :: [String]" - , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags) - , "" - , "module_sources :: [String]" - , "module_sources = " ++ show (map display module_sources) - ] - where - -- we do this check in Setup, as then doctests don't need to depend on Cabal - isOldCompiler = maybe False id $ do - a <- simpleParse $ showCompilerId $ compiler lbi - b <- simpleParse "7.5" - return $ packageVersion (a :: PackageId) < b - - formatDeps = map formatOne - formatOne (installedPkgId, pkgId) - -- The problem is how different cabal executables handle package databases - -- when doctests depend on the library - | packageId pkg == pkgId = "-package=" ++ display pkgId - | otherwise = "-package-id=" ++ display installedPkgId - - -- From Distribution.Simple.Program.GHC - packageDbArgs :: [PackageDB] -> [String] - packageDbArgs | isOldCompiler = packageDbArgsConf - | otherwise = packageDbArgsDb - - -- GHC <7.6 uses '-package-conf' instead of '-package-db'. - packageDbArgsConf :: [PackageDB] -> [String] - packageDbArgsConf dbstack = case dbstack of - (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs - (GlobalPackageDB:dbs) -> ("-no-user-package-conf") - : concatMap specific dbs - _ -> ierror - where - specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ] - specific _ = ierror - ierror = error $ "internal error: unexpected package db stack: " - ++ show dbstack - - -- GHC >= 7.6 uses the '-package-db' flag. See - -- https://ghc.haskell.org/trac/ghc/ticket/5977. - packageDbArgsDb :: [PackageDB] -> [String] - -- special cases to make arguments prettier in common scenarios - packageDbArgsDb dbstack = case dbstack of - (GlobalPackageDB:UserPackageDB:dbs) - | all isSpecific dbs -> concatMap single dbs - (GlobalPackageDB:dbs) - | all isSpecific dbs -> "-no-user-package-db" - : concatMap single dbs - dbs -> "-clear-package-db" - : concatMap single dbs - where - single (SpecificPackageDB db) = [ "-package-db=" ++ db ] - single GlobalPackageDB = [ "-global-package-db" ] - single UserPackageDB = [ "-user-package-db" ] - isSpecific (SpecificPackageDB _) = True - isSpecific _ = False +import Distribution.Simple -testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] -testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys +main :: IO () +main = defaultMain + +#endif \end{code} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.3.5/http-api-data.cabal new/http-api-data-0.3.7.1/http-api-data.cabal --- old/http-api-data-0.3.5/http-api-data.cabal 2017-01-19 21:50:39.000000000 +0100 +++ new/http-api-data-0.3.7.1/http-api-data.cabal 2017-05-15 14:28:55.000000000 +0200 @@ -1,5 +1,5 @@ name: http-api-data -version: 0.3.5 +version: 0.3.7.1 license: BSD3 license-file: LICENSE author: Nickolay Kudasov <[email protected]> @@ -24,10 +24,9 @@ custom-setup setup-depends: - base >= 4.7 && <4.10, - Cabal >= 1.18 && <1.26, - filepath, - directory + base >= 4.7 && <4.11, + Cabal >= 1.18 && <2.1, + cabal-doctest >=1.0.1 && <1.1 flag use-text-show description: Use text-show library for efficient ToHttpApiData implementations. @@ -37,10 +36,13 @@ library hs-source-dirs: src/ include-dirs: include/ - build-depends: base >= 4.7 && < 4.10 + build-depends: base >= 4.7 && < 4.11 + , attoparsec >= 0.13.0.1 && < 0.14 + , attoparsec-iso8601 >= 1.0.0.0 && < 1.1 , bytestring , containers , hashable + , http-types , text >= 0.5 , time , time-locale-compat >=0.1.1.0 && <0.2 @@ -83,7 +85,6 @@ test-suite doctests ghc-options: -Wall - build-tools: hsc2hs build-depends: base, directory >= 1.0, @@ -91,7 +92,7 @@ filepath default-language: Haskell2010 hs-source-dirs: test - main-is: DocTest.hs + main-is: doctests.hs type: exitcode-stdio-1.0 source-repository head diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.3.5/src/Web/Internal/HttpApiData.hs new/http-api-data-0.3.7.1/src/Web/Internal/HttpApiData.hs --- old/http-api-data-0.3.5/src/Web/Internal/HttpApiData.hs 2017-01-19 21:53:46.000000000 +0100 +++ new/http-api-data-0.3.7.1/src/Web/Internal/HttpApiData.hs 2017-04-21 09:03:49.000000000 +0200 @@ -55,6 +55,12 @@ import Data.Typeable (Typeable) import Data.Data (Data) +import qualified Data.ByteString.Builder as BS +import qualified Network.HTTP.Types as H + +import qualified Data.Attoparsec.Text as Atto +import qualified Data.Attoparsec.Time as Atto + -- $setup -- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show) @@ -70,6 +76,12 @@ toUrlPiece :: a -> Text toUrlPiece = toQueryParam + -- | Convert to a URL path piece, making sure to encode any special chars. + -- The default definition uses 'H.encodePathSegmentsRelative', + -- but this may be overriden with a more efficient version. + toEncodedUrlPiece :: a -> BS.Builder + toEncodedUrlPiece = H.encodePathSegmentsRelative . (:[]) . toUrlPiece + -- | Convert to HTTP header value. toHeader :: a -> ByteString toHeader = encodeUtf8 . toUrlPiece @@ -387,79 +399,120 @@ l = toInteger (minBound :: a) h = toInteger (maxBound :: a) +-- | Convert to a URL-encoded path piece using 'toUrlPiece'. +-- /Note/: this function does not check if the result contains unescaped characters! +-- This function can be used to override 'toEncodedUrlPiece' as a more efficient implementation +-- when the resulting URL piece /never/ has to be escaped. +unsafeToEncodedUrlPiece :: ToHttpApiData a => a -> BS.Builder +unsafeToEncodedUrlPiece = BS.byteString . encodeUtf8 . toUrlPiece + -- | -- >>> toUrlPiece () -- "_" instance ToHttpApiData () where toUrlPiece () = "_" + toEncodedUrlPiece = unsafeToEncodedUrlPiece -instance ToHttpApiData Char where toUrlPiece = T.singleton +instance ToHttpApiData Char where + toUrlPiece = T.singleton -- | -- >>> toUrlPiece (Version [1, 2, 3] []) -- "1.2.3" instance ToHttpApiData Version where toUrlPiece = T.pack . showVersion + toEncodedUrlPiece = unsafeToEncodedUrlPiece #if MIN_VERSION_base(4,8,0) instance ToHttpApiData Void where toUrlPiece = absurd -instance ToHttpApiData Natural where toUrlPiece = showt +instance ToHttpApiData Natural where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece #endif -instance ToHttpApiData Bool where toUrlPiece = showTextData -instance ToHttpApiData Ordering where toUrlPiece = showTextData +instance ToHttpApiData Bool where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Ordering where toUrlPiece = showTextData; toEncodedUrlPiece = unsafeToEncodedUrlPiece -instance ToHttpApiData Double where toUrlPiece = showt -instance ToHttpApiData Float where toUrlPiece = showt -instance ToHttpApiData Int where toUrlPiece = showt -instance ToHttpApiData Int8 where toUrlPiece = showt -instance ToHttpApiData Int16 where toUrlPiece = showt -instance ToHttpApiData Int32 where toUrlPiece = showt -instance ToHttpApiData Int64 where toUrlPiece = showt -instance ToHttpApiData Integer where toUrlPiece = showt -instance ToHttpApiData Word where toUrlPiece = showt -instance ToHttpApiData Word8 where toUrlPiece = showt -instance ToHttpApiData Word16 where toUrlPiece = showt -instance ToHttpApiData Word32 where toUrlPiece = showt -instance ToHttpApiData Word64 where toUrlPiece = showt +instance ToHttpApiData Double where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Float where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Int where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Int8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Int16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Int32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Int64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Integer where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Word where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Word8 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Word16 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Word32 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece +instance ToHttpApiData Word64 where toUrlPiece = showt; toEncodedUrlPiece = unsafeToEncodedUrlPiece -- | -- >>> toUrlPiece (fromGregorian 2015 10 03) -- "2015-10-03" -instance ToHttpApiData Day where toUrlPiece = T.pack . show +instance ToHttpApiData Day where + toUrlPiece = T.pack . show + toEncodedUrlPiece = unsafeToEncodedUrlPiece timeToUrlPiece :: FormatTime t => String -> t -> Text timeToUrlPiece fmt = T.pack . formatTime defaultTimeLocale (iso8601DateFormat (Just fmt)) -- | --- >>> toUrlPiece $ LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01) --- "2015-10-03T14:55:01" -instance ToHttpApiData LocalTime where toUrlPiece = timeToUrlPiece "%H:%M:%S" - --- | --- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 01)) utc --- "2015-10-03T14:55:01+0000" -instance ToHttpApiData ZonedTime where toUrlPiece = timeToUrlPiece "%H:%M:%S%z" - --- | --- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864 --- "2015-10-03T00:14:24Z" -instance ToHttpApiData UTCTime where toUrlPiece = timeToUrlPiece "%H:%M:%SZ" - -instance ToHttpApiData NominalDiffTime where toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer) +-- >>> toUrlPiece $ TimeOfDay 14 55 23.1 +-- "14:55:23.1" +instance ToHttpApiData TimeOfDay where + toUrlPiece = T.pack . formatTime defaultTimeLocale "%H:%M:%S%Q" + toEncodedUrlPiece = unsafeToEncodedUrlPiece + +-- | +-- >>> 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" + toEncodedUrlPiece = unsafeToEncodedUrlPiece + +-- | +-- >>> toUrlPiece $ ZonedTime (LocalTime (fromGregorian 2015 10 03) (TimeOfDay 14 55 51.001)) utc +-- "2015-10-03T14:55:51.001+0000" +instance ToHttpApiData ZonedTime where + toUrlPiece = timeToUrlPiece "%H:%M:%S%Q%z" + toEncodedUrlPiece = unsafeToEncodedUrlPiece + +-- | +-- >>> toUrlPiece $ UTCTime (fromGregorian 2015 10 03) 864.5 +-- "2015-10-03T00:14:24.5Z" +instance ToHttpApiData UTCTime where + toUrlPiece = timeToUrlPiece "%H:%M:%S%QZ" + toEncodedUrlPiece = unsafeToEncodedUrlPiece + +instance ToHttpApiData NominalDiffTime where + toUrlPiece = toUrlPiece . (floor :: NominalDiffTime -> Integer) + toEncodedUrlPiece = unsafeToEncodedUrlPiece instance ToHttpApiData String where toUrlPiece = T.pack instance ToHttpApiData Text where toUrlPiece = id instance ToHttpApiData L.Text where toUrlPiece = L.toStrict -instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll -instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny +instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll; toEncodedUrlPiece = toEncodedUrlPiece . getAll +instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny; toEncodedUrlPiece = toEncodedUrlPiece . getAny -instance ToHttpApiData a => ToHttpApiData (Dual a) where toUrlPiece = toUrlPiece . getDual -instance ToHttpApiData a => ToHttpApiData (Sum a) where toUrlPiece = toUrlPiece . getSum -instance ToHttpApiData a => ToHttpApiData (Product a) where toUrlPiece = toUrlPiece . getProduct -instance ToHttpApiData a => ToHttpApiData (First a) where toUrlPiece = toUrlPiece . getFirst -instance ToHttpApiData a => ToHttpApiData (Last a) where toUrlPiece = toUrlPiece . getLast +instance ToHttpApiData a => ToHttpApiData (Dual a) where + toUrlPiece = toUrlPiece . getDual + toEncodedUrlPiece = toEncodedUrlPiece . getDual + +instance ToHttpApiData a => ToHttpApiData (Sum a) where + toUrlPiece = toUrlPiece . getSum + toEncodedUrlPiece = toEncodedUrlPiece . getSum + +instance ToHttpApiData a => ToHttpApiData (Product a) where + toUrlPiece = toUrlPiece . getProduct + toEncodedUrlPiece = toEncodedUrlPiece . getProduct + +instance ToHttpApiData a => ToHttpApiData (First a) where + toUrlPiece = toUrlPiece . getFirst + toEncodedUrlPiece = toEncodedUrlPiece . getFirst + +instance ToHttpApiData a => ToHttpApiData (Last a) where + toUrlPiece = toUrlPiece . getLast + toEncodedUrlPiece = toEncodedUrlPiece . getLast -- | -- >>> toUrlPiece (Just "Hello") @@ -508,7 +561,7 @@ parseUrlPiece s = do n <- runReader (signed decimal) s if n < 0 - then Left ("undeflow: " <> s <> " (should be a non-negative integer)") + then Left ("underflow: " <> s <> " (should be a non-negative integer)") else Right (fromInteger n) #endif @@ -534,27 +587,30 @@ -- | -- >>> toGregorian <$> parseUrlPiece "2016-12-01" -- Right (2016,12,1) -instance FromHttpApiData Day where parseUrlPiece = readTextData +instance FromHttpApiData Day where parseUrlPiece = runAtto Atto.day -timeParseUrlPiece :: ParseTime t => String -> Text -> Either Text t -timeParseUrlPiece fmt = parseMaybeTextData (timeParseUrlPieceMaybe . T.unpack) - where - timeParseUrlPieceMaybe = parseTime defaultTimeLocale (iso8601DateFormat (Just fmt)) +-- | +-- >>> parseUrlPiece "14:55:01.333" :: Either Text TimeOfDay +-- Right 14:55:01.333 +instance FromHttpApiData TimeOfDay where parseUrlPiece = runAtto Atto.timeOfDay -- | -- >>> parseUrlPiece "2015-10-03T14:55:01" :: Either Text LocalTime -- Right 2015-10-03 14:55:01 -instance FromHttpApiData LocalTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S" +instance FromHttpApiData LocalTime where parseUrlPiece = runAtto Atto.localTime -- | -- >>> parseUrlPiece "2015-10-03T14:55:01+0000" :: Either Text ZonedTime -- Right 2015-10-03 14:55:01 +0000 -instance FromHttpApiData ZonedTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%S%z" +-- +-- >>> 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 -- | -- >>> parseUrlPiece "2015-10-03T00:14:24Z" :: Either Text UTCTime -- Right 2015-10-03 00:14:24 UTC -instance FromHttpApiData UTCTime where parseUrlPiece = timeParseUrlPiece "%H:%M:%SZ" +instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap fromInteger . parseUrlPiece @@ -590,6 +646,7 @@ instance ToHttpApiData UUID.UUID where toUrlPiece = UUID.toText toHeader = UUID.toASCIIBytes + toEncodedUrlPiece = unsafeToEncodedUrlPiece instance FromHttpApiData UUID.UUID where parseUrlPiece = maybe (Left "invalid UUID") Right . UUID.fromText @@ -606,3 +663,12 @@ parseUrlPiece = Right . LenientData . parseUrlPiece parseHeader = Right . LenientData . parseHeader parseQueryParam = Right . LenientData . parseQueryParam + +------------------------------------------------------------------------------- +-- Attoparsec helpers +------------------------------------------------------------------------------- + +runAtto :: Atto.Parser a -> Text -> Either Text a +runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of + Left err -> Left (T.pack err) + Right x -> Right x diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.3.5/test/DocTest.hsc new/http-api-data-0.3.7.1/test/DocTest.hsc --- old/http-api-data-0.3.5/test/DocTest.hsc 2017-01-17 16:20:22.000000000 +0100 +++ new/http-api-data-0.3.7.1/test/DocTest.hsc 1970-01-01 01:00:00.000000000 +0100 @@ -1,58 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} ------------------------------------------------------------------------------ --- | --- Module : Main (doctests) --- Copyright : (C) 2012-14 Edward Kmett --- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett <[email protected]> --- Stability : provisional --- Portability : portable --- --- This module provides doctests for a project based on the actual versions --- of the packages it was built with. It requires a corresponding Setup.lhs --- to be added to the project ------------------------------------------------------------------------------ -module Main where - -import Build_doctests (flags, pkgs, module_sources) -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative -#endif -import Data.Foldable (traverse_) -import Test.DocTest - -##if defined(mingw32_HOST_OS) -##if defined(i386_HOST_ARCH) -##define USE_CP -import Control.Applicative -import Control.Exception -import Foreign.C.Types -foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool -foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt -##elif defined(x86_64_HOST_ARCH) -##define USE_CP -import Control.Applicative -import Control.Exception -import Foreign.C.Types -foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool -foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt -##endif -##endif - --- | Run in a modified codepage where we can print UTF-8 values on Windows. -withUnicode :: IO a -> IO a -##ifdef USE_CP -withUnicode m = do - cp <- c_GetConsoleCP - (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp -##else -withUnicode m = m -##endif - -main :: IO () -main = withUnicode $ do - traverse_ putStrLn args - doctest args - where - args = flags ++ pkgs ++ module_sources diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.3.5/test/Web/Internal/HttpApiDataSpec.hs new/http-api-data-0.3.7.1/test/Web/Internal/HttpApiDataSpec.hs --- old/http-api-data-0.3.5/test/Web/Internal/HttpApiDataSpec.hs 2016-09-26 13:30:33.000000000 +0200 +++ new/http-api-data-0.3.7.1/test/Web/Internal/HttpApiDataSpec.hs 2017-05-15 14:28:55.000000000 +0200 @@ -9,6 +9,7 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Data.ByteString as BS +import Data.ByteString.Builder (toLazyByteString) import Data.Version import qualified Data.UUID as UUID @@ -26,11 +27,21 @@ import Web.Internal.TestInstances -(<=>) :: Eq a => (a -> b) -> (b -> Either T.Text a) -> a -> Bool -(f <=> g) x = g (f x) == Right x +(<=>) :: forall a b. (Show a, Show b, Eq a) => (a -> b) -> (b -> Either T.Text a) -> a -> Property +(f <=> g) x = counterexample + (show lhs' ++ " : " ++ show lhs ++ " /= " ++ show rhs) + (lhs == rhs) + where + lhs' = f x + lhs = g lhs' :: Either T.Text a + rhs = Right x :: Either T.Text a + +encodedUrlPieceProp :: ToHttpApiData a => a -> Property +encodedUrlPieceProp x = toLazyByteString (toEncodedUrlPiece (toUrlPiece x)) === toLazyByteString (toEncodedUrlPiece x) + checkUrlPiece :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a, Arbitrary a) => Proxy a -> String -> Spec -checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Bool) +checkUrlPiece _ name = prop name (toUrlPiece <=> parseUrlPiece :: a -> Property) -- | Check with given generator checkUrlPiece' :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Show a) => Gen a -> String -> Spec @@ -40,6 +51,15 @@ checkUrlPieceI :: forall a. (Eq a, ToHttpApiData a, FromHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec checkUrlPieceI _ = checkUrlPiece (Proxy :: Proxy (RandomCase a)) +-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation. +checkEncodedUrlPiece :: forall a. (Show a, ToHttpApiData a, Arbitrary a) => Proxy a -> String -> Spec +checkEncodedUrlPiece _ = checkEncodedUrlPiece' (arbitrary :: Gen a) + +-- | Check that 'toEncodedUrlPiece' is equivallent to default implementation. +-- Use a given generator. +checkEncodedUrlPiece' :: forall a. (Show a, ToHttpApiData a) => Gen a -> String -> Spec +checkEncodedUrlPiece' gen name = prop name $ forAll gen encodedUrlPieceProp + spec :: Spec spec = do describe "toUrlPiece <=> parseUrlPiece" $ do @@ -62,6 +82,7 @@ checkUrlPiece (Proxy :: Proxy T.Text) "Text.Strict" checkUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy" checkUrlPiece (Proxy :: Proxy Day) "Day" + checkUrlPiece' timeOfDayGen "TimeOfDay" checkUrlPiece' localTimeGen "LocalTime" checkUrlPiece' zonedTimeGen "ZonedTime" checkUrlPiece' utcTimeGen "UTCTime" @@ -78,6 +99,43 @@ checkUrlPiece (Proxy :: Proxy Natural) "Natural" #endif + describe "toEncodedUrlPiece encodes correctly" $ do + checkEncodedUrlPiece (Proxy :: Proxy ()) "()" + checkEncodedUrlPiece (Proxy :: Proxy Char) "Char" + checkEncodedUrlPiece (Proxy :: Proxy Bool) "Bool" + checkEncodedUrlPiece (Proxy :: Proxy Ordering) "Ordering" + checkEncodedUrlPiece (Proxy :: Proxy Int) "Int" + checkEncodedUrlPiece (Proxy :: Proxy Int8) "Int8" + checkEncodedUrlPiece (Proxy :: Proxy Int16) "Int16" + checkEncodedUrlPiece (Proxy :: Proxy Int32) "Int32" + checkEncodedUrlPiece (Proxy :: Proxy Int64) "Int64" + checkEncodedUrlPiece (Proxy :: Proxy Integer) "Integer" + checkEncodedUrlPiece (Proxy :: Proxy Word) "Word" + checkEncodedUrlPiece (Proxy :: Proxy Word8) "Word8" + checkEncodedUrlPiece (Proxy :: Proxy Word16) "Word16" + checkEncodedUrlPiece (Proxy :: Proxy Word32) "Word32" + checkEncodedUrlPiece (Proxy :: Proxy Word64) "Word64" + checkEncodedUrlPiece (Proxy :: Proxy String) "String" + checkEncodedUrlPiece (Proxy :: Proxy T.Text) "Text.Strict" + checkEncodedUrlPiece (Proxy :: Proxy L.Text) "Text.Lazy" + checkEncodedUrlPiece (Proxy :: Proxy Day) "Day" + checkEncodedUrlPiece' timeOfDayGen "TimeOfDay" + checkEncodedUrlPiece' localTimeGen "LocalTime" + checkEncodedUrlPiece' zonedTimeGen "ZonedTime" + checkEncodedUrlPiece' utcTimeGen "UTCTime" + checkEncodedUrlPiece' nominalDiffTimeGen "NominalDiffTime" + checkEncodedUrlPiece (Proxy :: Proxy Version) "Version" + checkEncodedUrlPiece' uuidGen "UUID" + + checkEncodedUrlPiece (Proxy :: Proxy (Maybe String)) "Maybe String" + checkEncodedUrlPiece (Proxy :: Proxy (Maybe Integer)) "Maybe Integer" + checkEncodedUrlPiece (Proxy :: Proxy (Either Integer T.Text)) "Either Integer Text" + checkEncodedUrlPiece (Proxy :: Proxy (Either Version Day)) "Either Version Day" + +#if MIN_VERSION_base(4,8,0) + checkEncodedUrlPiece (Proxy :: Proxy Natural) "Natural" +#endif + it "bad integers are rejected" $ do parseUrlPieceMaybe (T.pack "123hello") `shouldBe` (Nothing :: Maybe Int) @@ -88,14 +146,19 @@ it "invalid utf8 is handled" $ do parseHeaderMaybe (BS.pack [128]) `shouldBe` (Nothing :: Maybe T.Text) + uuidGen :: Gen UUID.UUID uuidGen = UUID.fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -- TODO: this generators don't generate full range items localTimeGen :: Gen LocalTime -localTimeGen = LocalTime - <$> arbitrary - <*> liftA3 TimeOfDay (choose (0, 23)) (choose (0, 59)) (fromInteger <$> choose (0, 60)) +localTimeGen = LocalTime <$> arbitrary <*> timeOfDayGen + +timeOfDayGen :: Gen TimeOfDay +timeOfDayGen = TimeOfDay + <$> choose (0, 23) + <*> choose (0, 59) + <*> fmap (\x -> 0.1 * fromInteger x) (choose (0, 600)) zonedTimeGen :: Gen ZonedTime zonedTimeGen = ZonedTime diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http-api-data-0.3.5/test/doctests.hs new/http-api-data-0.3.7.1/test/doctests.hs --- old/http-api-data-0.3.5/test/doctests.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/http-api-data-0.3.7.1/test/doctests.hs 2017-05-15 14:28:55.000000000 +0200 @@ -0,0 +1,25 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Main (doctests) +-- Copyright : (C) 2012-14 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett <[email protected]> +-- Stability : provisional +-- Portability : portable +-- +-- This module provides doctests for a project based on the actual versions +-- of the packages it was built with. It requires a corresponding Setup.lhs +-- to be added to the project +----------------------------------------------------------------------------- +module Main where + +import Build_doctests (flags, pkgs, module_sources) +import Data.Foldable (traverse_) +import Test.DocTest + +main :: IO () +main = do + traverse_ putStrLn args + doctest args + where + args = flags ++ pkgs ++ module_sources
