June 2019 - openSUSE Commits - openSUSE Mailing Lists

commit ghc-hsemail for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package ghc-hsemail for openSUSE:Factory checked in at 2019-06-30 10:21:34 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hsemail (Old) and /work/SRC/openSUSE:Factory/.ghc-hsemail.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hsemail" Sun Jun 30 10:21:34 2019 rev:4 rq:712503 version:2.2.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hsemail/ghc-hsemail.changes 2019-06-19 21:12:17.106735785 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hsemail.new.4615/ghc-hsemail.changes 2019-06-30 10:21:35.391628448 +0200 @@ -1,0 +2,15 @@ +Thu Jun 27 02:02:51 UTC 2019 - psimons(a)suse.com + +- Update hsemail to version 2.2.0. + ## v2.2.0 + + * Drop the `parsec2read` function. `Read` is not supposed to be defined + manually, really. It's supposed to be a dual to the derived `Show` instance. + * Drop the Rfc2821 module. This code is not generic enough to be useful, + really. I use it in [Postmaster](http://hackage.haskell.org/package/postmaster), + and there it will live henceforth. + * `caseString` no longer returns a string; it just returns `()`. + * Make use of `DayOfWeek` type from new `time` library. + * Drop the obsolete dependency on `mtl`. + +------------------------------------------------------------------- Old: ---- hsemail-2.1.0.tar.gz New: ---- hsemail-2.2.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hsemail.spec ++++++ --- /var/tmp/diff_new_pack.OUQCTc/_old 2019-06-30 10:21:35.899629238 +0200 +++ /var/tmp/diff_new_pack.OUQCTc/_new 2019-06-30 10:21:35.903629244 +0200 @@ -19,24 +19,24 @@ %global pkg_name hsemail %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.1.0 +Version: 2.2.0 Release: 0 -Summary: Parsec parsers for the RFC2822 Internet Message format +Summary: Parsec parsers for the Internet Message format (e-mail) License: BSD-3-Clause Group: Development/Libraries/Haskell URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel -BuildRequires: ghc-mtl-devel BuildRequires: ghc-parsec-devel BuildRequires: ghc-rpm-macros +BuildRequires: ghc-time-compat-devel BuildRequires: ghc-time-devel %if %{with tests} BuildRequires: ghc-hspec-devel %endif %description -Parsec parsers for the Internet Message format defined in RFC 2821 and 2822. +Parsec parsers for the Internet Message format defined in RFC2822. %package devel Summary: Haskell %{pkg_name} library development files ++++++ hsemail-2.1.0.tar.gz -> hsemail-2.2.0.tar.gz ++++++ ++++ 2924 lines of diff (skipped)

1 0

commit ghc-auto-update for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package ghc-auto-update for openSUSE:Factory checked in at 2019-06-30 10:21:30 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-auto-update (Old) and /work/SRC/openSUSE:Factory/.ghc-auto-update.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-auto-update" Sun Jun 30 10:21:30 2019 rev:12 rq:712501 version:0.1.5 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-auto-update/ghc-auto-update.changes 2019-02-24 17:18:34.276416662 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-auto-update.new.4615/ghc-auto-update.changes 2019-06-30 10:21:31.459622340 +0200 @@ -1,0 +2,9 @@ +Wed Jun 19 11:46:38 UTC 2019 - psimons(a)suse.com + +- Update auto-update to version 0.1.5. + ## 0.1.5 + + * Using the Strict and StrictData language extensions for GHC >8. + [#752](https://github.com/yesodweb/wai/pull/752) + +------------------------------------------------------------------- Old: ---- auto-update-0.1.4.1.tar.gz New: ---- auto-update-0.1.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-auto-update.spec ++++++ --- /var/tmp/diff_new_pack.2KDEl1/_old 2019-06-30 10:21:31.947623098 +0200 +++ /var/tmp/diff_new_pack.2KDEl1/_new 2019-06-30 10:21:31.951623104 +0200 @@ -18,7 +18,7 @@ %global pkg_name auto-update Name: ghc-%{pkg_name} -Version: 0.1.4.1 +Version: 0.1.5 Release: 0 Summary: Efficiently run periodic, on-demand actions License: MIT ++++++ auto-update-0.1.4.1.tar.gz -> auto-update-0.1.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/auto-update-0.1.4.1/ChangeLog.md new/auto-update-0.1.5/ChangeLog.md --- old/auto-update-0.1.4.1/ChangeLog.md 2019-02-20 10:44:00.000000000 +0100 +++ new/auto-update-0.1.5/ChangeLog.md 2019-06-18 03:58:46.000000000 +0200 @@ -1,5 +1,10 @@ # ChangeLog for auto-update +## 0.1.5 + +* Using the Strict and StrictData language extensions for GHC >8. + [#752](https://github.com/yesodweb/wai/pull/752) + ## 0.1.4.1 * [#693](https://github.com/yesodweb/wai/pull/693): diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/auto-update-0.1.4.1/auto-update.cabal new/auto-update-0.1.5/auto-update.cabal --- old/auto-update-0.1.4.1/auto-update.cabal 2019-02-20 10:44:04.000000000 +0100 +++ new/auto-update-0.1.5/auto-update.cabal 2019-06-18 03:58:46.000000000 +0200 @@ -1,5 +1,5 @@ name: auto-update -version: 0.1.4.1 +version: 0.1.5 synopsis: Efficiently run periodic, on-demand actions description: API docs and the README are available at <http://www.stackage.org/package/auto-update>. homepage: https://github.com/yesodweb/wai @@ -21,6 +21,8 @@ other-modules: Control.AutoUpdate.Util build-depends: base >= 4 && < 5 default-language: Haskell2010 + if impl(ghc >= 8) + default-extensions: Strict StrictData -- Test suite is currently not robust enough, gives too many false negatives.

1 0

commit ghc-conduit-extra for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package ghc-conduit-extra for openSUSE:Factory checked in at 2019-06-30 10:21:32 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-conduit-extra (Old) and /work/SRC/openSUSE:Factory/.ghc-conduit-extra.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-conduit-extra" Sun Jun 30 10:21:32 2019 rev:21 rq:712502 version:1.3.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-conduit-extra/ghc-conduit-extra.changes 2019-06-19 21:11:58.822718021 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-conduit-extra.new.4615/ghc-conduit-extra.changes 2019-06-30 10:21:32.283623620 +0200 @@ -1,0 +2,8 @@ +Thu Jun 27 02:02:51 UTC 2019 - psimons(a)suse.com + +- Update conduit-extra to version 1.3.3. + ## 1.3.3 + + * Disable buffering in process modules [#402](https://github.com/snoyberg/conduit/issues/402) + +------------------------------------------------------------------- Old: ---- conduit-extra-1.3.2.tar.gz New: ---- conduit-extra-1.3.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-conduit-extra.spec ++++++ --- /var/tmp/diff_new_pack.0hPyrN/_old 2019-06-30 10:21:32.759624359 +0200 +++ /var/tmp/diff_new_pack.0hPyrN/_new 2019-06-30 10:21:32.763624365 +0200 @@ -19,7 +19,7 @@ %global pkg_name conduit-extra %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.3.2 +Version: 1.3.3 Release: 0 Summary: Batteries included conduit: adapters for common libraries License: MIT ++++++ conduit-extra-1.3.2.tar.gz -> conduit-extra-1.3.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.3.2/ChangeLog.md new/conduit-extra-1.3.3/ChangeLog.md --- old/conduit-extra-1.3.2/ChangeLog.md 2019-06-12 15:52:18.000000000 +0200 +++ new/conduit-extra-1.3.3/ChangeLog.md 2019-06-19 07:58:06.000000000 +0200 @@ -1,5 +1,9 @@ # ChangeLog for conduit-extra +## 1.3.3 + +* Disable buffering in process modules [#402](https://github.com/snoyberg/conduit/issues/402) + ## 1.3.2 * Expose `BuilderInput` and `FlushInput`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.3.2/Data/Conduit/Process/Typed.hs new/conduit-extra-1.3.3/Data/Conduit/Process/Typed.hs --- old/conduit-extra-1.3.2/Data/Conduit/Process/Typed.hs 2019-05-13 15:53:27.000000000 +0200 +++ new/conduit-extra-1.3.3/Data/Conduit/Process/Typed.hs 2019-06-19 07:57:42.000000000 +0200 @@ -25,18 +25,23 @@ import Data.IORef (IORef, newIORef, readIORef, modifyIORef) import Control.Exception (throwIO, catch) import Control.Concurrent.Async (concurrently) +import System.IO (hSetBuffering, BufferMode (NoBuffering)) -- | Provide input to a process by writing to a conduit. -- -- @since 1.2.1 createSink :: MonadIO m => StreamSpec 'STInput (ConduitM S.ByteString o m ()) -createSink = CB.sinkHandle `fmap` createPipe +createSink = + (\h -> liftIO (hSetBuffering h NoBuffering) >> CB.sinkHandle h) + `fmap` createPipe -- | Read output from a process by read from a conduit. -- -- @since 1.2.1 createSource :: MonadIO m => StreamSpec 'STOutput (ConduitM i S.ByteString m ()) -createSource = CB.sourceHandle `fmap` createPipe +createSource = + (\h -> liftIO (hSetBuffering h NoBuffering) >> CB.sourceHandle h) + `fmap` createPipe -- | Internal function: like 'createSource', but stick all chunks into -- the 'IORef'. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.3.2/Data/Conduit/Process.hs new/conduit-extra-1.3.3/Data/Conduit/Process.hs --- old/conduit-extra-1.3.2/Data/Conduit/Process.hs 2019-06-12 15:52:18.000000000 +0200 +++ new/conduit-extra-1.3.3/Data/Conduit/Process.hs 2019-06-19 07:57:42.000000000 +0200 @@ -29,8 +29,9 @@ import Data.Streaming.Process.Internal import System.Exit (ExitCode (..)) import Control.Monad.IO.Unlift (MonadIO, liftIO, MonadUnliftIO, withRunInIO, withUnliftIO, unliftIO) -import System.IO (hClose) +import System.IO (hClose, BufferMode (NoBuffering), hSetBuffering) import Data.Conduit +import Data.Functor (($>)) import Data.Conduit.Binary (sourceHandle, sinkHandle, sinkHandleBuilder, sinkHandleFlush) import Data.ByteString (ByteString) import Data.ByteString.Builder (Builder) @@ -41,9 +42,9 @@ #endif instance (r ~ (), MonadIO m, i ~ ByteString) => InputSource (ConduitM i o m r) where - isStdStream = (\(Just h) -> return $ sinkHandle h, Just CreatePipe) + isStdStream = (\(Just h) -> hSetBuffering h NoBuffering $> sinkHandle h, Just CreatePipe) instance (r ~ (), r' ~ (), MonadIO m, MonadIO n, i ~ ByteString) => InputSource (ConduitM i o m r, n r') where - isStdStream = (\(Just h) -> return (sinkHandle h, liftIO $ hClose h), Just CreatePipe) + isStdStream = (\(Just h) -> hSetBuffering h NoBuffering $> (sinkHandle h, liftIO $ hClose h), Just CreatePipe) -- | Wrapper for input source which accepts 'Data.ByteString.Builder.Builder's. -- You can pass 'Data.ByteString.Builder.Extra.flush' to flush the input. Note @@ -68,9 +69,9 @@ isStdStream = (\(Just h) -> return (FlushInput $ sinkHandleFlush h, liftIO $ hClose h), Just CreatePipe) instance (r ~ (), MonadIO m, o ~ ByteString) => OutputSink (ConduitM i o m r) where - osStdStream = (\(Just h) -> return $ sourceHandle h, Just CreatePipe) + osStdStream = (\(Just h) -> hSetBuffering h NoBuffering $> sourceHandle h, Just CreatePipe) instance (r ~ (), r' ~ (), MonadIO m, MonadIO n, o ~ ByteString) => OutputSink (ConduitM i o m r, n r') where - osStdStream = (\(Just h) -> return (sourceHandle h, liftIO $ hClose h), Just CreatePipe) + osStdStream = (\(Just h) -> hSetBuffering h NoBuffering $> (sourceHandle h, liftIO $ hClose h), Just CreatePipe) -- | Given a @CreateProcess@, run the process, with its output being used as a -- @Source@ to feed the provided @Consumer@. Once the process has completed, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/conduit-extra-1.3.2/conduit-extra.cabal new/conduit-extra-1.3.3/conduit-extra.cabal --- old/conduit-extra-1.3.2/conduit-extra.cabal 2019-06-12 15:52:18.000000000 +0200 +++ new/conduit-extra-1.3.3/conduit-extra.cabal 2019-06-19 07:58:11.000000000 +0200 @@ -1,5 +1,5 @@ Name: conduit-extra -Version: 1.3.2 +Version: 1.3.3 Synopsis: Batteries included conduit: adapters for common libraries. Description: The conduit package itself maintains relative small dependencies. The purpose of this package is to collect commonly used utility functions wrapping other library dependencies, without depending on heavier-weight dependencies. The basic idea is that this package should only depend on haskell-platform packages and conduit.

1 0

commit ghc-asn1-types for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package ghc-asn1-types for openSUSE:Factory checked in at 2019-06-30 10:21:28 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-asn1-types (Old) and /work/SRC/openSUSE:Factory/.ghc-asn1-types.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-asn1-types" Sun Jun 30 10:21:28 2019 rev:8 rq:712500 version:0.3.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-asn1-types/ghc-asn1-types.changes 2018-10-25 08:22:27.163908442 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-asn1-types.new.4615/ghc-asn1-types.changes 2019-06-30 10:21:29.479619264 +0200 @@ -1,0 +2,6 @@ +Mon Jun 24 02:01:32 UTC 2019 - psimons(a)suse.com + +- Update asn1-types to version 0.3.3. + Upstream does not provide a change log file. + +------------------------------------------------------------------- Old: ---- asn1-types-0.3.2.tar.gz New: ---- asn1-types-0.3.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-asn1-types.spec ++++++ --- /var/tmp/diff_new_pack.yU23ce/_old 2019-06-30 10:21:29.991620059 +0200 +++ /var/tmp/diff_new_pack.yU23ce/_new 2019-06-30 10:21:29.995620065 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-asn1-types # -# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,7 +18,7 @@ %global pkg_name asn1-types Name: ghc-%{pkg_name} -Version: 0.3.2 +Version: 0.3.3 Release: 0 Summary: ASN.1 types License: BSD-3-Clause ++++++ asn1-types-0.3.2.tar.gz -> asn1-types-0.3.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/asn1-types-0.3.2/Data/ASN1/Types/String.hs new/asn1-types-0.3.3/Data/ASN1/Types/String.hs --- old/asn1-types-0.3.2/Data/ASN1/Types/String.hs 2015-12-19 08:32:06.000000000 +0100 +++ new/asn1-types-0.3.3/Data/ASN1/Types/String.hs 2019-06-23 15:26:50.000000000 +0200 @@ -148,18 +148,23 @@ b1 = fromIntegral (v .&. 0xff) decodeUTF32 :: ByteString -> String -decodeUTF32 b - | (B.length b `mod` 4) /= 0 = error "not a valid UTF32 string" - | otherwise = fromUTF32 $ B.unpack b - where fromUTF32 (a:b:c:d:l) = - let v :: Word32 - v = (fromIntegral a `shiftL` 24) .|. - (fromIntegral b `shiftL` 16) .|. - (fromIntegral c `shiftL` 8) .|. - (fromIntegral d) - in toEnum (fromIntegral v) : fromUTF32 l - fromUTF32 [] = [] - fromUTF32 _ = error "decodeUTF32: internal error" +decodeUTF32 bs + | (B.length bs `mod` 4) /= 0 = error "not a valid UTF32 string" + | otherwise = fromUTF32 0 + where w32ToChar :: Word32 -> Char + w32ToChar = toEnum . fromIntegral + fromUTF32 ofs + | ofs == B.length bs = [] + | otherwise = + let a = B.index bs ofs + b = B.index bs (ofs+1) + c = B.index bs (ofs+2) + d = B.index bs (ofs+3) + v = (fromIntegral a `shiftL` 24) .|. + (fromIntegral b `shiftL` 16) .|. + (fromIntegral c `shiftL` 8) .|. + (fromIntegral d) + in w32ToChar v : fromUTF32 (ofs+4) encodeUTF32 :: String -> ByteString encodeUTF32 s = B.pack $ concatMap (toUTF32 . fromEnum) s where toUTF32 v = [b0,b1,b2,b3] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/asn1-types-0.3.2/asn1-types.cabal new/asn1-types-0.3.3/asn1-types.cabal --- old/asn1-types-0.3.2/asn1-types.cabal 2015-12-19 08:32:06.000000000 +0100 +++ new/asn1-types-0.3.3/asn1-types.cabal 2019-06-23 15:55:10.000000000 +0200 @@ -1,5 +1,5 @@ Name: asn1-types -Version: 0.3.2 +Version: 0.3.3 Description: ASN.1 standard types License: BSD3 License-file: LICENSE @@ -11,7 +11,7 @@ Category: Data stability: experimental Cabal-Version: >=1.6 -Homepage: http://github.com/vincenthz/hs-asn1-types +Homepage: http://github.com/vincenthz/hs-asn1 Library Build-Depends: base >= 3 && < 5 @@ -29,4 +29,4 @@ source-repository head type: git - location: git://github.com/vincenthz/hs-asn1-types + location: git://github.com/vincenthz/hs-asn1

1 0

commit ghc-aeson for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package ghc-aeson for openSUSE:Factory checked in at 2019-06-30 10:21:25 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-aeson (Old) and /work/SRC/openSUSE:Factory/.ghc-aeson.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-aeson" Sun Jun 30 10:21:25 2019 rev:23 rq:712499 version:1.4.4.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-aeson/ghc-aeson.changes 2019-05-09 10:09:44.781085815 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-aeson.new.4615/ghc-aeson.changes 2019-06-30 10:21:26.535614690 +0200 @@ -1,0 +2,39 @@ +Tue Jun 25 02:02:15 UTC 2019 - psimons(a)suse.com + +- Update aeson to version 1.4.4.0. + ### 1.4.4.0 + + **New features**: + + * Adds a parameterized parser `jsonWith` that can be used to choose how to handle duplicate keys in objects, thanks to Xia Li-Yao. + + * Add generic implementations of `FromJSONKey` and `ToJSONKey`, thanks to Xia Li-Yao. Example: + + ```haskell + data Foo = Bar + deriving Generic + + opts :: JSONKeyOptions + opts = defaultJSONKeyOptions { keyModifier = toLower } + + instance ToJSONKey Foo where + toJSONKey = genericToJSONKey opts + + instance FromJSONKey Foo where + fromJSONKey = genericFromJSONKey opts + ``` + + **Minor**: + * aeson now uses `time-compat` instead of `time-locale-compat`, thanks to Oleg Grenrus. + * Prepare for `MonadFail` breakages in GHC 8.8, thanks to Oleg Grenrus. + * Require `bytestring >= 0.10.8.1` for newer GHCs to avoid build failures, thanks to Oleg Grenrus. + * Support `primitive 0.7.*`, thanks to Adam Bergmark. + * Allow `semigroups 0.19.*` and `hashable 1.3.*`, thanks to Oleg Grenrus. + * Fix a typo in the error message when parsing `NonEmpty`, thanks to Colin Woodbury. + * Document surprising behavior when using `omitNothingFields` with type variables, thanks to Xia Li-Yao. + + **Internal changes**: + * Code cleanup by Oleg Grenrus + * Fix dependencies of the benchmarks on older GHC's, thanks to Xia Li-Yao. + +------------------------------------------------------------------- Old: ---- aeson-1.4.3.0.tar.gz New: ---- aeson-1.4.4.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-aeson.spec ++++++ --- /var/tmp/diff_new_pack.dYqMyI/_old 2019-06-30 10:21:27.019615442 +0200 +++ /var/tmp/diff_new_pack.dYqMyI/_new 2019-06-30 10:21:27.023615448 +0200 @@ -19,7 +19,7 @@ %global pkg_name aeson %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.4.3.0 +Version: 1.4.4.0 Release: 0 Summary: Fast JSON parsing and encoding License: BSD-3-Clause @@ -41,8 +41,8 @@ BuildRequires: ghc-template-haskell-devel BuildRequires: ghc-text-devel BuildRequires: ghc-th-abstraction-devel +BuildRequires: ghc-time-compat-devel BuildRequires: ghc-time-devel -BuildRequires: ghc-time-locale-compat-devel BuildRequires: ghc-unordered-containers-devel BuildRequires: ghc-uuid-types-devel BuildRequires: ghc-vector-devel ++++++ aeson-1.4.3.0.tar.gz -> aeson-1.4.4.0.tar.gz ++++++ ++++ 1726 lines of diff (skipped)

1 0

commit ghc-JuicyPixels for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package ghc-JuicyPixels for openSUSE:Factory checked in at 2019-06-30 10:21:23 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-JuicyPixels (Old) and /work/SRC/openSUSE:Factory/.ghc-JuicyPixels.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-JuicyPixels" Sun Jun 30 10:21:23 2019 rev:24 rq:712498 version:3.3.3.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-JuicyPixels/ghc-JuicyPixels.changes 2019-06-19 21:11:46.662706206 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-JuicyPixels.new.4615/ghc-JuicyPixels.changes 2019-06-30 10:21:24.515611552 +0200 @@ -1,0 +2,9 @@ +Thu Jun 20 02:03:03 UTC 2019 - psimons(a)suse.com + +- Update JuicyPixels to version 3.3.3.1. + Upstream has edited the change log file since the last release in + a non-trivial way, i.e. they did more than just add a new entry + at the top. You can review the file at: + http://hackage.haskell.org/package/JuicyPixels-3.3.3.1/src/changelog + +------------------------------------------------------------------- Old: ---- JuicyPixels-3.3.3.tar.gz JuicyPixels.cabal New: ---- JuicyPixels-3.3.3.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-JuicyPixels.spec ++++++ --- /var/tmp/diff_new_pack.pVyu0T/_old 2019-06-30 10:21:25.199612615 +0200 +++ /var/tmp/diff_new_pack.pVyu0T/_new 2019-06-30 10:21:25.207612627 +0200 @@ -18,14 +18,13 @@ %global pkg_name JuicyPixels Name: ghc-%{pkg_name} -Version: 3.3.3 +Version: 3.3.3.1 Release: 0 Summary: Picture loading/serialization (in png, jpeg, bitmap, gif, tga, tiff and radiance) License: BSD-3-Clause Group: Development/Libraries/Haskell URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-binary-devel BuildRequires: ghc-bytestring-devel @@ -55,7 +54,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ JuicyPixels-3.3.3.tar.gz -> JuicyPixels-3.3.3.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/JuicyPixels.cabal new/JuicyPixels-3.3.3.1/JuicyPixels.cabal --- old/JuicyPixels-3.3.3/JuicyPixels.cabal 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/JuicyPixels.cabal 2019-06-19 21:11:57.000000000 +0200 @@ -1,5 +1,5 @@ Name: JuicyPixels -Version: 3.3.3 +Version: 3.3.3.1 Synopsis: Picture loading/serialization (in png, jpeg, bitmap, gif, tga, tiff and radiance) Description: <<data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAMAAAADABAMAAACg8nE0AAAAElBMVEUAAABJqDSTWEL/qyb///8AAABH/1GTAAAAAXRSTlMAQObYZgAAAN5JREFUeF7s1sEJgFAQxFBbsAV72v5bEVYWPwT/XDxmCsi7zvHXavYREBDI3XP2GgICqBBYuwIC+/rVayPUAyAg0HvIXBcQoDFDGnUBgWQQ2Bx3AYFaRoBpAQHWb3bt2ARgGAiCYFFuwf3X5HA/McgGJWI2FdykCv4aBYzmKwDwvl6NVmUAAK2vlwEALK7fo88GANB6HQsAAAAAAAAA7P94AQCzswEAAAAAAAAAAAAAAAAAAICzh4UAO4zWAYBfRutHA4Bn5C69JhowAMGoBaMWDG0wCkbBKBgFo2AUAACPmegUST/IJAAAAABJRU5ErkJggg==>> @@ -28,7 +28,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/Juicy.Pixels.git - Tag: v3.3.3 + Tag: v3.3.3.1 Flag Mmap Description: Enable the file loading via mmap (memory map) @@ -69,11 +69,11 @@ Build-depends: base >= 4.8 && < 6, bytestring >= 0.9 && < 0.11, mtl >= 1.1 && < 2.3, - binary >= 0.5 && < 0.9, + binary >= 0.8.1 && < 0.9, zlib >= 0.5.3.1 && < 0.7, transformers >= 0.2, vector >= 0.10 && < 0.13, - primitive >= 0.4 && < 0.7, + primitive >= 0.4, deepseq >= 1.1 && < 1.5, containers >= 0.4.2 && < 0.7 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/changelog new/JuicyPixels-3.3.3.1/changelog --- old/JuicyPixels-3.3.3/changelog 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/changelog 2019-06-19 21:11:17.000000000 +0200 @@ -1,6 +1,11 @@ Change log ========== +v3.3.3.1 June 2019 +------------------ + + * New GHC maintenance (thanks to ekmett) + v3.3.3 December 2018 -------------------- @@ -9,6 +14,8 @@ * Refactoring: exposing dynamicMap & dynamicPixelMap through `Codec.Picture` (thnks to LightAndLight) + * v3.3.3.1: fixing compilation with older GHC + v3.3.2 October 2018 ------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/Bitmap.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/Bitmap.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/Bitmap.hs 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/Bitmap.hs 2019-06-19 21:11:57.000000000 +0200 @@ -12,9 +12,9 @@ , decodeBitmap , decodeBitmapWithMetadata , decodeBitmapWithPaletteAndMetadata - , encodeDynamicBitmap + , encodeDynamicBitmap , encodeBitmapWithPaletteAndMetadata - , writeDynamicBitmap + , writeDynamicBitmap -- * Accepted format in output , BmpEncodable( ) ) where @@ -36,12 +36,12 @@ , putInt32le , putWord16le , putWord32le - , putByteString + , putByteString ) import Data.Binary.Get( Get , getWord8 - , getWord16le + , getWord16le , getWord32le , getInt32le , getByteString @@ -400,7 +400,7 @@ instance BmpEncodable PixelRGBA8 where hasAlpha _ = True bitsPerPixel _ = 32 - bmpEncode (Image {imageWidth = w, imageHeight = h, imageData = arr}) = + bmpEncode (Image {imageWidth = w, imageHeight = h, imageData = arr}) = forM_ [h - 1, h - 2 .. 0] $ \l -> putVector $ runST $ putLine l where putVector vec = putByteString . blitVector vec 0 $ w * 4 @@ -445,7 +445,7 @@ let r = arr `VS.unsafeIndex` readIdx g = arr `VS.unsafeIndex` (readIdx + 1) b = arr `VS.unsafeIndex` (readIdx + 2) - + (buff `M.unsafeWrite` writeIdx) b (buff `M.unsafeWrite` (writeIdx + 1)) g (buff `M.unsafeWrite` (writeIdx + 2)) r @@ -624,7 +624,7 @@ VS.unsafeFreeze arr padding = linePadding (fromIntegral bpp) wi - + readLine :: forall s. M.MVector s Word8 -> Int -> Int -> ST s Int readLine arr readIndex line = case lowBPP of OneBPP -> inner1 readIndex writeIndex @@ -678,7 +678,7 @@ inner (0 : 1 : _) _ = return () inner (0 : 2 : hOffset : vOffset : rest) (yOffset, _) = inner rest (yOffset - (wi * fromIntegral vOffset), fromIntegral hOffset) - inner (0 : n : rest) writePos = + inner (0 : n : rest) writePos = let isPadded = if is4bpp then (n + 3) .&. 0x3 < 2 else odd n in copyN isPadded (fromIntegral n) rest writePos inner (n : b : rest) writePos = writeN (fromIntegral n) b rest writePos @@ -735,7 +735,7 @@ metadataOfHeader :: BmpV5Header -> Maybe B.ByteString -> Metadatas metadataOfHeader hdr iccProfile = - cs <> Met.simpleMetadata Met.SourceBitmap (width hdr) (abs $ height hdr) dpiX dpiY + cs `mappend` Met.simpleMetadata Met.SourceBitmap (width hdr) (abs $ height hdr) dpiX dpiY where dpiX = Met.dotsPerMeterToDotPerInch . fromIntegral $ xResolution hdr dpiY = Met.dotsPerMeterToDotPerInch . fromIntegral $ yResolution hdr @@ -847,7 +847,7 @@ decodeImageRGB8 RGB24 hdr rest (16, 1, 0) -> do rest <- getData - return . TrueColorImage . ImageRGB8 $ + return . TrueColorImage . ImageRGB8 $ decodeImageRGB8 (RGB16 defaultBitfieldsRGB16) hdr rest (16, 1, 3) -> do r <- getBitfield . fromIntegral $ 0xFFFF .&. redMask hdr @@ -884,7 +884,11 @@ a -> fail $ "Can't handle BMP file " ++ show a -- | Decode a bitfield. Will fail if the bitfield is empty. +#if MIN_VERSION_base(4,13,0) +getBitfield :: (FiniteBits t, Integral t, Num t, MonadFail m) => t -> m (Bitfield t) +#else getBitfield :: (FiniteBits t, Integral t, Num t, Monad m) => t -> m (Bitfield t) +#endif getBitfield 0 = fail $ "Codec.Picture.Bitmap.getBitfield: bitfield cannot be 0" getBitfield w = return (makeBitfield w) @@ -911,7 +915,7 @@ -- the following metadatas: -- -- * 'Codec.Picture.Metadata.DpiX' --- * 'Codec.Picture.Metadata.DpiY' +-- * 'Codec.Picture.Metadata.DpiY' -- encodeBitmapWithMetadata :: forall pixel. BmpEncodable pixel => Metadatas -> Image pixel -> L.ByteString @@ -952,7 +956,7 @@ -- the following metadatas: -- -- * 'Codec.Picture.Metadata.DpiX' --- * 'Codec.Picture.Metadata.DpiY' +-- * 'Codec.Picture.Metadata.DpiY' -- encodeBitmapWithPaletteAndMetadata :: forall pixel. (BmpEncodable pixel) => Metadatas -> BmpPalette -> Image pixel diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/ColorQuant.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/ColorQuant.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/ColorQuant.hs 2018-03-14 21:32:58.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/ColorQuant.hs 2019-06-19 21:11:57.000000000 +0200 @@ -120,7 +120,7 @@ (bg, br, bb) = bitDiv3 maxCols (dr, dg, db) = (2^(8-br), 2^(8-bg), 2^(8-bb)) paletteIndex (PixelRGB8 r g b) = fromIntegral $ fromMaybe 0 (elemIndex - (PixelRGB8 (r .&. (256 - dr)) (g .&. (256 - dg)) (b .&. (256 - db))) + (PixelRGB8 (r .&. negate dr) (g .&. negate dg) (b .&. negate db)) paletteList) isColorCountBelow :: Int -> Image PixelRGB8 -> (Set.Set PixelRGB8, Bool) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/HDR.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/HDR.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/HDR.hs 2016-09-04 14:18:57.000000000 +0200 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/HDR.hs 2019-06-19 21:11:57.000000000 +0200 @@ -1,530 +1,534 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TupleSections #-} --- | Module dedicated of Radiance file decompression (.hdr or .pic) file. --- Radiance file format is used for High dynamic range imaging. -module Codec.Picture.HDR( decodeHDR - , decodeHDRWithMetadata - , encodeHDR - , encodeRawHDR - , encodeRLENewStyleHDR - , writeHDR - , writeRLENewStyleHDR - ) where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative( pure, (<*>), (<$>) ) -#endif - -import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR ) -import Data.Char( ord, chr, isDigit ) -import Data.Word( Word8 ) -import Data.Monoid( (<>) ) -import Control.Monad( when, foldM, foldM_, forM, forM_, unless ) -import Control.Monad.Trans.Class( lift ) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Char8 as BC - -import Data.List( partition ) -import Data.Binary( Binary( .. ), encode ) -import Data.Binary.Get( Get, getByteString, getWord8 ) -import Data.Binary.Put( putByteString, putLazyByteString ) - -import Control.Monad.ST( ST, runST ) -import Foreign.Storable ( Storable ) -import Control.Monad.Primitive ( PrimState, PrimMonad ) -import qualified Data.Vector.Storable as V -import qualified Data.Vector.Storable.Mutable as M - -import Codec.Picture.Metadata( Metadatas - , SourceFormat( SourceHDR ) - , basicMetadata ) -import Codec.Picture.InternalHelper -import Codec.Picture.Types -import Codec.Picture.VectorByteConversion - -#if MIN_VERSION_transformers(0, 4, 0) -import Control.Monad.Trans.Except( ExceptT, throwE, runExceptT ) -#else --- Transfomers 0.3 compat -import Control.Monad.Trans.Error( Error, ErrorT, throwError, runErrorT ) - -type ExceptT = ErrorT - -throwE :: (Monad m, Error e) => e -> ErrorT e m a -throwE = throwError - -runExceptT :: ErrorT e m a -> m (Either e a) -runExceptT = runErrorT -#endif - -{-# INLINE (.<<.) #-} -(.<<.), (.>>.) :: (Bits a) => a -> Int -> a -(.<<.) = unsafeShiftL -(.>>.) = unsafeShiftR - -{-# INLINE (.<-.) #-} -(.<-.) :: (PrimMonad m, Storable a) - => M.STVector (PrimState m) a -> Int -> a -> m () -(.<-.) = M.write - {-M.unsafeWrite-} - -type HDRReader s a = ExceptT String (ST s) a - -data RGBE = RGBE !Word8 !Word8 !Word8 !Word8 - -instance Binary RGBE where - put (RGBE r g b e) = put r >> put g >> put b >> put e - get = RGBE <$> get <*> get <*> get <*> get - -checkLineLength :: RGBE -> Int -checkLineLength (RGBE _ _ a b) = - (fromIntegral a .<<. 8) .|. fromIntegral b - -isNewRunLengthMarker :: RGBE -> Bool -isNewRunLengthMarker (RGBE 2 2 _ _) = True -isNewRunLengthMarker _ = False - -data RadianceFormat = - FormatRGBE - | FormatXYZE - -radiance32bitRleRGBEFormat, radiance32bitRleXYZEFromat :: B.ByteString -radiance32bitRleRGBEFormat = BC.pack "32-bit_rle_rgbe" -radiance32bitRleXYZEFromat = BC.pack "32-bit_rle_xyze" - -instance Binary RadianceFormat where - put FormatRGBE = putByteString radiance32bitRleRGBEFormat - put FormatXYZE = putByteString radiance32bitRleXYZEFromat - - get = getByteString (B.length radiance32bitRleRGBEFormat) >>= format - where format sig - | sig == radiance32bitRleRGBEFormat = pure FormatRGBE - | sig == radiance32bitRleXYZEFromat = pure FormatXYZE - | otherwise = fail "Unrecognized Radiance format" - -toRGBE :: PixelRGBF -> RGBE -toRGBE (PixelRGBF r g b) - | d <= 1e-32 = RGBE 0 0 0 0 - | otherwise = RGBE (fix r) (fix g) (fix b) (fromIntegral $ e + 128) - where d = maximum [r, g, b] - e = exponent d - coeff = significand d * 255.9999 / d - fix v = truncate $ v * coeff - - -dropUntil :: Word8 -> Get () -dropUntil c = getWord8 >>= inner - where inner val | val == c = pure () - inner _ = getWord8 >>= inner - -getUntil :: (Word8 -> Bool) -> B.ByteString -> Get B.ByteString -getUntil f initialAcc = getWord8 >>= inner initialAcc - where inner acc c | f c = pure acc - inner acc c = getWord8 >>= inner (B.snoc acc c) - -data RadianceHeader = RadianceHeader - { radianceInfos :: [(B.ByteString, B.ByteString)] - , radianceFormat :: RadianceFormat - , radianceHeight :: !Int - , radianceWidth :: !Int - , radianceData :: L.ByteString - } - -radianceFileSignature :: B.ByteString -radianceFileSignature = BC.pack "#?RADIANCE\n" - -unpackColor :: L.ByteString -> Int -> RGBE -unpackColor str idx = RGBE (at 0) (at 1) (at 2) (at 3) - where at n = L.index str . fromIntegral $ idx + n - -storeColor :: M.STVector s Word8 -> Int -> RGBE -> ST s () -storeColor vec idx (RGBE r g b e) = do - (vec .<-. (idx + 0)) r - (vec .<-. (idx + 1)) g - (vec .<-. (idx + 2)) b - (vec .<-. (idx + 3)) e - -parsePair :: Char -> Get (B.ByteString, B.ByteString) -parsePair firstChar = do - let eol c = c == fromIntegral (ord '\n') - line <- getUntil eol B.empty - case BC.split '=' line of - [] -> pure (BC.singleton firstChar, B.empty) - [val] -> pure (BC.singleton firstChar, val) - [key, val] -> pure (BC.singleton firstChar <> key, val) - (key : vals) -> pure (BC.singleton firstChar <> key, B.concat vals) - -decodeInfos :: Get [(B.ByteString, B.ByteString)] -decodeInfos = do - char <- getChar8 - case char of - -- comment - '#' -> dropUntil (fromIntegral $ ord '\n') >> decodeInfos - -- end of header, no more information - '\n' -> pure [] - -- Classical parsing - c -> (:) <$> parsePair c <*> decodeInfos - - --- | Decode an HDR (radiance) image, the resulting image can be: --- --- * 'ImageRGBF' --- -decodeHDR :: B.ByteString -> Either String DynamicImage -decodeHDR = fmap fst . decodeHDRWithMetadata - --- | Equivalent to decodeHDR but with aditional metadatas. -decodeHDRWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas) -decodeHDRWithMetadata str = runST $ runExceptT $ - case runGet decodeHeader $ L.fromChunks [str] of - Left err -> throwE err - Right rez -> - let meta = basicMetadata SourceHDR (abs $ radianceWidth rez) (abs $ radianceHeight rez) in - (, meta) . ImageRGBF <$> (decodeRadiancePicture rez >>= lift . unsafeFreezeImage) - -getChar8 :: Get Char -getChar8 = chr . fromIntegral <$> getWord8 - -isSign :: Char -> Bool -isSign c = c == '+' || c == '-' - -isAxisLetter :: Char -> Bool -isAxisLetter c = c == 'X' || c == 'Y' - -decodeNum :: Get Int -decodeNum = do - sign <- getChar8 - letter <- getChar8 - space <- getChar8 - - unless (isSign sign && isAxisLetter letter && space == ' ') - (fail "Invalid radiance size declaration") - - let numDec acc c | isDigit c = - getChar8 >>= numDec (acc * 10 + ord c - ord '0') - numDec acc _ - | sign == '-' = pure $ negate acc - | otherwise = pure acc - - getChar8 >>= numDec 0 - -copyPrevColor :: M.STVector s Word8 -> Int -> ST s () -copyPrevColor scanLine idx = do - r <- scanLine `M.unsafeRead` (idx - 4) - g <- scanLine `M.unsafeRead` (idx - 3) - b <- scanLine `M.unsafeRead` (idx - 2) - e <- scanLine `M.unsafeRead` (idx - 1) - - (scanLine `M.unsafeWrite` (idx + 0)) r - (scanLine `M.unsafeWrite` (idx + 1)) g - (scanLine `M.unsafeWrite` (idx + 2)) b - (scanLine `M.unsafeWrite` (idx + 3)) e - -oldStyleRLE :: L.ByteString -> Int -> M.STVector s Word8 - -> HDRReader s Int -oldStyleRLE inputData initialIdx scanLine = inner initialIdx 0 0 - where maxOutput = M.length scanLine - maxInput = fromIntegral $ L.length inputData - - inner readIdx writeIdx _ - | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx - inner readIdx writeIdx shift = do - let color@(RGBE r g b e) = unpackColor inputData readIdx - isRun = r == 1 && g == 1 && b == 1 - - if not isRun - then do - lift $ storeColor scanLine writeIdx color - inner (readIdx + 4) (writeIdx + 4) 0 - - else do - let count = fromIntegral e .<<. shift - lift $ forM_ [0 .. count] $ \i -> copyPrevColor scanLine (writeIdx + 4 * i) - inner (readIdx + 4) (writeIdx + 4 * count) (shift + 8) - -newStyleRLE :: L.ByteString -> Int -> M.STVector s Word8 - -> HDRReader s Int -newStyleRLE inputData initialIdx scanline = foldM inner initialIdx [0 .. 3] - where dataAt idx - | fromIntegral idx >= maxInput = throwE $ "Read index out of bound (" ++ show idx ++ ")" - | otherwise = pure $ L.index inputData (fromIntegral idx) - - maxOutput = M.length scanline - maxInput = fromIntegral $ L.length inputData - stride = 4 - - - strideSet count destIndex _ | endIndex > maxOutput + stride = - throwE $ "Out of bound HDR scanline " ++ show endIndex ++ " (max " ++ show maxOutput ++ ")" - where endIndex = destIndex + count * stride - strideSet count destIndex val = aux destIndex count - where aux i 0 = pure i - aux i c = do - lift $ (scanline .<-. i) val - aux (i + stride) (c - 1) - - - strideCopy _ count destIndex - | writeEndBound > maxOutput + stride = throwE "Out of bound HDR scanline" - where writeEndBound = destIndex + count * stride - strideCopy sourceIndex count destIndex = aux sourceIndex destIndex count - where aux _ j 0 = pure j - aux i j c = do - val <- dataAt i - lift $ (scanline .<-. j) val - aux (i + 1) (j + stride) (c - 1) - - inner readIdx writeIdx - | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx - inner readIdx writeIdx = do - code <- dataAt readIdx - if code > 128 - then do - let repeatCount = fromIntegral code .&. 0x7F - newVal <- dataAt $ readIdx + 1 - endIndex <- strideSet repeatCount writeIdx newVal - inner (readIdx + 2) endIndex - - else do - let iCode = fromIntegral code - endIndex <- strideCopy (readIdx + 1) iCode writeIdx - inner (readIdx + iCode + 1) endIndex - -instance Binary RadianceHeader where - get = decodeHeader - put hdr = do - putByteString radianceFileSignature - putByteString $ BC.pack "FORMAT=" - put $ radianceFormat hdr - let sizeString = - BC.pack $ "\n\n-Y " ++ show (radianceHeight hdr) - ++ " +X " ++ show (radianceWidth hdr) ++ "\n" - putByteString sizeString - putLazyByteString $ radianceData hdr - - -decodeHeader :: Get RadianceHeader -decodeHeader = do - sig <- getByteString $ B.length radianceFileSignature - when (sig /= radianceFileSignature) - (fail "Invalid radiance file signature") - - infos <- decodeInfos - let formatKey = BC.pack "FORMAT" - case partition (\(k,_) -> k /= formatKey) infos of - (_, []) -> fail "No radiance format specified" - (info, [(_, formatString)]) -> - case runGet get $ L.fromChunks [formatString] of - Left err -> fail err - Right format -> do - (n1, n2, b) <- (,,) <$> decodeNum - <*> decodeNum - <*> getRemainingBytes - return . RadianceHeader info format n1 n2 $ L.fromChunks [b] - - _ -> fail "Multiple radiance format specified" - -toFloat :: RGBE -> PixelRGBF -toFloat (RGBE r g b e) = PixelRGBF rf gf bf - where f = encodeFloat 1 $ fromIntegral e - (128 + 8) - rf = (fromIntegral r + 0.0) * f - gf = (fromIntegral g + 0.0) * f - bf = (fromIntegral b + 0.0) * f - -encodeScanlineColor :: M.STVector s Word8 - -> M.STVector s Word8 - -> Int - -> ST s Int -encodeScanlineColor vec outVec outIdx = do - val <- vec `M.unsafeRead` 0 - runLength 1 0 val 1 outIdx - where maxIndex = M.length vec - - pushRun len val at = do - (outVec `M.unsafeWrite` at) $ fromIntegral $ len .|. 0x80 - (outVec `M.unsafeWrite` (at + 1)) val - return $ at + 2 - - pushData start len at = do - (outVec `M.unsafeWrite` at) $ fromIntegral len - let first = start - len - end = start - 1 - offset = at - first + 1 - forM_ [first .. end] $ \i -> do - v <- vec `M.unsafeRead` i - (outVec `M.unsafeWrite` (offset + i)) v - - return $ at + len + 1 - - -- End of scanline, empty the thing - runLength run cpy prev idx at | idx >= maxIndex = - case (run, cpy) of - (0, 0) -> pure at - (0, n) -> pushData idx n at - (n, 0) -> pushRun n prev at - (_, _) -> error "HDR - Run length algorithm is wrong" - - -- full runlength, we must write the packet - runLength r@127 _ prev idx at = do - val <- vec `M.unsafeRead` idx - pushRun r prev at >>= - runLength 1 0 val (idx + 1) - - -- full copy, we must write the packet - runLength _ c@127 _ idx at = do - val <- vec `M.unsafeRead` idx - pushData idx c at >>= - runLength 1 0 val (idx + 1) - - runLength n 0 prev idx at = do - val <- vec `M.unsafeRead` idx - case val == prev of - True -> runLength (n + 1) 0 prev (idx + 1) at - False | n < 4 -> runLength 0 (n + 1) val (idx + 1) at - False -> - pushRun n prev at >>= - runLength 1 0 val (idx + 1) - - runLength 0 n prev idx at = do - val <- vec `M.unsafeRead` idx - if val /= prev - then runLength 0 (n + 1) val (idx + 1) at - else - pushData (idx - 1) (n - 1) at >>= - runLength (2 :: Int) 0 val (idx + 1) - - runLength _ _ _ _ _ = - error "HDR RLE inconsistent state" - --- | Write an High dynamic range image into a radiance --- image file on disk. -writeHDR :: FilePath -> Image PixelRGBF -> IO () -writeHDR filename img = L.writeFile filename $ encodeHDR img - --- | Write a RLE encoded High dynamic range image into a radiance --- image file on disk. -writeRLENewStyleHDR :: FilePath -> Image PixelRGBF -> IO () -writeRLENewStyleHDR filename img = - L.writeFile filename $ encodeRLENewStyleHDR img - --- | Encode an High dynamic range image into a radiance image --- file format. --- Alias for encodeRawHDR -encodeHDR :: Image PixelRGBF -> L.ByteString -encodeHDR = encodeRawHDR - --- | Encode an High dynamic range image into a radiance image --- file format. without compression -encodeRawHDR :: Image PixelRGBF -> L.ByteString -encodeRawHDR pic = encode descriptor - where - newImage = pixelMap rgbeInRgba pic - -- we are cheating to death here, the layout we want - -- correspond to the layout of pixelRGBA8, so we - -- convert - rgbeInRgba pixel = PixelRGBA8 r g b e - where RGBE r g b e = toRGBE pixel - - descriptor = RadianceHeader - { radianceInfos = [] - , radianceFormat = FormatRGBE - , radianceHeight = imageHeight pic - , radianceWidth = imageWidth pic - , radianceData = L.fromChunks [toByteString $ imageData newImage] - } - - --- | Encode an High dynamic range image into a radiance image --- file format using a light RLE compression. Some problems --- seem to arise with some image viewer. -encodeRLENewStyleHDR :: Image PixelRGBF -> L.ByteString -encodeRLENewStyleHDR pic = encode $ runST $ do - let w = imageWidth pic - h = imageHeight pic - - scanLineR <- M.new w :: ST s (M.STVector s Word8) - scanLineG <- M.new w - scanLineB <- M.new w - scanLineE <- M.new w - - encoded <- - forM [0 .. h - 1] $ \line -> do - buff <- M.new $ w * 4 + w `div` 127 + 2 - let columner col | col >= w = return () - columner col = do - let RGBE r g b e = toRGBE $ pixelAt pic col line - (scanLineR `M.unsafeWrite` col) r - (scanLineG `M.unsafeWrite` col) g - (scanLineB `M.unsafeWrite` col) b - (scanLineE `M.unsafeWrite` col) e - - columner (col + 1) - - columner 0 - - (buff `M.unsafeWrite` 0) 2 - (buff `M.unsafeWrite` 1) 2 - (buff `M.unsafeWrite` 2) $ fromIntegral ((w .>>. 8) .&. 0xFF) - (buff `M.unsafeWrite` 3) $ fromIntegral (w .&. 0xFF) - - i1 <- encodeScanlineColor scanLineR buff 4 - i2 <- encodeScanlineColor scanLineG buff i1 - i3 <- encodeScanlineColor scanLineB buff i2 - endIndex <- encodeScanlineColor scanLineE buff i3 - - (\v -> blitVector v 0 endIndex) <$> V.unsafeFreeze buff - - pure RadianceHeader - { radianceInfos = [] - , radianceFormat = FormatRGBE - , radianceHeight = h - , radianceWidth = w - , radianceData = L.fromChunks encoded - } - - -decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s PixelRGBF) -decodeRadiancePicture hdr = do - let width = abs $ radianceWidth hdr - height = abs $ radianceHeight hdr - packedData = radianceData hdr - - scanLine <- lift $ M.new $ width * 4 - resultBuffer <- lift $ M.new $ width * height * 3 - - let scanLineImage = MutableImage - { mutableImageWidth = width - , mutableImageHeight = 1 - , mutableImageData = scanLine - } - - finalImage = MutableImage - { mutableImageWidth = width - , mutableImageHeight = height - , mutableImageData = resultBuffer - } - - let scanLineExtractor readIdx line = do - let color = unpackColor packedData readIdx - inner | isNewRunLengthMarker color = do - let calcSize = checkLineLength color - when (calcSize /= width) - (throwE "Invalid sanline size") - pure $ \idx -> newStyleRLE packedData (idx + 4) - | otherwise = pure $ oldStyleRLE packedData - f <- inner - newRead <- f readIdx scanLine - forM_ [0 .. width - 1] $ \i -> do - -- mokay, it's a hack, but I don't want to define a - -- pixel instance of RGBE... - PixelRGBA8 r g b e <- lift $ readPixel scanLineImage i 0 - lift $ writePixel finalImage i line . toFloat $ RGBE r g b e - - return newRead - - foldM_ scanLineExtractor 0 [0 .. height - 1] - - return finalImage - +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TupleSections #-} +-- | Module dedicated of Radiance file decompression (.hdr or .pic) file. +-- Radiance file format is used for High dynamic range imaging. +module Codec.Picture.HDR( decodeHDR + , decodeHDRWithMetadata + , encodeHDR + , encodeRawHDR + , encodeRLENewStyleHDR + , writeHDR + , writeRLENewStyleHDR + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative( pure, (<*>), (<$>) ) +#endif + +import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR ) +import Data.Char( ord, chr, isDigit ) +import Data.Word( Word8 ) + +#if !MIN_VERSION_base(4,11,0) +import Data.Monoid( (<>) ) +#endif + +import Control.Monad( when, foldM, foldM_, forM, forM_, unless ) +import Control.Monad.Trans.Class( lift ) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Char8 as BC + +import Data.List( partition ) +import Data.Binary( Binary( .. ), encode ) +import Data.Binary.Get( Get, getByteString, getWord8 ) +import Data.Binary.Put( putByteString, putLazyByteString ) + +import Control.Monad.ST( ST, runST ) +import Foreign.Storable ( Storable ) +import Control.Monad.Primitive ( PrimState, PrimMonad ) +import qualified Data.Vector.Storable as V +import qualified Data.Vector.Storable.Mutable as M + +import Codec.Picture.Metadata( Metadatas + , SourceFormat( SourceHDR ) + , basicMetadata ) +import Codec.Picture.InternalHelper +import Codec.Picture.Types +import Codec.Picture.VectorByteConversion + +#if MIN_VERSION_transformers(0, 4, 0) +import Control.Monad.Trans.Except( ExceptT, throwE, runExceptT ) +#else +-- Transfomers 0.3 compat +import Control.Monad.Trans.Error( Error, ErrorT, throwError, runErrorT ) + +type ExceptT = ErrorT + +throwE :: (Monad m, Error e) => e -> ErrorT e m a +throwE = throwError + +runExceptT :: ErrorT e m a -> m (Either e a) +runExceptT = runErrorT +#endif + +{-# INLINE (.<<.) #-} +(.<<.), (.>>.) :: (Bits a) => a -> Int -> a +(.<<.) = unsafeShiftL +(.>>.) = unsafeShiftR + +{-# INLINE (.<-.) #-} +(.<-.) :: (PrimMonad m, Storable a) + => M.STVector (PrimState m) a -> Int -> a -> m () +(.<-.) = M.write + {-M.unsafeWrite-} + +type HDRReader s a = ExceptT String (ST s) a + +data RGBE = RGBE !Word8 !Word8 !Word8 !Word8 + +instance Binary RGBE where + put (RGBE r g b e) = put r >> put g >> put b >> put e + get = RGBE <$> get <*> get <*> get <*> get + +checkLineLength :: RGBE -> Int +checkLineLength (RGBE _ _ a b) = + (fromIntegral a .<<. 8) .|. fromIntegral b + +isNewRunLengthMarker :: RGBE -> Bool +isNewRunLengthMarker (RGBE 2 2 _ _) = True +isNewRunLengthMarker _ = False + +data RadianceFormat = + FormatRGBE + | FormatXYZE + +radiance32bitRleRGBEFormat, radiance32bitRleXYZEFromat :: B.ByteString +radiance32bitRleRGBEFormat = BC.pack "32-bit_rle_rgbe" +radiance32bitRleXYZEFromat = BC.pack "32-bit_rle_xyze" + +instance Binary RadianceFormat where + put FormatRGBE = putByteString radiance32bitRleRGBEFormat + put FormatXYZE = putByteString radiance32bitRleXYZEFromat + + get = getByteString (B.length radiance32bitRleRGBEFormat) >>= format + where format sig + | sig == radiance32bitRleRGBEFormat = pure FormatRGBE + | sig == radiance32bitRleXYZEFromat = pure FormatXYZE + | otherwise = fail "Unrecognized Radiance format" + +toRGBE :: PixelRGBF -> RGBE +toRGBE (PixelRGBF r g b) + | d <= 1e-32 = RGBE 0 0 0 0 + | otherwise = RGBE (fix r) (fix g) (fix b) (fromIntegral $ e + 128) + where d = maximum [r, g, b] + e = exponent d + coeff = significand d * 255.9999 / d + fix v = truncate $ v * coeff + + +dropUntil :: Word8 -> Get () +dropUntil c = getWord8 >>= inner + where inner val | val == c = pure () + inner _ = getWord8 >>= inner + +getUntil :: (Word8 -> Bool) -> B.ByteString -> Get B.ByteString +getUntil f initialAcc = getWord8 >>= inner initialAcc + where inner acc c | f c = pure acc + inner acc c = getWord8 >>= inner (B.snoc acc c) + +data RadianceHeader = RadianceHeader + { radianceInfos :: [(B.ByteString, B.ByteString)] + , radianceFormat :: RadianceFormat + , radianceHeight :: !Int + , radianceWidth :: !Int + , radianceData :: L.ByteString + } + +radianceFileSignature :: B.ByteString +radianceFileSignature = BC.pack "#?RADIANCE\n" + +unpackColor :: L.ByteString -> Int -> RGBE +unpackColor str idx = RGBE (at 0) (at 1) (at 2) (at 3) + where at n = L.index str . fromIntegral $ idx + n + +storeColor :: M.STVector s Word8 -> Int -> RGBE -> ST s () +storeColor vec idx (RGBE r g b e) = do + (vec .<-. (idx + 0)) r + (vec .<-. (idx + 1)) g + (vec .<-. (idx + 2)) b + (vec .<-. (idx + 3)) e + +parsePair :: Char -> Get (B.ByteString, B.ByteString) +parsePair firstChar = do + let eol c = c == fromIntegral (ord '\n') + line <- getUntil eol B.empty + case BC.split '=' line of + [] -> pure (BC.singleton firstChar, B.empty) + [val] -> pure (BC.singleton firstChar, val) + [key, val] -> pure (BC.singleton firstChar <> key, val) + (key : vals) -> pure (BC.singleton firstChar <> key, B.concat vals) + +decodeInfos :: Get [(B.ByteString, B.ByteString)] +decodeInfos = do + char <- getChar8 + case char of + -- comment + '#' -> dropUntil (fromIntegral $ ord '\n') >> decodeInfos + -- end of header, no more information + '\n' -> pure [] + -- Classical parsing + c -> (:) <$> parsePair c <*> decodeInfos + + +-- | Decode an HDR (radiance) image, the resulting image can be: +-- +-- * 'ImageRGBF' +-- +decodeHDR :: B.ByteString -> Either String DynamicImage +decodeHDR = fmap fst . decodeHDRWithMetadata + +-- | Equivalent to decodeHDR but with aditional metadatas. +decodeHDRWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas) +decodeHDRWithMetadata str = runST $ runExceptT $ + case runGet decodeHeader $ L.fromChunks [str] of + Left err -> throwE err + Right rez -> + let meta = basicMetadata SourceHDR (abs $ radianceWidth rez) (abs $ radianceHeight rez) in + (, meta) . ImageRGBF <$> (decodeRadiancePicture rez >>= lift . unsafeFreezeImage) + +getChar8 :: Get Char +getChar8 = chr . fromIntegral <$> getWord8 + +isSign :: Char -> Bool +isSign c = c == '+' || c == '-' + +isAxisLetter :: Char -> Bool +isAxisLetter c = c == 'X' || c == 'Y' + +decodeNum :: Get Int +decodeNum = do + sign <- getChar8 + letter <- getChar8 + space <- getChar8 + + unless (isSign sign && isAxisLetter letter && space == ' ') + (fail "Invalid radiance size declaration") + + let numDec acc c | isDigit c = + getChar8 >>= numDec (acc * 10 + ord c - ord '0') + numDec acc _ + | sign == '-' = pure $ negate acc + | otherwise = pure acc + + getChar8 >>= numDec 0 + +copyPrevColor :: M.STVector s Word8 -> Int -> ST s () +copyPrevColor scanLine idx = do + r <- scanLine `M.unsafeRead` (idx - 4) + g <- scanLine `M.unsafeRead` (idx - 3) + b <- scanLine `M.unsafeRead` (idx - 2) + e <- scanLine `M.unsafeRead` (idx - 1) + + (scanLine `M.unsafeWrite` (idx + 0)) r + (scanLine `M.unsafeWrite` (idx + 1)) g + (scanLine `M.unsafeWrite` (idx + 2)) b + (scanLine `M.unsafeWrite` (idx + 3)) e + +oldStyleRLE :: L.ByteString -> Int -> M.STVector s Word8 + -> HDRReader s Int +oldStyleRLE inputData initialIdx scanLine = inner initialIdx 0 0 + where maxOutput = M.length scanLine + maxInput = fromIntegral $ L.length inputData + + inner readIdx writeIdx _ + | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx + inner readIdx writeIdx shift = do + let color@(RGBE r g b e) = unpackColor inputData readIdx + isRun = r == 1 && g == 1 && b == 1 + + if not isRun + then do + lift $ storeColor scanLine writeIdx color + inner (readIdx + 4) (writeIdx + 4) 0 + + else do + let count = fromIntegral e .<<. shift + lift $ forM_ [0 .. count] $ \i -> copyPrevColor scanLine (writeIdx + 4 * i) + inner (readIdx + 4) (writeIdx + 4 * count) (shift + 8) + +newStyleRLE :: L.ByteString -> Int -> M.STVector s Word8 + -> HDRReader s Int +newStyleRLE inputData initialIdx scanline = foldM inner initialIdx [0 .. 3] + where dataAt idx + | fromIntegral idx >= maxInput = throwE $ "Read index out of bound (" ++ show idx ++ ")" + | otherwise = pure $ L.index inputData (fromIntegral idx) + + maxOutput = M.length scanline + maxInput = fromIntegral $ L.length inputData + stride = 4 + + + strideSet count destIndex _ | endIndex > maxOutput + stride = + throwE $ "Out of bound HDR scanline " ++ show endIndex ++ " (max " ++ show maxOutput ++ ")" + where endIndex = destIndex + count * stride + strideSet count destIndex val = aux destIndex count + where aux i 0 = pure i + aux i c = do + lift $ (scanline .<-. i) val + aux (i + stride) (c - 1) + + + strideCopy _ count destIndex + | writeEndBound > maxOutput + stride = throwE "Out of bound HDR scanline" + where writeEndBound = destIndex + count * stride + strideCopy sourceIndex count destIndex = aux sourceIndex destIndex count + where aux _ j 0 = pure j + aux i j c = do + val <- dataAt i + lift $ (scanline .<-. j) val + aux (i + 1) (j + stride) (c - 1) + + inner readIdx writeIdx + | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx + inner readIdx writeIdx = do + code <- dataAt readIdx + if code > 128 + then do + let repeatCount = fromIntegral code .&. 0x7F + newVal <- dataAt $ readIdx + 1 + endIndex <- strideSet repeatCount writeIdx newVal + inner (readIdx + 2) endIndex + + else do + let iCode = fromIntegral code + endIndex <- strideCopy (readIdx + 1) iCode writeIdx + inner (readIdx + iCode + 1) endIndex + +instance Binary RadianceHeader where + get = decodeHeader + put hdr = do + putByteString radianceFileSignature + putByteString $ BC.pack "FORMAT=" + put $ radianceFormat hdr + let sizeString = + BC.pack $ "\n\n-Y " ++ show (radianceHeight hdr) + ++ " +X " ++ show (radianceWidth hdr) ++ "\n" + putByteString sizeString + putLazyByteString $ radianceData hdr + + +decodeHeader :: Get RadianceHeader +decodeHeader = do + sig <- getByteString $ B.length radianceFileSignature + when (sig /= radianceFileSignature) + (fail "Invalid radiance file signature") + + infos <- decodeInfos + let formatKey = BC.pack "FORMAT" + case partition (\(k,_) -> k /= formatKey) infos of + (_, []) -> fail "No radiance format specified" + (info, [(_, formatString)]) -> + case runGet get $ L.fromChunks [formatString] of + Left err -> fail err + Right format -> do + (n1, n2, b) <- (,,) <$> decodeNum + <*> decodeNum + <*> getRemainingBytes + return . RadianceHeader info format n1 n2 $ L.fromChunks [b] + + _ -> fail "Multiple radiance format specified" + +toFloat :: RGBE -> PixelRGBF +toFloat (RGBE r g b e) = PixelRGBF rf gf bf + where f = encodeFloat 1 $ fromIntegral e - (128 + 8) + rf = (fromIntegral r + 0.0) * f + gf = (fromIntegral g + 0.0) * f + bf = (fromIntegral b + 0.0) * f + +encodeScanlineColor :: M.STVector s Word8 + -> M.STVector s Word8 + -> Int + -> ST s Int +encodeScanlineColor vec outVec outIdx = do + val <- vec `M.unsafeRead` 0 + runLength 1 0 val 1 outIdx + where maxIndex = M.length vec + + pushRun len val at = do + (outVec `M.unsafeWrite` at) $ fromIntegral $ len .|. 0x80 + (outVec `M.unsafeWrite` (at + 1)) val + return $ at + 2 + + pushData start len at = do + (outVec `M.unsafeWrite` at) $ fromIntegral len + let first = start - len + end = start - 1 + offset = at - first + 1 + forM_ [first .. end] $ \i -> do + v <- vec `M.unsafeRead` i + (outVec `M.unsafeWrite` (offset + i)) v + + return $ at + len + 1 + + -- End of scanline, empty the thing + runLength run cpy prev idx at | idx >= maxIndex = + case (run, cpy) of + (0, 0) -> pure at + (0, n) -> pushData idx n at + (n, 0) -> pushRun n prev at + (_, _) -> error "HDR - Run length algorithm is wrong" + + -- full runlength, we must write the packet + runLength r@127 _ prev idx at = do + val <- vec `M.unsafeRead` idx + pushRun r prev at >>= + runLength 1 0 val (idx + 1) + + -- full copy, we must write the packet + runLength _ c@127 _ idx at = do + val <- vec `M.unsafeRead` idx + pushData idx c at >>= + runLength 1 0 val (idx + 1) + + runLength n 0 prev idx at = do + val <- vec `M.unsafeRead` idx + case val == prev of + True -> runLength (n + 1) 0 prev (idx + 1) at + False | n < 4 -> runLength 0 (n + 1) val (idx + 1) at + False -> + pushRun n prev at >>= + runLength 1 0 val (idx + 1) + + runLength 0 n prev idx at = do + val <- vec `M.unsafeRead` idx + if val /= prev + then runLength 0 (n + 1) val (idx + 1) at + else + pushData (idx - 1) (n - 1) at >>= + runLength (2 :: Int) 0 val (idx + 1) + + runLength _ _ _ _ _ = + error "HDR RLE inconsistent state" + +-- | Write an High dynamic range image into a radiance +-- image file on disk. +writeHDR :: FilePath -> Image PixelRGBF -> IO () +writeHDR filename img = L.writeFile filename $ encodeHDR img + +-- | Write a RLE encoded High dynamic range image into a radiance +-- image file on disk. +writeRLENewStyleHDR :: FilePath -> Image PixelRGBF -> IO () +writeRLENewStyleHDR filename img = + L.writeFile filename $ encodeRLENewStyleHDR img + +-- | Encode an High dynamic range image into a radiance image +-- file format. +-- Alias for encodeRawHDR +encodeHDR :: Image PixelRGBF -> L.ByteString +encodeHDR = encodeRawHDR + +-- | Encode an High dynamic range image into a radiance image +-- file format. without compression +encodeRawHDR :: Image PixelRGBF -> L.ByteString +encodeRawHDR pic = encode descriptor + where + newImage = pixelMap rgbeInRgba pic + -- we are cheating to death here, the layout we want + -- correspond to the layout of pixelRGBA8, so we + -- convert + rgbeInRgba pixel = PixelRGBA8 r g b e + where RGBE r g b e = toRGBE pixel + + descriptor = RadianceHeader + { radianceInfos = [] + , radianceFormat = FormatRGBE + , radianceHeight = imageHeight pic + , radianceWidth = imageWidth pic + , radianceData = L.fromChunks [toByteString $ imageData newImage] + } + + +-- | Encode an High dynamic range image into a radiance image +-- file format using a light RLE compression. Some problems +-- seem to arise with some image viewer. +encodeRLENewStyleHDR :: Image PixelRGBF -> L.ByteString +encodeRLENewStyleHDR pic = encode $ runST $ do + let w = imageWidth pic + h = imageHeight pic + + scanLineR <- M.new w :: ST s (M.STVector s Word8) + scanLineG <- M.new w + scanLineB <- M.new w + scanLineE <- M.new w + + encoded <- + forM [0 .. h - 1] $ \line -> do + buff <- M.new $ w * 4 + w `div` 127 + 2 + let columner col | col >= w = return () + columner col = do + let RGBE r g b e = toRGBE $ pixelAt pic col line + (scanLineR `M.unsafeWrite` col) r + (scanLineG `M.unsafeWrite` col) g + (scanLineB `M.unsafeWrite` col) b + (scanLineE `M.unsafeWrite` col) e + + columner (col + 1) + + columner 0 + + (buff `M.unsafeWrite` 0) 2 + (buff `M.unsafeWrite` 1) 2 + (buff `M.unsafeWrite` 2) $ fromIntegral ((w .>>. 8) .&. 0xFF) + (buff `M.unsafeWrite` 3) $ fromIntegral (w .&. 0xFF) + + i1 <- encodeScanlineColor scanLineR buff 4 + i2 <- encodeScanlineColor scanLineG buff i1 + i3 <- encodeScanlineColor scanLineB buff i2 + endIndex <- encodeScanlineColor scanLineE buff i3 + + (\v -> blitVector v 0 endIndex) <$> V.unsafeFreeze buff + + pure RadianceHeader + { radianceInfos = [] + , radianceFormat = FormatRGBE + , radianceHeight = h + , radianceWidth = w + , radianceData = L.fromChunks encoded + } + + +decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s PixelRGBF) +decodeRadiancePicture hdr = do + let width = abs $ radianceWidth hdr + height = abs $ radianceHeight hdr + packedData = radianceData hdr + + scanLine <- lift $ M.new $ width * 4 + resultBuffer <- lift $ M.new $ width * height * 3 + + let scanLineImage = MutableImage + { mutableImageWidth = width + , mutableImageHeight = 1 + , mutableImageData = scanLine + } + + finalImage = MutableImage + { mutableImageWidth = width + , mutableImageHeight = height + , mutableImageData = resultBuffer + } + + let scanLineExtractor readIdx line = do + let color = unpackColor packedData readIdx + inner | isNewRunLengthMarker color = do + let calcSize = checkLineLength color + when (calcSize /= width) + (throwE "Invalid sanline size") + pure $ \idx -> newStyleRLE packedData (idx + 4) + | otherwise = pure $ oldStyleRLE packedData + f <- inner + newRead <- f readIdx scanLine + forM_ [0 .. width - 1] $ \i -> do + -- mokay, it's a hack, but I don't want to define a + -- pixel instance of RGBE... + PixelRGBA8 r g b e <- lift $ readPixel scanLineImage i 0 + lift $ writePixel finalImage i line . toFloat $ RGBE r g b e + + return newRead + + foldM_ scanLineExtractor 0 [0 .. height - 1] + + return finalImage + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/Jpg/Internal/Types.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/Jpg/Internal/Types.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/Jpg/Internal/Types.hs 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/Jpg/Internal/Types.hs 2019-06-19 21:11:57.000000000 +0200 @@ -34,7 +34,11 @@ import Control.Monad.ST( ST ) import Data.Bits( (.|.), (.&.), unsafeShiftL, unsafeShiftR ) import Data.List( partition ) + +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif + import Foreign.Storable ( Storable ) import Data.Vector.Unboxed( (!) ) import qualified Data.Vector as V diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/Jpg.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/Jpg.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/Jpg.hs 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/Jpg.hs 2019-06-19 21:11:57.000000000 +0200 @@ -31,7 +31,9 @@ import Control.Monad.Trans.RWS.Strict( RWS, modify, tell, gets, execRWS ) import Data.Bits( (.|.), unsafeShiftL ) +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Data.Int( Int16, Int32 ) import Data.Word(Word8, Word32) import Data.Binary( Binary(..), encode ) @@ -309,7 +311,7 @@ scanSpecifier scanCount scanSpec = do compMapping <- gets componentIndexMapping comp <- case lookup (componentSelector scanSpec) compMapping of - Nothing -> fail "Jpg decoding error - bad component selector in blob." + Nothing -> error "Jpg decoding error - bad component selector in blob." Just v -> return v let maximumHuffmanTable = 4 dcIndex = min (maximumHuffmanTable - 1) @@ -326,7 +328,7 @@ frameInfo <- gets currentFrame blobId <- gets seenBlobs case frameInfo of - Nothing -> fail "Jpg decoding error - no previous frame" + Nothing -> error "Jpg decoding error - no previous frame" Just v -> do let compDesc = jpgComponents v !! comp compCount = length $ jpgComponents v diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/Png/Internal/Export.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/Png/Internal/Export.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/Png/Internal/Export.hs 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/Png/Internal/Export.hs 2019-06-19 21:11:57.000000000 +0200 @@ -19,7 +19,9 @@ import Control.Monad.ST( ST, runST ) import Data.Bits( unsafeShiftR, (.&.) ) import Data.Binary( encode ) +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Data.Word(Word8, Word16) import qualified Codec.Compression.Zlib as Z import qualified Data.ByteString as B diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/Png/Internal/Metadata.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/Png/Internal/Metadata.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/Png/Internal/Metadata.hs 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/Png/Internal/Metadata.hs 2019-06-19 21:11:57.000000000 +0200 @@ -16,7 +16,9 @@ import Data.Binary.Get( getLazyByteStringNul ) import Data.Binary.Put( putLazyByteString, putWord8 ) import qualified Data.ByteString.Lazy.Char8 as L +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Codec.Picture.InternalHelper import qualified Codec.Picture.Metadata as Met diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/Png.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/Png.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/Png.hs 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/Png.hs 2019-06-19 21:11:57.000000000 +0200 @@ -36,7 +36,11 @@ import Control.Arrow( first ) import Control.Monad( forM_, foldM_, when, void ) import Control.Monad.ST( ST, runST ) + +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif + import Data.Binary( Binary( get) ) import qualified Data.Vector.Storable as V diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/Tiff/Internal/Metadata.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/Tiff/Internal/Metadata.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/Tiff/Internal/Metadata.hs 2018-12-16 22:36:06.000000000 +0100 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/Tiff/Internal/Metadata.hs 2019-06-19 21:11:57.000000000 +0200 @@ -16,7 +16,9 @@ import Data.List( sortBy ) import Data.Function( on ) import qualified Data.Foldable as F +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Codec.Picture.Metadata( Metadatas ) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/JuicyPixels-3.3.3/src/Codec/Picture/Types.hs new/JuicyPixels-3.3.3.1/src/Codec/Picture/Types.hs --- old/JuicyPixels-3.3.3/src/Codec/Picture/Types.hs 2018-07-10 12:36:32.000000000 +0200 +++ new/JuicyPixels-3.3.3.1/src/Codec/Picture/Types.hs 2019-06-19 21:11:57.000000000 +0200 @@ -109,8 +109,9 @@ import Data.Monoid( Monoid, mempty ) import Control.Applicative( Applicative, pure, (<*>), (<$>) ) #endif - +#if !MIN_VERSION_base(4,11,0) import Data.Monoid( (<>) ) +#endif import Control.Monad( foldM, liftM, ap ) import Control.DeepSeq( NFData( .. ) ) import Control.Monad.ST( ST, runST )

1 0

commit pragha for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package pragha for openSUSE:Factory checked in at 2019-06-30 10:21:21 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/pragha (Old) and /work/SRC/openSUSE:Factory/.pragha.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "pragha" Sun Jun 30 10:21:21 2019 rev:23 rq:712494 version:1.3.99 Changes: -------- --- /work/SRC/openSUSE:Factory/pragha/pragha.changes 2019-01-24 14:11:35.579488565 +0100 +++ /work/SRC/openSUSE:Factory/.pragha.new.4615/pragha.changes 2019-06-30 10:21:22.667608681 +0200 @@ -1,0 +2,6 @@ +Fri Jun 28 14:57:56 UTC 2019 - Marcel Kuehlhorn <tux93(a)opensuse.org> + +- Fixed dependency issue due to new gupnp version in Tumbleweed +- Removed conditionals for Leap < 15 + +------------------------------------------------------------------- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ pragha.spec ++++++ --- /var/tmp/diff_new_pack.wKMUTT/_old 2019-06-30 10:21:23.339609725 +0200 +++ /var/tmp/diff_new_pack.wKMUTT/_new 2019-06-30 10:21:23.343609731 +0200 @@ -37,7 +37,11 @@ BuildRequires: pkgconfig(gthread-2.0) >= 2.31 BuildRequires: pkgconfig(gtk+-3.0) >= 3.4.0 BuildRequires: pkgconfig(gudev-1.0) +%if 0%{?suse_version} >= 01550 && 0%{?is_opensuse} +BuildRequires: pkgconfig(gupnp-1.2) +%else BuildRequires: pkgconfig(gupnp-1.0) +%endif BuildRequires: pkgconfig(json-glib-1.0) BuildRequires: pkgconfig(keybinder-3.0) BuildRequires: pkgconfig(libcddb) @@ -127,7 +131,7 @@ %build export CPPFLAGS='-I/usr/include/gssdp-1.0/ -I/usr/include/gupnp-1.0/ -I/usr/include/libsoup-2.4/' %configure -make %{?_smp_mflags} +%make_build %{?_smp_mflags} %install %make_install @@ -150,16 +154,6 @@ %find_lang %{name} -%if 0%{?suse_version} && 0%{?suse_version} < 1500 -%post -%desktop_database_post -%icon_theme_cache_post - -%postun -%desktop_database_postun -%icon_theme_cache_postun -%endif - %files # FIXME: add AUTHORS to docs if not empty. %license COPYING @@ -167,9 +161,6 @@ %{_bindir}/%{name} %{_datadir}/applications/%{name}.desktop %{_datadir}/icons/hicolor/*/*/*.* -%if 0%{?suse_version} && 0%{?suse_version} < 1500 -%dir %{_datadir}/metainfo/ -%endif %{_datadir}/metainfo/io.github.pragha-music-player.metainfo.xml %{_datadir}/pixmaps/%{name}/ %{_mandir}/man?/*

1 0

commit lollypop for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package lollypop for openSUSE:Factory checked in at 2019-06-30 10:21:18 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/lollypop (Old) and /work/SRC/openSUSE:Factory/.lollypop.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "lollypop" Sun Jun 30 10:21:18 2019 rev:86 rq:712450 version:1.1.3.1 Changes: -------- --- /work/SRC/openSUSE:Factory/lollypop/lollypop.changes 2019-06-24 21:53:50.752128388 +0200 +++ /work/SRC/openSUSE:Factory/.lollypop.new.4615/lollypop.changes 2019-06-30 10:21:19.935604436 +0200 @@ -1,0 +2,16 @@ +Fri Jun 28 21:44:28 UTC 2019 - antoine.belvire(a)opensuse.org + +- Update to version 1.1.3.1: + * Fix wrong view displayed when sidebar is disabled + (glgo#World/lollypop#1872). + +------------------------------------------------------------------- +Fri Jun 28 18:17:57 UTC 2019 - antoine.belvire(a)opensuse.org + +- Update to version 1.1.3: + * Bug fixes: + glgo#World/lollypop#1865, glgo#World/lollypop#1867, + glgo#World/lollypop#1868, glgo#World/lollypop#1869, + glgo#World/lollypop#1879, glgo#World/lollypop#1871. + +------------------------------------------------------------------- Old: ---- lollypop-1.1.1.tar.xz New: ---- lollypop-1.1.3.1.tar.xz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ lollypop.spec ++++++ --- /var/tmp/diff_new_pack.W0UPJd/_old 2019-06-30 10:21:21.515606891 +0200 +++ /var/tmp/diff_new_pack.W0UPJd/_new 2019-06-30 10:21:21.559606959 +0200 @@ -17,7 +17,7 @@ Name: lollypop -Version: 1.1.1 +Version: 1.1.3.1 Release: 0 Summary: GNOME music playing application License: GPL-3.0-or-later ++++++ _service ++++++ --- /var/tmp/diff_new_pack.W0UPJd/_old 2019-06-30 10:21:21.831607382 +0200 +++ /var/tmp/diff_new_pack.W0UPJd/_new 2019-06-30 10:21:21.831607382 +0200 @@ -1,7 +1,7 @@ <services> <service mode="disabled" name="tar_scm"> <param name="changesgenerate">enable</param> - <param name="revision">1.1.1</param> + <param name="revision">1.1.3.1</param> <param name="scm">git</param> <param name="url">https://gitlab.gnome.org/World/lollypop.git</param> <param name="versionformat">@PARENT_TAG@</param> ++++++ _servicedata ++++++ --- /var/tmp/diff_new_pack.W0UPJd/_old 2019-06-30 10:21:21.843607401 +0200 +++ /var/tmp/diff_new_pack.W0UPJd/_new 2019-06-30 10:21:21.843607401 +0200 @@ -1,4 +1,4 @@ <servicedata> <service name="tar_scm"> <param name="url">https://gitlab.gnome.org/World/lollypop.git</param> - <param name="changesrevision">3fd7197bc786ad224bf5a5a58bdfbdba1443f6a3</param></service></servicedata> \ No newline at end of file + <param name="changesrevision">a152d1c05406df1c1a129fff547401c4837ccb9c</param></service></servicedata> \ No newline at end of file ++++++ lollypop-1.1.1.tar.xz -> lollypop-1.1.3.1.tar.xz ++++++ ++++ 26223 lines of diff (skipped)

1 0

commit wxMaxima for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package wxMaxima for openSUSE:Factory checked in at 2019-06-30 10:21:16 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/wxMaxima (Old) and /work/SRC/openSUSE:Factory/.wxMaxima.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "wxMaxima" Sun Jun 30 10:21:16 2019 rev:34 rq:712439 version:19.05.7 Changes: -------- --- /work/SRC/openSUSE:Factory/wxMaxima/wxMaxima.changes 2019-05-16 22:08:49.558348831 +0200 +++ /work/SRC/openSUSE:Factory/.wxMaxima.new.4615/wxMaxima.changes 2019-06-30 10:21:17.107600043 +0200 @@ -1,0 +2,7 @@ +Tue Jun 25 09:49:29 UTC 2019 - Atri Bhattacharya <badshah400(a)gmail.com> - 19.05.7 + +- Update to version 19.05.7: + * Support worksheets starting in a :lisp command [with maxima >= + 5.43.0] + +------------------------------------------------------------------- Old: ---- Version-19.05.2.tar.gz New: ---- Version-19.05.7.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ wxMaxima.spec ++++++ --- /var/tmp/diff_new_pack.pkdWUt/_old 2019-06-30 10:21:18.779602641 +0200 +++ /var/tmp/diff_new_pack.pkdWUt/_new 2019-06-30 10:21:18.823602709 +0200 @@ -18,7 +18,7 @@ %define tarname wxmaxima Name: wxMaxima -Version: 19.05.2 +Version: 19.05.7 Release: 0 Summary: Graphical User Interface for the maxima Computer Algebra System License: GPL-2.0-or-later ++++++ Version-19.05.2.tar.gz -> Version-19.05.7.tar.gz ++++++ /work/SRC/openSUSE:Factory/wxMaxima/Version-19.05.2.tar.gz /work/SRC/openSUSE:Factory/.wxMaxima.new.4615/Version-19.05.7.tar.gz differ: char 18, line 1

1 0

commit libpsl for openSUSE:Factory
by root 30 Jun '19

30 Jun '19

Hello community, here is the log from the commit of package libpsl for openSUSE:Factory checked in at 2019-06-30 10:20:31 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/libpsl (Old) and /work/SRC/openSUSE:Factory/.libpsl.new.4615 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "libpsl" Sun Jun 30 10:20:31 2019 rev:20 rq:712385 version:0.21.0 Changes: -------- --- /work/SRC/openSUSE:Factory/libpsl/psl-make-dafsa.changes 2019-06-03 18:42:47.544692681 +0200 +++ /work/SRC/openSUSE:Factory/.libpsl.new.4615/psl-make-dafsa.changes 2019-06-30 10:20:32.979531489 +0200 @@ -1,0 +2,5 @@ +Sun Jun 2 18:39:53 UTC 2019 - Jan Engelhardt <jengelh(a)inai.de> + +- Use noun phrase in summary. + +------------------------------------------------------------------- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ psl-make-dafsa.spec ++++++ --- /var/tmp/diff_new_pack.JwDCCG/_old 2019-06-30 10:20:34.207533396 +0200 +++ /var/tmp/diff_new_pack.JwDCCG/_new 2019-06-30 10:20:34.211533403 +0200 @@ -20,7 +20,7 @@ Name: psl-make-dafsa Version: 0.21.0 Release: 0 -Summary: Create a binary DAFSA from a Public Suffix List +Summary: Tool to create a binary DAFSA from a Public Suffix List License: BSD-3-Clause Group: Development/Libraries/C and C++ Url: https://rockdaboot.github.io/libpsl

1 0