Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-JuicyPixels for openSUSE:Factory
checked in at 2024-06-14 19:02:31
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-JuicyPixels (Old)
and /work/SRC/openSUSE:Factory/.ghc-JuicyPixels.new.19518 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-JuicyPixels"
Fri Jun 14 19:02:31 2024 rev:36 rq:1180780 version:3.3.9
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-JuicyPixels/ghc-JuicyPixels.changes
2024-04-21 20:30:43.701512941 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-JuicyPixels.new.19518/ghc-JuicyPixels.changes
2024-06-14 19:07:04.514397418 +0200
@@ -1,0 +2,9 @@
+Thu Jun 6 18:35:17 UTC 2024 - Peter Simons <[email protected]>
+
+- Update JuicyPixels to version 3.3.9.
+ v3.3.9 June 2024
+ ----------------
+
+ * Something something compilation
+
+-------------------------------------------------------------------
Old:
----
JuicyPixels-3.3.8.tar.gz
JuicyPixels.cabal
New:
----
JuicyPixels-3.3.9.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-JuicyPixels.spec ++++++
--- /var/tmp/diff_new_pack.vGXGfq/_old 2024-06-14 19:07:05.022415557 +0200
+++ /var/tmp/diff_new_pack.vGXGfq/_new 2024-06-14 19:07:05.026415701 +0200
@@ -19,13 +19,12 @@
%global pkg_name JuicyPixels
%global pkgver %{pkg_name}-%{version}
Name: ghc-%{pkg_name}
-Version: 3.3.8
+Version: 3.3.9
Release: 0
Summary: Picture loading/serialization (in png, jpeg, bitmap, gif, tga,
tiff and radiance)
License: BSD-3-Clause
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-base-devel
BuildRequires: ghc-base-prof
@@ -82,7 +81,6 @@
%prep
%autosetup -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ JuicyPixels-3.3.8.tar.gz -> JuicyPixels-3.3.9.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/JuicyPixels-3.3.8/JuicyPixels.cabal
new/JuicyPixels-3.3.9/JuicyPixels.cabal
--- old/JuicyPixels-3.3.8/JuicyPixels.cabal 2022-07-17 21:36:36.000000000
+0200
+++ new/JuicyPixels-3.3.9/JuicyPixels.cabal 2024-06-06 20:35:02.000000000
+0200
@@ -1,5 +1,5 @@
Name: JuicyPixels
-Version: 3.3.8
+Version: 3.3.9
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==>>
@@ -14,11 +14,21 @@
Category: Codec, Graphics, Image
Stability: Stable
Build-type: Simple
+cabal-version: 1.18
+tested-with:
+ GHC == 9.8.1
+ GHC == 9.6.4
+ GHC == 9.4.8
+ GHC == 9.2.8
+ GHC == 9.0.2
+ GHC == 8.10.7
+ GHC == 8.8.4
+ GHC == 8.6.5
+ GHC == 8.4.4
+ GHC == 8.2.2
+ GHC == 8.0.2
--- Constraint on the version of Cabal needed to build this package.
-Cabal-version: 1.18
-
-extra-source-files: changelog, docimages/*.png, docimages/*.svg, README.md
+extra-doc-files: changelog, docimages/*.png, docimages/*.svg, README.md
extra-doc-files: docimages/*.png, docimages/*.svg
Source-Repository head
@@ -28,7 +38,7 @@
Source-Repository this
Type: git
Location: git://github.com/Twinside/Juicy.Pixels.git
- Tag: v3.3.7
+ Tag: v3.3.8
Flag Mmap
Description: Enable the file loading via mmap (memory map)
@@ -37,6 +47,7 @@
Library
hs-source-dirs: src
Default-Language: Haskell2010
+ default-extensions: TypeOperators
Exposed-modules: Codec.Picture,
Codec.Picture.Bitmap,
Codec.Picture.Gif,
@@ -66,16 +77,16 @@
Codec.Picture.Tiff.Internal.Types
Ghc-options: -O3 -Wall
- Build-depends: base >= 4.8 && < 6,
- bytestring >= 0.9 && < 0.12,
+ Build-depends: base >= 4.8 && < 5,
+ bytestring >= 0.9 && < 0.13,
mtl >= 1.1 && < 2.4,
- binary >= 0.8.1 && < 0.9,
- zlib >= 0.5.3.1 && < 0.7,
+ binary >= 0.8.1 && < 0.9,
+ zlib >= 0.5.3.1 && < 0.8,
transformers >= 0.2,
- vector >= 0.13,
+ vector >= 0.12.3.1,
primitive >= 0.4,
- deepseq >= 1.1 && < 1.5,
- containers >= 0.4.2 && < 0.7
+ deepseq >= 1.1 && < 1.6,
+ containers >= 0.4.2 && < 0.8
-- Modules not exported by this package.
Other-modules: Codec.Picture.BitWriter,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/JuicyPixels-3.3.8/changelog
new/JuicyPixels-3.3.9/changelog
--- old/JuicyPixels-3.3.8/changelog 2022-07-17 21:34:19.000000000 +0200
+++ new/JuicyPixels-3.3.9/changelog 2024-06-06 20:34:05.000000000 +0200
@@ -1,6 +1,11 @@
Change log
==========
+v3.3.9 June 2024
+----------------
+
+ * Something something compilation
+
v3.3.7 July 2022
----------------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/JuicyPixels-3.3.8/src/Codec/Picture/ColorQuant.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/ColorQuant.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/ColorQuant.hs 2022-03-09
23:41:19.000000000 +0100
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/ColorQuant.hs 2024-06-06
20:34:05.000000000 +0200
@@ -278,7 +278,7 @@
-- Based on the OCaml implementation:
-- http://rosettacode.org/wiki/Color_quantization
--- which is in turn based on: www.leptonica.com/papers/mediancut.pdf.
+-- which is in turn based on: www.leptonica.org/papers/mediancut.pdf.
-- We use the product of volume and population to determine the next cluster
-- to split and determine the placement of each color by compating it to the
-- mean of the parent cluster. So median cut is a bit of a misnomer, since one
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/JuicyPixels-3.3.8/src/Codec/Picture/InternalHelper.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/InternalHelper.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/InternalHelper.hs 2016-09-04
14:18:57.000000000 +0200
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/InternalHelper.hs 2024-06-06
20:34:05.000000000 +0200
@@ -1,51 +1,32 @@
-{-# LANGUAGE CPP #-}
-module Codec.Picture.InternalHelper ( runGet
- , runGetStrict
- , decode
- , getRemainingBytes
- , getRemainingLazyBytes ) where
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import Data.Binary( Binary( get ) )
-import Data.Binary.Get( Get
- , getRemainingLazyByteString
- )
-import qualified Data.Binary.Get as G
-
-#if MIN_VERSION_binary(0,6,4)
-#else
-import Control.Applicative( (<$>) )
-import qualified Control.Exception as E
--- I feel so dirty. :(
-import System.IO.Unsafe( unsafePerformIO )
-#endif
-
-decode :: (Binary a) => B.ByteString -> Either String a
-decode = runGetStrict get
-
-runGet :: Get a -> L.ByteString -> Either String a
-#if MIN_VERSION_binary(0,6,4)
-runGet act = unpack . G.runGetOrFail act
- where unpack (Left (_, _, str)) = Left str
- unpack (Right (_, _, element)) = Right element
-#else
-runGet act str = unsafePerformIO $ E.catch
- (Right <$> E.evaluate (G.runGet act str))
- (\msg -> return . Left $ show (msg :: E.SomeException))
-#endif
-
-runGetStrict :: Get a -> B.ByteString -> Either String a
-runGetStrict act buffer = runGet act $ L.fromChunks [buffer]
-
-getRemainingBytes :: Get B.ByteString
-getRemainingBytes = do
- rest <- getRemainingLazyByteString
- return $ case L.toChunks rest of
- [] -> B.empty
- [a] -> a
- lst -> B.concat lst
-
-getRemainingLazyBytes :: Get L.ByteString
-getRemainingLazyBytes = getRemainingLazyByteString
-
+{-# LANGUAGE CPP #-}
+module Codec.Picture.InternalHelper ( runGet
+ , runGetStrict
+ , decode
+ , getRemainingBytes
+ , getRemainingLazyBytes ) where
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+import Data.Binary( Binary( get ) )
+import Data.Binary.Get( Get
+ , getRemainingLazyByteString
+ )
+import qualified Data.Binary.Get as G
+
+decode :: (Binary a) => B.ByteString -> Either String a
+decode = runGetStrict get
+
+runGet :: Get a -> L.ByteString -> Either String a
+runGet act = unpack . G.runGetOrFail act
+ where unpack (Left (_, _, str)) = Left str
+ unpack (Right (_, _, element)) = Right element
+
+runGetStrict :: Get a -> B.ByteString -> Either String a
+runGetStrict act buffer = runGet act $ L.fromChunks [buffer]
+
+getRemainingBytes :: Get B.ByteString
+getRemainingBytes = L.toStrict <$> getRemainingLazyByteString
+
+getRemainingLazyBytes :: Get L.ByteString
+getRemainingLazyBytes = getRemainingLazyByteString
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/JuicyPixels-3.3.8/src/Codec/Picture/Jpg/Internal/DefaultTable.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/Jpg/Internal/DefaultTable.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/Jpg/Internal/DefaultTable.hs
2018-12-16 22:36:06.000000000 +0100
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/Jpg/Internal/DefaultTable.hs
2024-06-06 20:34:05.000000000 +0200
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
-- | Module used by the jpeg decoder internally, shouldn't be used
@@ -33,6 +34,7 @@
, defaultDcLumaHuffmanTable
) where
+import Control.DeepSeq( NFData(..) )
import Data.Int( Int16 )
import Foreign.Storable ( Storable )
import Control.Monad.ST( runST )
@@ -42,6 +44,7 @@
import Data.Word( Word8, Word16 )
import Data.List( foldl' )
import qualified Data.Vector.Storable.Mutable as M
+import GHC.Generics( Generic )
import Codec.Picture.BitWriter
@@ -108,7 +111,8 @@
-- | Enumeration used to search in the tables for different components.
data DctComponent = DcComponent | AcComponent
- deriving (Eq, Show)
+ deriving (Eq, Show, Generic)
+instance NFData DctComponent
-- | Transform parsed coefficients from the jpeg header to a
-- tree which can be used to decode data.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/JuicyPixels-3.3.8/src/Codec/Picture/Jpg/Internal/Types.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/Jpg/Internal/Types.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/Jpg/Internal/Types.hs
2022-07-17 21:34:19.000000000 +0200
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/Jpg/Internal/Types.hs
2024-06-06 20:34:05.000000000 +0200
@@ -1,6 +1,13 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
+
+-- | A good explanation of the JPEG format, including diagrams, is given at:
+-- <https://github.com/corkami/formats/blob/master/image/jpeg.md>
+--
+-- The full spec (excluding EXIF): https://www.w3.org/Graphics/JPEG/itu-t81.pdf
module Codec.Picture.Jpg.Internal.Types( MutableMacroBlock
, createEmptyMutableMacroBlock
, printMacroBlock
@@ -21,8 +28,19 @@
, JpgAdobeApp14( .. )
, JpgJFIFApp0( .. )
, JFifUnit( .. )
+ , TableList( .. )
+ , RestartInterval( .. )
+ , getJpgImage
, calculateSize
, dctBlockSize
+ , parseECS
+ , parseECS_simple
+ , skipUntilFrames
+ , skipFrameMarker
+ , parseFrameOfKind
+ , parseFrames
+ , parseFrameKinds
+ , parseToFirstFrameHeader
) where
@@ -30,10 +48,13 @@
import Control.Applicative( pure, (<*>), (<$>) )
#endif
+import Control.DeepSeq( NFData(..) )
import Control.Monad( when, replicateM, forM, forM_, unless )
import Control.Monad.ST( ST )
import Data.Bits( (.|.), (.&.), unsafeShiftL, unsafeShiftR )
import Data.List( partition )
+import Data.Maybe( maybeToList )
+import GHC.Generics( Generic )
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid( (<>) )
@@ -48,8 +69,9 @@
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Unsafe as BU
-import Data.Int( Int16 )
+import Data.Int( Int16, Int64 )
import Data.Word(Word8, Word16 )
import Data.Binary( Binary(..) )
@@ -59,7 +81,11 @@
, getByteString
, skip
, bytesRead
+ , lookAhead
+ , ByteOffset
+ , getLazyByteString
)
+import qualified Data.Binary.Get.Internal as GetInternal
import Data.Binary.Put( Put
, putWord8
@@ -75,7 +101,6 @@
import Codec.Picture.Tiff.Internal.Metadata( exifOffsetIfd )
import Codec.Picture.Metadata.Exif
-{-import Debug.Trace-}
import Text.Printf
-- | Type only used to make clear what kind of integer we are carrying
@@ -108,7 +133,8 @@
| JpgRestartInterval
| JpgRestartIntervalEnd Word8
- deriving (Eq, Show)
+ deriving (Eq, Show, Generic)
+instance NFData JpgFrameKind
data JpgFrame =
JpgAppFrame !Word8 B.ByteString
@@ -118,10 +144,11 @@
| JpgExtension !Word8 B.ByteString
| JpgQuantTable ![JpgQuantTableSpec]
| JpgHuffmanTable ![(JpgHuffmanTableSpec, HuffmanPackedTree)]
- | JpgScanBlob !JpgScanHeader !L.ByteString
+ | JpgScanBlob !JpgScanHeader !L.ByteString -- ^ The @ByteString@ is
the ECS (Entropy-Coded Segment), typically the largest part of compressed image
data.
| JpgScans !JpgFrameKind !JpgFrameHeader
| JpgIntervalRestart !Word16
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgFrame
data JpgColorSpace
= JpgColorSpaceYCbCr
@@ -133,13 +160,15 @@
| JpgColorSpaceCMYK
| JpgColorSpaceRGB
| JpgColorSpaceRGBA
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgColorSpace
data AdobeTransform
= AdobeUnknown -- ^ Value 0
| AdobeYCbCr -- ^ value 1
| AdobeYCck -- ^ value 2
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData AdobeTransform
data JpgAdobeApp14 = JpgAdobeApp14
{ _adobeDctVersion :: !Word16
@@ -147,14 +176,16 @@
, _adobeFlag1 :: !Word16
, _adobeTransform :: !AdobeTransform
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgAdobeApp14
-- | Size: 1
data JFifUnit
= JFifUnitUnknown -- ^ 0
| JFifPixelsPerInch -- ^ 1
| JFifPixelsPerCentimeter -- ^ 2
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JFifUnit
instance Binary JFifUnit where
put v = putWord8 $ case v of
@@ -175,7 +206,8 @@
, _jfifDpiY :: !Word16
, _jfifThumbnail :: !(Maybe {- (Image PixelRGB8) -} Int)
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgJFIFApp0
instance Binary JpgJFIFApp0 where
get = do
@@ -260,7 +292,8 @@
, jpgImageComponentCount :: !Word8
, jpgComponents :: ![JpgComponent]
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgFrameHeader
instance SizeCalculable JpgFrameHeader where
@@ -275,13 +308,15 @@
, verticalSamplingFactor :: !Word8
, quantizationTableDest :: !Word8
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgComponent
instance SizeCalculable JpgComponent where
calculateSize _ = 3
data JpgImage = JpgImage { jpgFrame :: [JpgFrame] }
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgImage
data JpgScanSpecification = JpgScanSpecification
{ componentSelector :: !Word8
@@ -291,7 +326,8 @@
, acEntropyCodingTable :: !Word8
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgScanSpecification
instance SizeCalculable JpgScanSpecification where
calculateSize _ = 2
@@ -310,7 +346,8 @@
-- | Encoded as 4 bits
, successiveApproxLow :: !Word8
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgScanHeader
instance SizeCalculable JpgScanHeader where
calculateSize hdr = 2 + 1
@@ -327,7 +364,8 @@
, quantTable :: MacroBlock Int16
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgQuantTableSpec
class SizeCalculable a where
calculateSize :: a -> Int
@@ -382,7 +420,8 @@
, huffSizes :: !(VU.Vector Word8)
, huffCodes :: !(V.Vector (VU.Vector Word8))
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData JpgHuffmanTableSpec
instance SizeCalculable JpgHuffmanTableSpec where
calculateSize table = 1 + 16 + sum [fromIntegral e | e <- VU.toList $
huffSizes table]
@@ -416,15 +455,28 @@
putWord8 0xFF >> putWord8 0xD8 >> mapM_ putFrame frames
>> putWord8 0xFF >> putWord8 0xD9
+ -- | Consider using `getJpgImage` instead for a non-semi-lazy
implementation.
get = do
- let startOfImageMarker = 0xD8
- -- endOfImageMarker = 0xD9
- checkMarker commonMarkerFirstByte startOfImageMarker
- eatUntilCode
- frames <- parseFrames
+ skipUntilFrames
+ frames <- parseFramesSemiLazy
+ -- let endOfImageMarker = 0xD9
{-checkMarker commonMarkerFirstByte endOfImageMarker-}
return JpgImage { jpgFrame = frames }
+-- | Like `get` from `instance Binary JpgImage`, but without the legacy
+-- semi-lazy implementation.
+getJpgImage :: Get JpgImage
+getJpgImage = do
+ skipUntilFrames
+ frames <- parseFrames
+ return JpgImage { jpgFrame = frames }
+
+skipUntilFrames :: Get ()
+skipUntilFrames = do
+ let startOfImageMarker = 0xD8
+ checkMarker commonMarkerFirstByte startOfImageMarker
+ eatUntilCode
+
eatUntilCode :: Get ()
eatUntilCode = do
code <- getWord8
@@ -436,7 +488,7 @@
getByteString (fromIntegral size - 2)
putFrame :: JpgFrame -> Put
-putFrame (JpgAdobeAPP14 adobe) =
+putFrame (JpgAdobeAPP14 adobe) =
put (JpgAppSegment 14) >> putWord16be 14 >> put adobe
putFrame (JpgJFIF jfif) =
put (JpgAppSegment 0) >> putWord16be (14+2) >> put jfif
@@ -469,41 +521,162 @@
when (rb1 /= b1 || rb2 /= b2)
(fail "Invalid marker used")
-extractScanContent :: L.ByteString -> (L.ByteString, L.ByteString)
-extractScanContent str = aux 0
- where maxi = fromIntegral $ L.length str - 1
-
- aux n | n >= maxi = (str, L.empty)
- | v == 0xFF && vNext /= 0 && not isReset = L.splitAt n str
- | otherwise = aux (n + 1)
- where v = str `L.index` n
- vNext = str `L.index` (n + 1)
- isReset = 0xD0 <= vNext && vNext <= 0xD7
-
-parseAdobe14 :: B.ByteString -> [JpgFrame] -> [JpgFrame]
-parseAdobe14 str lst = go where
- go = case runGetStrict get str of
- Left _err -> lst
- Right app14 -> JpgAdobeAPP14 app14 : lst
+-- | Simpler implementation of `parseECS` to allow an easier understanding
+-- of the logic, and to provide a comparison for correctness.
+parseECS_simple :: Get L.ByteString
+parseECS_simple = do
+ -- There's no efficient way in `binary` to parse byte-by-byte while
assembling a
+ -- resulting ByteString (without using `.Internal` modules, which is what
+ -- `parseECS` does), so instead first compute the length of the content
+ -- byte-by-byte inside a `lookAhead` (not advancing the parser offset), and
+ -- then efficiently take that long a ByteString (advancing the parser
offset).
+ --
+ -- This is still slow compared to `parseECS` because parser functions
+ -- (`getWord8`) are used repeatedly, instead of plain loops over
ByteString contents.
+ -- The slowdown is ~2x on GHC 8.10.7 on an Intel Core i7-7500U.
+ n <- lookAhead getContentLength
+ getLazyByteString n
+ where
+ getContentLength :: Get ByteOffset
+ getContentLength = do
+ bytesReadBeforeContent <- bytesRead
+ let loop :: Word8 -> Get ByteOffset
+ loop !v = do
+ vNext <- getWord8
+ let isReset = 0xD0 <= vNext && vNext <= 0xD7
+ let vIsSegmentMarker = v == 0xFF && vNext /= 0 && not isReset
+ if not vIsSegmentMarker
+ then loop vNext
+ else do
+ bytesReadAfterContentPlus2 <- bytesRead -- "plus 2"
because we've also read the segment marker (0xFF and `vNext`)
+ let !contentLength = (bytesReadAfterContentPlus2 - 2)
- bytesReadBeforeContent
+ return contentLength
+
+ v_first <- getWord8
+ loop v_first
+
+-- Replace by `Data.ByteString.dropEnd` once we require `bytestring >=
0.11.1.0`.
+bsDropEnd :: Int -> B.ByteString -> B.ByteString
+bsDropEnd n bs
+ | n <= 0 = bs
+ | n >= len = B.empty
+ | otherwise = B.take (len - 1) bs
+ where
+ len = B.length bs
+{-# INLINE bsDropEnd #-}
+
+-- | Parses a Scan's ECS (Entropy-Coded Segment, the largest part of
compressed image data)
+-- from the `Get` stream.
+--
+-- When this function is called, the parser's offset should be
+-- immediately behind the SOS tag.
+--
+-- As described on e.g. https://www.ccoderun.ca/programming/2017-01-31_jpeg/,
+--
+-- > To find the next segment after the SOS, you must keep reading until you
+-- > find a 0xFF bytes which is not immediately followed by 0x00 (see "byte
stuffing")
+-- > [or a reset marker's byte: 0xD0 through 0xD7].
+-- > Normally, this will be the EOI segment that comes at the end of the file.
+--
+-- where the 0xFF is the next segment's marker.
+-- See
https://github.com/corkami/formats/blob/master/image/jpeg.md#entropy-coded-segment
+-- for more details.
+--
+-- This function returns the ECS, not including the next segment's
+-- marker on its trailing end.
+parseECS :: Get L.ByteString
+parseECS = do
+ -- For a simpler but slower implementation of this function, see
+ -- `parseECS_simple`.
+
+ v_first <- getWord8
+ -- TODO: Compare with what `scan` from `binary-parsers` does.
+ -- Probably we cannot use it because it does not allow us to set the
parser state
+ -- to be _before_ the segment marker which would be convenient to
not have to
+ -- make a special case the function that calls this function.
+ -- But `scan` works on pointers into the bytestring chunks. Why, for
performance?
+ -- I've asked on
https://github.com/winterland1989/binary-parsers/issues/7
+ -- If that is for performance, we may want to replicate the same
thing here.
+ --
+ -- An orthogonal idea is to use `Data.ByteString.elemIndex` to
fast-forward
+ -- to the next 0xFF using `memchr`, but the `unsafe` call to
`memchr` might
+ -- have too much overhead, since 0xFF bytes appear statistically
every 256 bytes.
+ -- See
https://stackoverflow.com/questions/14519905/how-much-does-it-cost-for-haskell-ffi-to-go-into-c-and-back
+
+ -- `withInputChunks` allows us to work on chunks of ByteStrings,
+ -- reducing the number of higher-overhead `Get` functions called.
+ -- It also allows to easily assemble the ByteString to return,
+ -- which may be cross-chunk.
+ -- `withInputChunks` terminates when we return a
+ -- Right (consumed :: ByteString, unconsumed :: ByteString)
+ -- from `consumeChunk`, setting the `Get` parser's offset to just before
`unconsumed`.
+ -- Because the segment marker we seek may be the 2 bytes across chunk
boundaries,
+ -- we need to keep a reference to the previous chunk (initialised as
`B.empty`),
+ -- so that we can set `consumed` properly, because this function is
supposed
+ -- to not consume the start of the segment marker (see code dropping the
last
+ -- byte of the previous chunk below).
+ GetInternal.withInputChunks
+ (v_first, B.empty)
+ consumeChunk
+ ( L.fromChunks . (B.singleton v_first :)) -- `v_first` also
belongs to the returned BS
+ (return . L.fromChunks . (B.singleton v_first :)) -- `v_first` also
belongs to the returned BS
+ where
+ consumeChunk :: GetInternal.Consume (Word8, B.ByteString) -- which is:
(Word8, B.ByteString) -> B.ByteString -> Either (Word8, B.ByteString)
(B.ByteString, B.ByteString)
+ consumeChunk (!v_chunk_start, !prev_chunk) !chunk
+ -- If `withInputChunks` hands us an empty chunk (which `binary`
probably
+ -- won't do, but since that's not documented, handle it anyway) then
skip over it,
+ -- so that we always remember the last `prev_chunk` that actually has
data in it,
+ -- since we `bsDropEnd 1 prev_chunk` in the `case` below.
+ | B.null chunk = Left (v_chunk_start, prev_chunk)
+ | otherwise = loop v_chunk_start 0
+ where
+ loop :: Word8 -> Int -> Either (Word8, B.ByteString)
(B.ByteString, B.ByteString)
+ loop !v !offset_in_chunk
+ | offset_in_chunk >= B.length chunk = Left (v, chunk)
+ | otherwise =
+ let !vNext = BU.unsafeIndex chunk offset_in_chunk --
bounds check is done above
+ !isReset = 0xD0 <= vNext && vNext <= 0xD7
+ !vIsSegmentMarker = v == 0xFF && vNext /= 0 && not
isReset
+ in
+ if not vIsSegmentMarker
+ then loop vNext (offset_in_chunk+1)
+ else
+ -- Set the parser state to _before_ the
segment marker.
+ -- The first case, where the segment marker's
2 bytes are exactly
+ -- at the chunk boundary, requires us to
allocate a new BS with
+ -- `B.cons`; luckily this case should be rare.
+ let (!consumed, !unconsumed) = case () of
+ () | offset_in_chunk == 0 -> (bsDropEnd 1
prev_chunk, v `B.cons` chunk) -- segment marker starts at `v`, which is the
last byte of the previous chunk
+ | offset_in_chunk == 1 -> (B.empty,
chunk) -- segment marker starts exactly at `chunk`
+ | otherwise -> B.splitAt
(offset_in_chunk - 1) chunk -- segment marker starts at `v`, which is 1 before
`vNext` (which is at `offset_in_chunk`)
+ in Right $! (consumed, unconsumed)
+
+
+
+parseAdobe14 :: B.ByteString -> Maybe JpgFrame
+parseAdobe14 str = case runGetStrict get str of
+ Left _err -> Nothing
+ Right app14 -> Just $! JpgAdobeAPP14 app14
-- | Parse JFIF or JFXX information. Right now only JFIF.
-parseJF__ :: B.ByteString -> [JpgFrame] -> [JpgFrame]
-parseJF__ str lst = go where
- go = case runGetStrict get str of
- Left _err -> lst
- Right jfif -> JpgJFIF jfif : lst
-
-parseExif :: B.ByteString -> [JpgFrame] -> [JpgFrame]
-parseExif str lst
- | exifHeader `B.isPrefixOf` str = go
- | otherwise = lst
+parseJF__ :: B.ByteString -> Maybe JpgFrame
+parseJF__ str = case runGetStrict get str of
+ Left _err -> Nothing
+ Right jfif -> Just $! JpgJFIF jfif
+
+parseExif :: B.ByteString -> Maybe JpgFrame
+parseExif str
+ | exifHeader `B.isPrefixOf` str =
+ let
+ tiff = B.drop (B.length exifHeader) str
+ in
+ case runGetStrict (getP tiff) tiff of
+ Left _err -> Nothing
+ Right (_hdr :: TiffHeader, []) -> Nothing
+ Right (_hdr :: TiffHeader, ifds : _) -> Just $! JpgExif ifds
+ | otherwise = Nothing
where
exifHeader = BC.pack "Exif\0\0"
- tiff = B.drop (B.length exifHeader) str
- go = case runGetStrict (getP tiff) tiff of
- Left _err -> lst
- Right (_hdr :: TiffHeader, []) -> lst
- Right (_hdr :: TiffHeader, ifds : _) -> JpgExif ifds : lst
putExif :: [ImageFileDirectory] -> Put
putExif ifds = putAll where
@@ -515,7 +688,7 @@
ifdList = case partition (isInIFD0 . ifdIdentifier) ifds of
(ifd0, []) -> [ifd0]
(ifd0, ifdExif) -> [ifd0 <> pure exifOffsetIfd, ifdExif]
-
+
exifBlob = runPut $ do
putByteString $ BC.pack "Exif\0\0"
putP BC.empty (hdr, ifdList)
@@ -525,47 +698,190 @@
putWord16be . fromIntegral $ L.length exifBlob + 2
putLazyByteString exifBlob
-parseFrames :: Get [JpgFrame]
-parseFrames = do
- kind <- get
- let parseNextFrame = do
- word <- getWord8
- when (word /= 0xFF) $ do
- readedData <- bytesRead
- fail $ "Invalid Frame marker (" ++ show word
- ++ ", bytes read : " ++ show readedData ++ ")"
- parseFrames
-
+skipFrameMarker :: Get ()
+skipFrameMarker = do
+ word <- getWord8
+ when (word /= 0xFF) $ do
+ readedData <- bytesRead
+ fail $ "Invalid Frame marker (" ++ show word
+ ++ ", bytes read : " ++ show readedData ++ ")"
+
+-- | Parses a single frame.
+--
+-- Returns `Nothing` when we encounter a frame we want to skip.
+parseFrameOfKind :: JpgFrameKind -> Get (Maybe JpgFrame)
+parseFrameOfKind kind = do
case kind of
- JpgEndOfImage -> return []
- JpgAppSegment 0 ->
- parseJF__ <$> takeCurrentFrame <*> parseNextFrame
- JpgAppSegment 1 ->
- parseExif <$> takeCurrentFrame <*> parseNextFrame
- JpgAppSegment 14 ->
- parseAdobe14 <$> takeCurrentFrame <*> parseNextFrame
- JpgAppSegment c ->
- (\frm lst -> JpgAppFrame c frm : lst) <$> takeCurrentFrame <*>
parseNextFrame
- JpgExtensionSegment c ->
- (\frm lst -> JpgExtension c frm : lst) <$> takeCurrentFrame <*>
parseNextFrame
+ JpgEndOfImage -> return Nothing
+ JpgAppSegment 0 -> parseJF__ <$> takeCurrentFrame
+ JpgAppSegment 1 -> parseExif <$> takeCurrentFrame
+ JpgAppSegment 14 -> parseAdobe14 <$> takeCurrentFrame
+ JpgAppSegment c -> Just . JpgAppFrame c <$> takeCurrentFrame
+ JpgExtensionSegment c -> Just . JpgExtension c <$> takeCurrentFrame
JpgQuantizationTable ->
- (\(TableList quants) lst -> JpgQuantTable quants : lst) <$> get
<*> parseNextFrame
+ (\(TableList quants) -> Just $! JpgQuantTable quants) <$> get
JpgRestartInterval ->
- (\(RestartInterval i) lst -> JpgIntervalRestart i : lst) <$> get
<*> parseNextFrame
+ (\(RestartInterval i) -> Just $! JpgIntervalRestart i) <$> get
JpgHuffmanTableMarker ->
- (\(TableList huffTables) lst ->
- JpgHuffmanTable [(t, packHuffmanTree .
buildPackedHuffmanTree $ huffCodes t) | t <- huffTables] : lst)
- <$> get <*> parseNextFrame
- JpgStartOfScan ->
- (\frm imgData ->
- let (d, other) = extractScanContent imgData
- in
- case runGet parseFrames (L.drop 1 other) of
- Left _ -> [JpgScanBlob frm d]
- Right lst -> JpgScanBlob frm d : lst
- ) <$> get <*> getRemainingLazyBytes
+ (\(TableList huffTables) -> Just $!
+ JpgHuffmanTable [(t, packHuffmanTree .
buildPackedHuffmanTree $ huffCodes t) | t <- huffTables])
+ <$> get
+ JpgStartOfScan -> do
+ scanHeader <- get
+ ecs <- parseECS
+ return $! Just $! JpgScanBlob scanHeader ecs
+ _ -> Just . JpgScans kind <$> get
+
+
+-- | Parse a list of `JpgFrame`s.
+--
+-- This function has various quirks; consider the below with great caution
+-- when using this function.
+--
+-- While @data JpgFrame = ... | JpgScanBlob !...` itself has strict fields,
+--
+-- This function is written in such a way that that it can construct
+-- the @[JpgFrame]@ "lazily" such that the expensive byte-by-byte traversal
+-- in `parseECS` to create a `JpgScanBlob` can be avoided if only
+-- list elements before that `JpgScanBlob` are evaluated.
+--
+-- That means the user can write code such as
+--
+-- > let mbFirstScan =
+-- > case runGetOrFail (get @JPG.JpgImage) hugeImageByteString of --
(`get @JPG.JpgImage` uses `parseFramesSemiLazy`)
+-- > Right (_restBs, _offset, res) ->
+-- > find (\frame -> case frame of { JPG.JpgScans{} -> True; _ ->
False }) (JPG.jpgFrame res)
+--
+-- with the guarantee that only the bytes before the ECS (large compressed
image data)
+-- will be inspected, assuming that indeed there is at least 1 `JpgScan` in
front
+-- of the `JpgScanBlob` that contains the ECS.
+--
+-- This guarantee can be useful to e.g. quickly read just the image
+-- dimensions (width, height) without traversing the large data.
+--
+-- Also note that this `Get` parser does not correctly maintain the parser
byte offset
+-- (`Data.Binary.Get.bytesRead`), because as soon as a `JpgStartOfScan` is
returned,
+-- it uses `Data.Binary.Get.getRemainingLazyBytes` to provide:
+--
+-- 1. the laziness described above, and
+-- 2. the ability to ignore any parser failure after the first
successfully-parsed
+-- `JpgScanBlob` (it is debatable whether this behaviour is a desirable
behaviour of this
+-- library, but it is historically so and existing exposed functions do not
break
+-- this for backwards compatibility with existing uses of this library).
+-- This fact also means that even `parseNextFrameStrict` cannot maintain
+-- correct parser byte offsets.
+--
+-- Further note that if you are reading a huge JPEG image from disk strictly,
+-- this will already incur a full traversal (namely creation) of the
`hugeImageByteString`.
+-- Thus, `parseNextFrameLazy` only provides any benefit if you:
+--
+-- - read the image from disk using lazy IO (not recommended!) such as via
+-- `Data.ByteString.Lazy.readFile`,
+-- - or do something similar, such as creating the `hugeImageByteString` via
@mmap()@
+--
+-- This function is called "semi lazy" because only the first `JpgScanBlob`
returned
+-- in the `[JpgFrame]` is returned lazily; frames of other types, or multiple
+-- `JpgScanBlob`s, are confusingly not dealt with lazily.
+--
+-- If as a caller you do not want to deal with any of these quirks,
+-- and use proper strict IO and/or via `Data.Binary.Get`'s incremental input
interface:
+--
+-- - If you want the whole `[JpgFrame]`: use `parseFrames`.
+-- - If you want parsing to terminate early as in the example shown above,
+-- use in combination with just the right amount of `get :: Get
JpgFrameKind`,
+-- `parseFrameOfKind`, and `skipFrameMarker`.
+parseFramesSemiLazy :: Get [JpgFrame]
+parseFramesSemiLazy = do
+ kind <- get
+ case kind of
+ -- The end-of-image case needs to be here because `_ ->` default case
below
+ -- unconditionally uses `skipFrameMarker` which does not exist after
`JpgEndOfImage`.
+ JpgEndOfImage -> pure []
+ JpgStartOfScan -> do
+ scanHeader <- get
+ remainingBytes <- getRemainingLazyBytes
+ -- It is after the above `getRemainingLazyBytes` that the `Get`
parser lazily succeeds,
+ -- allowing consumers of `parseFramesSemiLazy` evaluate all
`[JpgFrame]` list elements
+ -- until (excluding) the cons-cell around the `JpgScanBlob ...` we
construct below.
+
+ return $ case runGet parseECS remainingBytes of
+ Left _ ->
+ -- Construct invalid `JpgScanBlob` even when the
compressed JPEG
+ -- data is truncated or otherwise invalid, because that's
what JuicyPixels's
+ -- `parseFramesSemiLazy` function did in the past, for
backwards compat.
+ [JpgScanBlob scanHeader remainingBytes]
+ Right ecs ->
+ JpgScanBlob scanHeader ecs
+ :
+ -- TODO Why `drop 1` instead of `runGet (skipFrameMarker
*> parseFramesSemiLazy) remainingBytes` that would check that the dropped 1
Byte is really a frame marker?
+ case runGet parseFramesSemiLazy (L.drop (L.length ecs + 1)
remainingBytes) of
+ -- After we've encountered the first scan blob
containing encoded image data,
+ -- we accept anything else after to fail parsing,
ignoring that failure,
+ -- end emitting no further frames.
+ -- TODO: Explain why JuicyPixel chose to use this
logic, insteaed of failing.
+ Left _ -> []
+ Right remainingFrames -> remainingFrames
+ _ -> do
+ mbFrame <- parseFrameOfKind kind
+ skipFrameMarker
+ remainingFrames <- parseFramesSemiLazy
+ return $ maybeToList mbFrame ++ remainingFrames
- _ -> (\hdr lst -> JpgScans kind hdr : lst) <$> get <*> parseNextFrame
+-- | Parse a list of `JpgFrame`s.
+parseFrames :: Get [JpgFrame]
+parseFrames = do
+ kind <- get
+ case kind of
+ JpgEndOfImage -> pure []
+ _ -> do
+ mbFrame <- parseFrameOfKind kind
+ skipFrameMarker
+ remainingFrames <- parseFrames
+ return $ maybeToList mbFrame ++ remainingFrames
+
+-- | Parse a list of `JpgFrameKind`s with their corresponding offsets and
lengths
+-- (not counting the segment and frame markers into the lengths).
+--
+-- Useful for debugging.
+parseFrameKinds :: Get [(JpgFrameKind, Int64, Int64)]
+parseFrameKinds = do
+ kindMarkerOffset :: Int64 <- bytesRead
+ kind <- get
+ case kind of
+ JpgEndOfImage -> pure [(JpgEndOfImage, kindMarkerOffset, 0)]
+ _ -> do
+ parserOffsetBefore <- bytesRead
+ _ <- parseFrameOfKind kind
+ parserOffsetAfter <- bytesRead
+ let !segmentLengthWithoutMarker = parserOffsetAfter -
parserOffsetBefore
+ skipFrameMarker
+ remainingKinds <- parseFrameKinds
+ return $ (kind, kindMarkerOffset,
segmentLengthWithoutMarker):remainingKinds
+
+-- | Parses forward, returning the first scan header encountered.
+--
+-- Should be used after `skipUntilFrames`.
+--
+-- Fails parsing when an SOS segment marker (`JpgStartOfScan`, resulting
+-- in `JpgScanBlob`) is encountered before an SOF segment marker (that
+-- results in `JpgScans` carrying the `JpgFrameHeader`).
+parseToFirstFrameHeader :: Get (Maybe JpgFrameHeader)
+parseToFirstFrameHeader = do
+ kind <- get
+ case kind of
+ JpgEndOfImage -> return Nothing
+ JpgStartOfScan -> fail "parseToFirstFrameHeader: Encountered SOS frame
marker before frame header that tells its dimensions"
+ _ -> do
+ mbFrame <- parseFrameOfKind kind
+ case mbFrame of
+ Nothing -> continueSearching
+ Just frame -> case frame of
+ JpgScans _ frameHeader -> return $ Just $! frameHeader
+ _ -> continueSearching
+ where
+ continueSearching = do
+ skipFrameMarker
+ parseToFirstFrameHeader
buildPackedHuffmanTree :: V.Vector (VU.Vector Word8) -> HuffmanTree
buildPackedHuffmanTree = buildHuffmanTree . map VU.toList . V.toList
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/JuicyPixels-3.3.8/src/Codec/Picture/Metadata/Exif.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/Metadata/Exif.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/Metadata/Exif.hs 2017-11-11
10:35:34.000000000 +0100
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/Metadata/Exif.hs 2024-06-06
20:34:05.000000000 +0200
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveGeneric #-}
+
-- | This module provide a totally partial and incomplete maping
-- of Exif values. Used for Tiff parsing and reused for Exif extraction.
module Codec.Picture.Metadata.Exif ( ExifTag( .. )
@@ -14,6 +16,7 @@
import Data.Word( Word16, Word32 )
import qualified Data.Vector as V
import qualified Data.ByteString as B
+import GHC.Generics( Generic )
-- | Tag values used for exif fields. Completly incomplete
data ExifTag
@@ -72,7 +75,8 @@
| TagExifOffset
| TagUnknown !Word16
- deriving (Eq, Ord, Show)
+ deriving (Eq, Ord, Show, Generic)
+instance NFData ExifTag
-- | Convert a value to it's corresponding Exif tag.
-- Will often be written as 'TagUnknown'
@@ -206,13 +210,5 @@
| ExifRational !Word32 !Word32
| ExifSignedRational !Int32 !Int32
| ExifIFD ![(ExifTag, ExifData)]
- deriving Show
-
-instance NFData ExifTag where
- rnf a = a `seq` ()
-
-instance NFData ExifData where
- rnf (ExifIFD ifds) = rnf ifds `seq` ()
- rnf (ExifLongs l) = rnf l `seq` ()
- rnf (ExifShorts l) = rnf l `seq` ()
- rnf a = a `seq` ()
+ deriving (Eq, Show, Generic)
+instance NFData ExifData
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/JuicyPixels-3.3.8/src/Codec/Picture/Metadata.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/Metadata.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/Metadata.hs 2018-12-16
22:36:06.000000000 +0100
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/Metadata.hs 2024-06-06
20:34:05.000000000 +0200
@@ -43,6 +43,8 @@
, dotsPerCentiMeterToDotPerInch
) where
+import Prelude hiding (Foldable(..))
+
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid( Monoid, mempty, mappend )
import Data.Word( Word )
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/JuicyPixels-3.3.8/src/Codec/Picture/Png/Internal/Type.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/Png/Internal/Type.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/Png/Internal/Type.hs
2018-12-16 22:36:06.000000000 +0100
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/Png/Internal/Type.hs
2024-06-06 20:34:05.000000000 +0200
@@ -14,6 +14,8 @@
, APngFrameControl( .. )
, parsePalette
, pngComputeCrc
+ , pngSignature
+ , iHDRSignature
, pLTESignature
, iDATSignature
, iENDSignature
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/JuicyPixels-3.3.8/src/Codec/Picture/Png.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/Png.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/Png.hs 2019-06-19
21:11:57.000000000 +0200
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/Png.hs 2024-06-06
20:34:05.000000000 +0200
@@ -366,8 +366,8 @@
deinterlacer :: PngIHdr -> B.ByteString -> ST s (Either (V.Vector Word8)
(V.Vector Word16))
deinterlacer (PngIHdr { width = w, height = h, colourType = imgKind
, interlaceMethod = method, bitDepth = depth }) str = do
- let compCount = sampleCountOfImageType imgKind
- arraySize = fromIntegral $ w * h * compCount
+ let compCount = fromIntegral $ sampleCountOfImageType imgKind
+ arraySize = (fromIntegral w) * (fromIntegral h) * compCount
deinterlaceFunction = case method of
PngNoInterlace -> scanLineInterleaving
PngInterlaceAdam7 -> adam7Unpack
@@ -377,10 +377,9 @@
imgArray <- M.new arraySize
let mutableImage = MutableImage (fromIntegral w) (fromIntegral h)
imgArray
deinterlaceFunction iBitDepth
- (fromIntegral compCount)
+ compCount
(fromIntegral w, fromIntegral h)
- (scanlineUnpacker8 iBitDepth (fromIntegral
compCount)
- mutableImage)
+ (scanlineUnpacker8 iBitDepth compCount
mutableImage)
str
Left <$> V.unsafeFreeze imgArray
@@ -388,9 +387,9 @@
imgArray <- M.new arraySize
let mutableImage = MutableImage (fromIntegral w) (fromIntegral h)
imgArray
deinterlaceFunction iBitDepth
- (fromIntegral compCount)
+ compCount
(fromIntegral w, fromIntegral h)
- (shortUnpacker (fromIntegral compCount)
mutableImage)
+ (shortUnpacker compCount mutableImage)
str
Right <$> V.unsafeFreeze imgArray
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/JuicyPixels-3.3.8/src/Codec/Picture/Tiff/Internal/Types.hs
new/JuicyPixels-3.3.9/src/Codec/Picture/Tiff/Internal/Types.hs
--- old/JuicyPixels-3.3.8/src/Codec/Picture/Tiff/Internal/Types.hs
2022-03-09 23:41:19.000000000 +0100
+++ new/JuicyPixels-3.3.9/src/Codec/Picture/Tiff/Internal/Types.hs
2024-06-06 20:34:05.000000000 +0200
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -32,6 +33,7 @@
import Control.Applicative( (<$>), (<*>), pure )
#endif
+import Control.DeepSeq( NFData(..) )
import Control.Monad( forM_, when, replicateM, )
import Data.Bits( (.&.), unsafeShiftR )
import Data.Binary( Binary( .. ) )
@@ -53,6 +55,7 @@
import qualified Data.ByteString as B
import Data.Int( Int32 )
import Data.Word( Word8, Word16, Word32 )
+import GHC.Generics( Generic )
import Codec.Picture.Metadata.Exif
{-import Debug.Trace-}
@@ -154,7 +157,8 @@
| TypeSignedRational
| TypeFloat
| TypeDouble
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData IfdType
instance BinaryParam Endianness IfdType where
getP endianness = getP endianness >>= conv where
@@ -403,7 +407,8 @@
, ifdOffset :: !Word32
, ifdExtended :: !ExifData
}
- deriving Show
+ deriving (Eq, Show, Generic)
+instance NFData ImageFileDirectory
instance BinaryParam Endianness ImageFileDirectory where
getP endianness =
