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 - psimons@suse.com
+
+- Update to version 0.3.7.1 with cabal2obs.
+
+-------------------------------------------------------------------
+Mon Apr 24 12:26:17 UTC 2017 - psimons@suse.com
+
+- Update to version 0.3.7 with cabal2obs.
+
+-------------------------------------------------------------------
+Wed Apr 19 13:32:14 UTC 2017 - psimons@suse.com
+
+- 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
@@ -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
--- 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
+-- 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