{-# LANGUAGE CPP #-}
module Codec.Picture.Tiff.Metadata( extractTiffMetadata ) where

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid( mempty )
import Data.Foldable( foldMap )
import Control.Applicative( (<$>) )
#endif

import Data.Foldable( find )
import qualified Data.Foldable as F
import Data.Monoid( (<>) )
import Codec.Picture.Metadata( Metadatas )
import qualified Data.ByteString.Char8 as B
import qualified Codec.Picture.Metadata as Met
import Codec.Picture.Tiff.Types
import Codec.Picture.Metadata.Exif

extractTiffStringMetadata :: [ImageFileDirectory] -> Metadatas
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
  inserter acc (k, v) = Met.insert (Met.Exif k) v acc

  go ifd = case (ifdIdentifier ifd, ifdExtended ifd) of
    (TagUnknown _, _) -> exif ifd
    (TagCopyright, ExifString v) -> strMeta Met.Copyright v
    (TagArtist, ExifString v) -> strMeta Met.Author v
    (TagDocumentName, ExifString v) -> strMeta Met.Title v
    (TagSoftware, ExifString v) -> strMeta Met.Software v
    (TagImageDescription, ExifString v) -> strMeta Met.Description v
    (TagCompression, _) -> mempty
    (TagImageWidth, _) -> Met.singleton Met.Width . fromIntegral $ ifdOffset ifd
    (TagImageLength, _) -> Met.singleton Met.Height . fromIntegral $ ifdOffset ifd
    (TagXResolution, _) -> mempty
    (TagYResolution, _) -> mempty
    (TagResolutionUnit, _) -> mempty
    (TagRowPerStrip, _) -> mempty
    (TagStripByteCounts, _) -> mempty
    (TagStripOffsets, _) -> mempty
    (TagBitsPerSample, _) -> mempty
    (TagColorMap, _) -> mempty
    (TagTileWidth, _) -> mempty
    (TagTileLength, _) -> mempty
    (TagTileOffset, _) -> mempty
    (TagTileByteCount, _) -> mempty
    (TagSamplesPerPixel, _) -> mempty
    (TagYCbCrCoeff, _) -> mempty
    (TagYCbCrSubsampling, _) -> mempty
    (TagYCbCrPositioning, _) -> mempty
    (TagJpegProc, _) -> mempty
    (TagJPEGInterchangeFormat, _) -> mempty
    (TagJPEGInterchangeFormatLength, _) -> mempty
    (TagJPEGRestartInterval, _) -> mempty
    (TagJPEGLosslessPredictors, _) -> mempty
    (TagJPEGPointTransforms, _) -> mempty
    (TagJPEGQTables, _) -> mempty
    (TagJPEGDCTables, _) -> mempty
    (TagJPEGACTables, _) -> mempty
    (TagExifOffset, ExifIFD lst) -> F.foldl' inserter mempty lst
    _ -> mempty

byTag :: ExifTag -> ImageFileDirectory -> Bool
byTag t ifd = ifdIdentifier ifd == t

data TiffResolutionUnit
  = ResolutionUnitUnknown
  | ResolutionUnitInch
  | ResolutionUnitCentimeter

unitOfIfd :: ImageFileDirectory -> TiffResolutionUnit
unitOfIfd ifd = case (ifdType ifd, ifdOffset ifd) of
  (TypeShort, 1) -> ResolutionUnitUnknown
  (TypeShort, 2) -> ResolutionUnitInch
  (TypeShort, 3) -> ResolutionUnitCentimeter
  _ -> ResolutionUnitUnknown

extractTiffDpiMetadata :: [ImageFileDirectory] -> Metadatas
extractTiffDpiMetadata lst = go where
  go = case unitOfIfd <$> find (byTag TagResolutionUnit) lst of
    Nothing -> mempty
    Just ResolutionUnitUnknown -> mempty
    Just ResolutionUnitCentimeter -> findDpis Met.dotsPerCentiMeterToDotPerInch mempty
    Just ResolutionUnitInch -> findDpis id mempty

  findDpis toDpi =
     findDpi Met.DpiX TagXResolution toDpi . findDpi Met.DpiY TagYResolution toDpi

  findDpi k tag toDpi metas = case find (byTag tag) lst of
    Nothing -> metas
    Just ImageFileDirectory { ifdExtended = ExifRational num den } ->
      Met.insert k (toDpi . fromIntegral $ num `div` den) metas
    Just _ -> metas

extractTiffMetadata :: [ImageFileDirectory] -> Metadatas
extractTiffMetadata lst = extractTiffDpiMetadata lst <> extractTiffStringMetadata lst