Exif metadata vomiting :)

JuicyPixels.cabal

@@ -106,6 +106,7 @@ Library
                     Codec.Picture.Tga,
                     Codec.Picture.Tiff,
                     Codec.Picture.Metadata,
+                    Codec.Picture.Metadata.Exif,
                     Codec.Picture.Saving,
                     Codec.Picture.Types,
                     Codec.Picture.ColorQuant

Makefile

@@ -30,7 +30,9 @@ test:
 
 lint:
 	hlint lint src \
+		--cpp-define=MIN_VERSION_base=1 \
 		--cpp-define=MIN_VERSION_transformers=1 \
+		--cpp-define=MIN_VERSION_containers=1 \
 		--cpp-define=MIN_VERSION_binary=1
 
 sdist: docimages/pixelgraph.svg

src/Codec/Picture/Metadata.hs

@@ -46,6 +46,8 @@ import Control.DeepSeq( NFData( .. ) )
 import Data.Typeable( (:~:)( Refl ) )
 import qualified Data.Foldable as F
 
+import Codec.Picture.Metadata.Exif
+
 -- | Store various additional information about an image. If
 -- something is not recognized, it can be stored in an unknown tag.
 --
@@ -68,11 +70,12 @@ data Keys a where
   Disclaimer  :: Keys String
   Source      :: Keys String
   Warning     :: Keys String
+  Exif        :: !ExifTag -> Keys ExifData
   Unknown     :: !String -> Keys Value
 
 deriving instance Show (Keys a)
 deriving instance Eq (Keys a)
-deriving instance Ord (Keys a)
+{-deriving instance Ord (Keys a)-}
 
 -- | Encode values for unknown information
 data Value
@@ -109,6 +112,7 @@ keyEq a b = case (a, b) of
   (Source, Source) -> Just Refl
   (Warning, Warning) -> Just Refl
   (Unknown v1, Unknown v2) | v1 == v2 -> Just Refl
+  (Exif t1, Exif t2) | t1 == t2 -> Just Refl
   _ -> Nothing
 
 -- | Dependent storage used for metadatas.

src/Codec/Picture/Metadata/Exif.hs

@@ -0,0 +1,205 @@
+-- | 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( .. )
+                                   , ExifData( .. )
+
+                                   , tagOfWord16
+                                   , word16OfTag
+                                   ) where
+
+import Control.DeepSeq( NFData( .. ) )
+import Data.Int( Int32 )
+import Data.Word( Word16, Word32 )
+import qualified Data.Vector as V
+import qualified Data.ByteString as B
+
+-- | Tag values used for exif fields. Completly incomplete
+data ExifTag
+  = TagPhotometricInterpretation
+  | TagCompression -- ^ Short type
+  | TagImageWidth  -- ^ Short or long type
+  | TagImageLength -- ^ Short or long type
+  | TagXResolution -- ^ Rational type
+  | TagYResolution -- ^ Rational type
+  | TagResolutionUnit --  ^ Short type
+  | TagRowPerStrip -- ^ Short or long type
+  | TagStripByteCounts -- ^ Short or long
+  | TagStripOffsets -- ^ Short or long
+  | TagBitsPerSample --  ^ Short
+  | TagColorMap -- ^ Short
+  | TagTileWidth
+  | TagTileLength
+  | TagTileOffset
+  | TagTileByteCount
+  | TagSamplesPerPixel -- ^ Short
+  | TagArtist
+  | TagDocumentName
+  | TagSoftware
+  | TagPlanarConfiguration -- ^ Short
+  | TagOrientation
+  | TagSampleFormat -- ^ Short
+  | TagInkSet
+  | TagSubfileType
+  | TagFillOrder
+  | TagYCbCrCoeff
+  | TagYCbCrSubsampling
+  | TagYCbCrPositioning
+  | TagReferenceBlackWhite
+  | TagXPosition
+  | TagYPosition
+  | TagExtraSample
+  | TagImageDescription
+  | TagPredictor
+  | TagCopyright
+  | TagMake
+  | TagModel
+  | TagDateTime
+  | TagGPSInfo
+
+  | TagJpegProc
+  | TagJPEGInterchangeFormat
+  | TagJPEGInterchangeFormatLength
+  | TagJPEGRestartInterval
+  | TagJPEGLosslessPredictors
+  | TagJPEGPointTransforms
+  | TagJPEGQTables
+  | TagJPEGDCTables
+  | TagJPEGACTables
+
+  | TagExifOffset
+  | TagUnknown !Word16
+  deriving (Eq, Ord, Show)
+
+-- | Convert a value to it's corresponding Exif tag.
+-- Will often be written as 'TagUnknown'
+tagOfWord16 :: Word16 -> ExifTag
+tagOfWord16 v = case v of
+  255 -> TagSubfileType
+  256 -> TagImageWidth
+  257 -> TagImageLength
+  258 -> TagBitsPerSample
+  259 -> TagCompression
+  262 -> TagPhotometricInterpretation
+  266 -> TagFillOrder
+  269 -> TagDocumentName
+  270 -> TagImageDescription
+  271 -> TagMake
+  272 -> TagModel
+  273 -> TagStripOffsets
+  274 -> TagOrientation
+  277 -> TagSamplesPerPixel
+  278 -> TagRowPerStrip
+  279 -> TagStripByteCounts
+  282 -> TagXResolution
+  283 -> TagYResolution
+  284 -> TagPlanarConfiguration
+  286 -> TagXPosition
+  287 -> TagYPosition
+  296 -> TagResolutionUnit
+  305 -> TagSoftware
+  306 -> TagDateTime
+  315 -> TagArtist
+  317 -> TagPredictor
+  320 -> TagColorMap
+  322 -> TagTileWidth
+  323 -> TagTileLength
+  324 -> TagTileOffset
+  325 -> TagTileByteCount
+  332 -> TagInkSet
+  338 -> TagExtraSample
+  339 -> TagSampleFormat
+  529 -> TagYCbCrCoeff
+  512 -> TagJpegProc
+  513 -> TagJPEGInterchangeFormat
+  514 -> TagJPEGInterchangeFormatLength
+  515 -> TagJPEGRestartInterval
+  517 -> TagJPEGLosslessPredictors
+  518 -> TagJPEGPointTransforms
+  519 -> TagJPEGQTables
+  520 -> TagJPEGDCTables
+  521 -> TagJPEGACTables
+  530 -> TagYCbCrSubsampling
+  531 -> TagYCbCrPositioning
+  532 -> TagReferenceBlackWhite
+  33432 -> TagCopyright
+  34665 -> TagExifOffset
+  34853 -> TagGPSInfo
+  vv -> TagUnknown vv
+
+-- | Convert a tag to it's corresponding value.
+word16OfTag :: ExifTag -> Word16
+word16OfTag t = case t of
+  TagSubfileType -> 255
+  TagImageWidth -> 256
+  TagImageLength -> 257
+  TagBitsPerSample -> 258
+  TagCompression -> 259
+  TagPhotometricInterpretation -> 262
+  TagFillOrder -> 266
+  TagDocumentName -> 269
+  TagImageDescription -> 270
+  TagMake -> 271
+  TagModel -> 272
+  TagStripOffsets -> 273
+  TagOrientation -> 274
+  TagSamplesPerPixel -> 277
+  TagRowPerStrip -> 278
+  TagStripByteCounts -> 279
+  TagXResolution -> 282
+  TagYResolution -> 283
+  TagPlanarConfiguration -> 284
+  TagXPosition -> 286
+  TagYPosition -> 287
+  TagResolutionUnit -> 296
+  TagSoftware -> 305
+  TagDateTime -> 306
+  TagArtist -> 315
+  TagPredictor -> 317
+  TagColorMap -> 320
+  TagTileWidth -> 322
+  TagTileLength -> 323
+  TagTileOffset -> 324
+  TagTileByteCount -> 325
+  TagInkSet -> 332
+  TagExtraSample -> 338
+  TagSampleFormat -> 339
+  TagYCbCrCoeff -> 529
+  TagJpegProc -> 512
+  TagJPEGInterchangeFormat -> 513
+  TagJPEGInterchangeFormatLength -> 514
+  TagJPEGRestartInterval -> 515
+  TagJPEGLosslessPredictors -> 517
+  TagJPEGPointTransforms -> 518
+  TagJPEGQTables -> 519
+  TagJPEGDCTables -> 520
+  TagJPEGACTables -> 521
+  TagYCbCrSubsampling -> 530
+  TagYCbCrPositioning -> 531
+  TagReferenceBlackWhite -> 532
+  TagCopyright -> 33432
+  TagExifOffset -> 34665
+  TagGPSInfo -> 34853
+  (TagUnknown v) -> v
+
+-- | Possible data held by an Exif tag
+data ExifData
+  = ExifNone
+  | ExifLong      !Word32
+  | ExifShort     !Word16
+  | ExifString    !B.ByteString
+  | ExifUndefined !B.ByteString
+  | ExifShorts    !(V.Vector Word16)
+  | ExifLongs     !(V.Vector Word32)
+  | 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` ()

src/Codec/Picture/Png/Export.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE TypeFamilies #-}

src/Codec/Picture/Png/Metadata.hs

@@ -97,6 +97,7 @@ encodeSingleMetadata :: Metadatas -> [PngRawChunk]
 encodeSingleMetadata = Met.foldMap go where
   go :: Elem Met.Keys -> [PngRawChunk]
   go v = case v of
+    Met.Exif _ :=> _ -> mempty
     Met.DpiX :=> _ -> mempty
     Met.DpiY :=> _ -> mempty
     Met.Gamma       :=> g ->