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 <psim...@suse.com> + +- 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 =