Adding format in metadatas

changelog

@@ -6,6 +6,7 @@ V3.2.5.2 June 2015
 
  * Adding: Width & Height metdata to help querying image information
 	without decompressing the whole.
+ * Adding: Source format metadata.
 
 v3.2.5.1 May 2015
 ---------------

src/Codec/Picture/Bitmap.hs

@@ -26,7 +26,6 @@ import Control.Applicative( (<$>) )
 import Control.Monad( when, forM_ )
 import Control.Monad.ST ( ST, runST )
 import Data.Maybe( fromMaybe )
-import Data.Monoid( (<>) )
 import qualified Data.Vector as V
 import qualified Data.Vector.Storable as VS
 import qualified Data.Vector.Storable.Mutable as M
@@ -313,9 +312,9 @@ pixelGet = do
     return $ PixelRGB8 r g b
 
 metadataOfHeader :: BmpInfoHeader -> Metadatas
-metadataOfHeader hdr = Met.mkSizeMetadata (width hdr) (height hdr) <> dpiMeta
+metadataOfHeader hdr = 
+  Met.simpleMetadata Met.SourceBitmap (width hdr) (height hdr) dpiX dpiY
   where
-    dpiMeta = Met.insert Met.DpiY dpiY $ Met.singleton Met.DpiX dpiX  
     dpiX = Met.dotsPerMeterToDotPerInch . fromIntegral $ xResolution hdr
     dpiY = Met.dotsPerMeterToDotPerInch . fromIntegral $ yResolution hdr
 

src/Codec/Picture/Gif.hs

@@ -59,7 +59,9 @@ import Data.Binary.Put( Put
 
 import Codec.Picture.InternalHelper
 import Codec.Picture.Types
-import Codec.Picture.Metadata( Metadatas, mkSizeMetadata )
+import Codec.Picture.Metadata( Metadatas
+                             , SourceFormat( SourceGif )
+                             , basicMetadata )
 import Codec.Picture.Gif.LZW
 import Codec.Picture.Gif.LZWEncoding
 import Codec.Picture.BitWriter
@@ -665,7 +667,7 @@ decodeFirstGifImage :: GifFile -> Either String (DynamicImage, Metadatas)
 decodeFirstGifImage img@GifFile { gifImages = (firstImage:_) } =
     case decodeAllGifImages img { gifImages = [firstImage] } of
       [] -> Left "No image after decoding"
-      (i:_) -> Right (i, mkSizeMetadata (screenWidth hdr) (screenHeight hdr))
+      (i:_) -> Right (i, basicMetadata SourceGif (screenWidth hdr) (screenHeight hdr))
   where hdr = gifScreenDescriptor $ gifHeader img
 decodeFirstGifImage _ = Left "No image in gif file"
 

src/Codec/Picture/HDR.hs

@@ -37,7 +37,9 @@ 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, mkSizeMetadata )
+import Codec.Picture.Metadata( Metadatas
+                             , SourceFormat( SourceHDR )
+                             , basicMetadata )
 import Codec.Picture.InternalHelper
 import Codec.Picture.Types
 import Codec.Picture.VectorByteConversion
@@ -180,7 +182,7 @@ decodeHDRWithMetadata str = runST $ runExceptT $
   case runGet decodeHeader $ L.fromChunks [str] of
     Left err -> throwE err
     Right rez ->
-      let meta = mkSizeMetadata (abs $ radianceWidth rez) (abs $ radianceHeight rez) in
+      let meta = basicMetadata SourceHDR (abs $ radianceWidth rez) (abs $ radianceHeight rez) in
       (, meta) . ImageRGBF <$> (decodeRadiancePicture rez >>= lift . unsafeFreezeImage)
 
 getChar8 :: Get Char

src/Codec/Picture/Jpg.hs

@@ -47,7 +47,9 @@ import qualified Data.ByteString.Lazy as L
 import Codec.Picture.InternalHelper
 import Codec.Picture.BitWriter
 import Codec.Picture.Types
-import Codec.Picture.Metadata( Metadatas, mkSizeMetadata )
+import Codec.Picture.Metadata( Metadatas
+                             , SourceFormat( SourceJpeg )
+                             , basicMetadata )
 import Codec.Picture.Tiff.Types
 import Codec.Picture.Tiff.Metadata
 import Codec.Picture.Jpg.Types
@@ -588,7 +590,7 @@ decodeJpegWithMetadata file = case runGetStrict get file of
       imgWidth = fromIntegral $ jpgWidth scanInfo
       imgHeight = fromIntegral $ jpgHeight scanInfo
 
-      sizeMeta = mkSizeMetadata imgWidth imgHeight
+      sizeMeta = basicMetadata SourceJpeg imgWidth imgHeight
 
       imageSize = imgWidth * imgHeight * compCount
 

src/Codec/Picture/Metadata.hs

@@ -16,6 +16,7 @@ module Codec.Picture.Metadata( -- * Types
                              , Keys( .. )
                              , Value( .. )
                              , Elem( .. )
+                             , SourceFormat( .. )
 
                                -- * Functions
                              , Codec.Picture.Metadata.lookup
@@ -31,6 +32,8 @@ module Codec.Picture.Metadata( -- * Types
                               -- * Helper functions
                              , mkDpiMetadata
                              , mkSizeMetadata
+                             , basicMetadata
+                             , simpleMetadata
 
                                -- * Conversion functions
                              , dotsPerMeterToDotPerInch
@@ -57,6 +60,20 @@ data Equiv a b where
     Refl :: Equiv a a
 #endif
 
+-- | Type describing the original file format of the ilfe.
+data SourceFormat
+  = SourceJpeg
+  | SourceGif
+  | SourceBitmap
+  | SourceTiff
+  | SourcePng
+  | SourceHDR
+  | SourceTGA
+  deriving (Eq, Show)
+
+instance NFData SourceFormat where
+  rnf a = a `seq` ()
+
 -- | Store various additional information about an image. If
 -- something is not recognized, it can be stored in an unknown tag.
 --
@@ -78,6 +95,7 @@ data Equiv a b where
 --
 data Keys a where
   Gamma       :: Keys Double
+  Format      :: Keys SourceFormat
   DpiX        :: Keys Word
   DpiY        :: Keys Word
   Width       :: Keys Word
@@ -134,6 +152,7 @@ keyEq a b = case (a, b) of
   (Disclaimer, Disclaimer) -> Just Refl
   (Source, Source) -> Just Refl
   (Warning, Warning) -> Just Refl
+  (Format, Format) -> Just Refl
   (Unknown v1, Unknown v2) | v1 == v2 -> Just Refl
   (Exif t1, Exif t2) | t1 == t2 -> Just Refl
   _ -> Nothing
@@ -211,9 +230,30 @@ dotsPerCentiMeterToDotPerInch z = z * 254 `div` 100
 
 -- | Create metadatas indicating the resolution, with DpiX == DpiY
 mkDpiMetadata :: Word -> Metadatas
-mkDpiMetadata w = insert DpiY w $ singleton DpiX w
+mkDpiMetadata w =
+  Metadatas [DpiY :=> w, DpiX :=> w]
 
 -- | Create metadatas holding width and height information.
 mkSizeMetadata :: Integral n => n -> n -> Metadatas
-mkSizeMetadata w h = insert Width (fromIntegral w) . singleton Height $ fromIntegral h
+mkSizeMetadata w h = 
+  Metadatas [ Width :=> fromIntegral w, Height :=> fromIntegral h ]
+
+-- | Create simple metadatas with Format, Width & Height
+basicMetadata :: Integral nSize => SourceFormat -> nSize -> nSize -> Metadatas
+basicMetadata f w h =
+  Metadatas [ Format :=> f
+            , Width :=> fromIntegral w
+            , Height :=> fromIntegral h
+            ]
+
+-- | Create simple metadatas with Format, Width, Height, DpiX & DpiY
+simpleMetadata :: (Integral nSize, Integral nDpi)
+               => SourceFormat -> nSize -> nSize -> nDpi -> nDpi -> Metadatas
+simpleMetadata f w h dpiX dpiY =
+  Metadatas [ Format :=> f
+            , Width :=> fromIntegral w
+            , Height :=> fromIntegral h
+            , DpiX :=> fromIntegral dpiX
+            , DpiY :=> fromIntegral dpiY
+            ]
 

src/Codec/Picture/Png.hs

@@ -508,7 +508,8 @@ decodePngWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
 decodePngWithMetadata byte =  do
   rawImg <- runGetStrict get byte
   let ihdr = header rawImg
-      metadatas = mkSizeMetadata (width ihdr) (height ihdr) <> extractMetadatas rawImg
+      metadatas =
+         basicMetadata SourcePng (width ihdr) (height ihdr) <> extractMetadatas rawImg
       compressedImageData =
             Lb.concat [chunkData chunk | chunk <- chunks rawImg
                                        , chunkType chunk == iDATSignature]

src/Codec/Picture/Png/Metadata.hs

@@ -113,6 +113,7 @@ encodeSingleMetadata = Met.foldMap go where
     Met.DpiY :=> _ -> mempty
     Met.Width :=> _ -> mempty
     Met.Height :=> _ -> mempty
+    Met.Format :=> _ -> mempty
     Met.Gamma       :=> g ->
       pure $ mkRawChunk gammaSignature . encode $ PngGamma g
     Met.Title       :=> tx -> txt "Title" (L.pack tx)

src/Codec/Picture/Tga.hs

@@ -47,7 +47,9 @@ import qualified Data.Vector.Storable.Mutable as M
 
 import Codec.Picture.Types
 import Codec.Picture.InternalHelper
-import Codec.Picture.Metadata( Metadatas, mkSizeMetadata )
+import Codec.Picture.Metadata( Metadatas
+                             , SourceFormat( SourceTGA )
+                             , basicMetadata )
 import Codec.Picture.VectorByteConversion
 
 data TgaColorMapType
@@ -284,7 +286,7 @@ unparse file =
       unpacker | isRleEncoded imageType = unpackRLETga
                | otherwise = unpackUncompressedTga
 
-      metas = mkSizeMetadata (_tgaHdrWidth hdr) (_tgaHdrHeight hdr)
+      metas = basicMetadata SourceTGA (_tgaHdrWidth hdr) (_tgaHdrHeight hdr)
       decodedPalette = unparse file
         { _tgaFileHeader = hdr
             { _tgaHdrHeight = 1

src/Codec/Picture/Tiff/Metadata.hs

@@ -17,7 +17,7 @@ import Codec.Picture.Tiff.Types
 import Codec.Picture.Metadata.Exif
 
 extractTiffStringMetadata :: [ImageFileDirectory] -> Metadatas
-extractTiffStringMetadata = foldMap go where
+extractTiffStringMetadata = Met.insert Met.Format Met.SourceTiff . foldMap go where
   strMeta k = Met.singleton k . B.unpack
   exif ifd =
     Met.singleton (Met.Exif $ ifdIdentifier ifd) $ ifdExtended ifd