{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
-- | This module expose a common "metadata" storage for various image

-- type. Different format can generate different metadatas, and write

-- only a part of them.

--

-- Since version 3.2.5

--

module Codec.Picture.Metadata( -- * Types

                               Metadatas
                             , Keys( .. )
                             , Value( .. )
                             , Elem( .. )
                             , SourceFormat( .. )
                             , ColorSpace( .. )

                               -- * Functions

                             , Codec.Picture.Metadata.lookup
                             , empty
                             , insert
                             , delete
                             , singleton

                               -- * Folding

                             , foldl'
                             , Codec.Picture.Metadata.foldMap

                              -- * Helper functions

                             , mkDpiMetadata
                             , mkSizeMetadata
                             , basicMetadata
                             , simpleMetadata
                             , extractExifMetas

                               -- * Conversion functions

                             , dotsPerMeterToDotPerInch
                             , dotPerInchToDotsPerMeter 
                             , dotsPerCentiMeterToDotPerInch
                             ) where

import Prelude hiding (Foldable(..))

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid( Monoid, mempty, mappend )
import Data.Word( Word )
#endif


import Control.DeepSeq( NFData( .. ) )
import qualified Data.ByteString as B
import qualified Data.Foldable as F

import Codec.Picture.Metadata.Exif

#if MIN_VERSION_base(4,7,0)
import Data.Typeable( (:~:)( Refl ) )
type Equiv = (:~:)
#else
data Equiv a b where
    Refl :: Equiv a a
#endif

-- | Type describing the original file format of the file.

data SourceFormat
  = SourceJpeg
  | SourceGif
  | SourceBitmap
  | SourceTiff
  | SourcePng
  | SourceHDR
  | SourceTGA
  deriving (SourceFormat -> SourceFormat -> Bool
(SourceFormat -> SourceFormat -> Bool)
-> (SourceFormat -> SourceFormat -> Bool) -> Eq SourceFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceFormat -> SourceFormat -> Bool
== :: SourceFormat -> SourceFormat -> Bool
$c/= :: SourceFormat -> SourceFormat -> Bool
/= :: SourceFormat -> SourceFormat -> Bool
Eq, Int -> SourceFormat -> ShowS
[SourceFormat] -> ShowS
SourceFormat -> String
(Int -> SourceFormat -> ShowS)
-> (SourceFormat -> String)
-> ([SourceFormat] -> ShowS)
-> Show SourceFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceFormat -> ShowS
showsPrec :: Int -> SourceFormat -> ShowS
$cshow :: SourceFormat -> String
show :: SourceFormat -> String
$cshowList :: [SourceFormat] -> ShowS
showList :: [SourceFormat] -> ShowS
Show)

instance NFData SourceFormat where
  rnf :: SourceFormat -> ()
rnf SourceFormat
a = SourceFormat
a SourceFormat -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | The same color values may result in slightly different colors on different

-- devices. To get consistent colors accross multiple devices we need a way of

-- mapping color values from a source device into their equivalents on the

-- target device.

--

-- The solution is essentially to define, for each device, a family of mappings

-- that convert between device colors and standard CIEXYZ or CIELAB colors. The

-- collection of mappings for a device is known as the 'color-profile' of that

-- device, and each color-profile can be thought of as describing a

-- 'color-space'.

--

-- If we know the color-space of the input pixels, and the color space of the

-- output device, then we can convert the colors in the image to their

-- equivalents on the output device.

--

-- JuicyPixels does not parse color-profiles or attempt to perform color

-- correction.

--

-- The following color space types are recognised:

--

--   * sRGB: Standard RGB color space.

--   * Windows BMP color space: Color space information embedded within a V4

--         Windows BMP file.

--   * ICC profile: An ICC color profile.

data ColorSpace = SRGB
                | WindowsBitmapColorSpace !B.ByteString
                | ICCProfile !B.ByteString
                deriving (ColorSpace -> ColorSpace -> Bool
(ColorSpace -> ColorSpace -> Bool)
-> (ColorSpace -> ColorSpace -> Bool) -> Eq ColorSpace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorSpace -> ColorSpace -> Bool
== :: ColorSpace -> ColorSpace -> Bool
$c/= :: ColorSpace -> ColorSpace -> Bool
/= :: ColorSpace -> ColorSpace -> Bool
Eq, Int -> ColorSpace -> ShowS
[ColorSpace] -> ShowS
ColorSpace -> String
(Int -> ColorSpace -> ShowS)
-> (ColorSpace -> String)
-> ([ColorSpace] -> ShowS)
-> Show ColorSpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColorSpace -> ShowS
showsPrec :: Int -> ColorSpace -> ShowS
$cshow :: ColorSpace -> String
show :: ColorSpace -> String
$cshowList :: [ColorSpace] -> ShowS
showList :: [ColorSpace] -> ShowS
Show)

instance NFData ColorSpace where
  rnf :: ColorSpace -> ()
rnf ColorSpace
v = ColorSpace
v ColorSpace -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Store various additional information about an image. If

-- something is not recognized, it can be stored in an unknown tag.

--

--   * 'DpiX' Dot per inch on this x axis.

--

--   * 'DpiY' Dot per inch on this y axis.

--

--   * 'Width' Image width in pixel. Relying on the metadata for this

--          information can avoid the full decompression of the image.

--          Ignored for image writing.

--

--   * 'Height' Image height in pixels. Relying on the metadata for this

--          information can void the full decompression of the image.

--          Ignored for image writing.

--

--   * 'ColorProfile' An unparsed ICC color profile. Currently only supported by

--          the Bitmap format.

--

--   * 'Unknown' unlikely to be decoded, but usefull for metadata writing

--

--   * 'Exif' Exif tag and associated data.

--

data Keys a where
  Gamma       :: Keys Double
  ColorSpace  :: Keys ColorSpace
  Format      :: Keys SourceFormat
  DpiX        :: Keys Word
  DpiY        :: Keys Word
  Width       :: Keys Word
  Height      :: Keys Word
  Title       :: Keys String
  Description :: Keys String
  Author      :: Keys String
  Copyright   :: Keys String
  Software    :: Keys String
  Comment     :: Keys String
  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)-}

-- | Encode values for unknown information

data Value
  = Int    !Int
  | Double !Double
  | String !String
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

instance NFData Value where
  rnf :: Value -> ()
rnf Value
v = Value
v Value -> () -> ()
forall a b. a -> b -> b
`seq` () -- everything is strict, so it's OK


-- | Element describing a metadata and it's (typed) associated

-- value.

data Elem k =
  forall a. (Show a, NFData a) => !(k a) :=> a

deriving instance Show (Elem Keys)

instance NFData (Elem Keys) where
  rnf :: Elem Keys -> ()
rnf (Keys a
_ :=> a
v) = a -> ()
forall a. NFData a => a -> ()
rnf a
v () -> () -> ()
forall a b. a -> b -> b
`seq` ()

keyEq :: Keys a -> Keys b -> Maybe (Equiv a b)
keyEq :: forall a b. Keys a -> Keys b -> Maybe (Equiv a b)
keyEq Keys a
a Keys b
b = case (Keys a
a, Keys b
b) of
  (Keys a
Gamma, Keys b
Gamma) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
ColorSpace, Keys b
ColorSpace) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
DpiX, Keys b
DpiX) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
DpiY, Keys b
DpiY) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Width, Keys b
Width) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Height, Keys b
Height) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Title, Keys b
Title) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Description, Keys b
Description) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Author, Keys b
Author) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Copyright, Keys b
Copyright) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Software, Keys b
Software) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Comment, Keys b
Comment) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Disclaimer, Keys b
Disclaimer) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Source, Keys b
Source) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Warning, Keys b
Warning) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a
Format, Keys b
Format) -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Unknown String
v1, Unknown String
v2) | String
v1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v2 -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Exif ExifTag
t1, Exif ExifTag
t2) | ExifTag
t1 ExifTag -> ExifTag -> Bool
forall a. Eq a => a -> a -> Bool
== ExifTag
t2 -> Equiv a b -> Maybe (Equiv a b)
forall a. a -> Maybe a
Just a :~: a
Equiv a b
forall {k} (a :: k). a :~: a
Refl
  (Keys a, Keys b)
_ -> Maybe (Equiv a b)
forall a. Maybe a
Nothing

-- | Dependent storage used for metadatas.

-- All metadatas of a given kind are unique within

-- this container.

    --

-- The current data structure is based on list,

-- so bad performances can be expected.

newtype Metadatas = Metadatas
  { Metadatas -> [Elem Keys]
getMetadatas :: [Elem Keys]
  }
  deriving (Int -> Metadatas -> ShowS
[Metadatas] -> ShowS
Metadatas -> String
(Int -> Metadatas -> ShowS)
-> (Metadatas -> String)
-> ([Metadatas] -> ShowS)
-> Show Metadatas
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadatas -> ShowS
showsPrec :: Int -> Metadatas -> ShowS
$cshow :: Metadatas -> String
show :: Metadatas -> String
$cshowList :: [Metadatas] -> ShowS
showList :: [Metadatas] -> ShowS
Show, Metadatas -> ()
(Metadatas -> ()) -> NFData Metadatas
forall a. (a -> ()) -> NFData a
$crnf :: Metadatas -> ()
rnf :: Metadatas -> ()
NFData)

instance Monoid Metadatas where
  mempty :: Metadatas
mempty = Metadatas
empty
#if !MIN_VERSION_base(4,11,0)
  mappend = union
#else
instance Semigroup Metadatas where
  <> :: Metadatas -> Metadatas -> Metadatas
(<>) = Metadatas -> Metadatas -> Metadatas
union
#endif

-- | Right based union

union :: Metadatas -> Metadatas -> Metadatas
union :: Metadatas -> Metadatas -> Metadatas
union Metadatas
m1 = (Metadatas -> Elem Keys -> Metadatas)
-> Metadatas -> [Elem Keys] -> Metadatas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Metadatas -> Elem Keys -> Metadatas
go Metadatas
m1 ([Elem Keys] -> Metadatas)
-> (Metadatas -> [Elem Keys]) -> Metadatas -> Metadatas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadatas -> [Elem Keys]
getMetadatas where
  go :: Metadatas -> Elem Keys -> Metadatas
go Metadatas
acc el :: Elem Keys
el@(Keys a
k :=> a
_) = [Elem Keys] -> Metadatas
Metadatas ([Elem Keys] -> Metadatas) -> [Elem Keys] -> Metadatas
forall a b. (a -> b) -> a -> b
$ Elem Keys
el Elem Keys -> [Elem Keys] -> [Elem Keys]
forall a. a -> [a] -> [a]
: Metadatas -> [Elem Keys]
getMetadatas (Keys a -> Metadatas -> Metadatas
forall a. Keys a -> Metadatas -> Metadatas
delete Keys a
k Metadatas
acc)

-- | Strict left fold of the metadatas

foldl' :: (acc -> Elem Keys -> acc) -> acc -> Metadatas -> acc
foldl' :: forall acc. (acc -> Elem Keys -> acc) -> acc -> Metadatas -> acc
foldl' acc -> Elem Keys -> acc
f acc
initAcc = (acc -> Elem Keys -> acc) -> acc -> [Elem Keys] -> acc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' acc -> Elem Keys -> acc
f acc
initAcc ([Elem Keys] -> acc)
-> (Metadatas -> [Elem Keys]) -> Metadatas -> acc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadatas -> [Elem Keys]
getMetadatas

-- | foldMap equivalent for metadatas.

foldMap :: Monoid m => (Elem Keys -> m) -> Metadatas -> m
foldMap :: forall m. Monoid m => (Elem Keys -> m) -> Metadatas -> m
foldMap Elem Keys -> m
f = (m -> Elem Keys -> m) -> m -> Metadatas -> m
forall acc. (acc -> Elem Keys -> acc) -> acc -> Metadatas -> acc
foldl' (\m
acc Elem Keys
v -> m
acc m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Elem Keys -> m
f Elem Keys
v) m
forall a. Monoid a => a
mempty

-- | Remove an element of the given keys from the metadatas.

-- If not present does nothing.

delete :: Keys a -> Metadatas -> Metadatas
delete :: forall a. Keys a -> Metadatas -> Metadatas
delete Keys a
k = [Elem Keys] -> Metadatas
Metadatas ([Elem Keys] -> Metadatas)
-> (Metadatas -> [Elem Keys]) -> Metadatas -> Metadatas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Elem Keys] -> [Elem Keys]
go ([Elem Keys] -> [Elem Keys])
-> (Metadatas -> [Elem Keys]) -> Metadatas -> [Elem Keys]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadatas -> [Elem Keys]
getMetadatas where
  go :: [Elem Keys] -> [Elem Keys]
go [] = []
  go (el :: Elem Keys
el@(Keys a
k2 :=> a
_) : [Elem Keys]
rest) = case Keys a -> Keys a -> Maybe (Equiv a a)
forall a b. Keys a -> Keys b -> Maybe (Equiv a b)
keyEq Keys a
k Keys a
k2 of
    Maybe (Equiv a a)
Nothing -> Elem Keys
el Elem Keys -> [Elem Keys] -> [Elem Keys]
forall a. a -> [a] -> [a]
: [Elem Keys] -> [Elem Keys]
go [Elem Keys]
rest
    Just Equiv a a
Refl -> [Elem Keys]
rest

-- | Extract all Exif specific metadatas

extractExifMetas :: Metadatas -> [(ExifTag, ExifData)]
extractExifMetas :: Metadatas -> [(ExifTag, ExifData)]
extractExifMetas = [Elem Keys] -> [(ExifTag, ExifData)]
go ([Elem Keys] -> [(ExifTag, ExifData)])
-> (Metadatas -> [Elem Keys]) -> Metadatas -> [(ExifTag, ExifData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadatas -> [Elem Keys]
getMetadatas where
  go :: [Elem Keys] -> [(ExifTag, ExifData)]
  go :: [Elem Keys] -> [(ExifTag, ExifData)]
go [] = []
  go ((Keys a
k :=> a
v) : [Elem Keys]
rest) =
    case Keys a
k of
      Exif ExifTag
t -> (ExifTag
t, a
ExifData
v) (ExifTag, ExifData)
-> [(ExifTag, ExifData)] -> [(ExifTag, ExifData)]
forall a. a -> [a] -> [a]
: [Elem Keys] -> [(ExifTag, ExifData)]
go [Elem Keys]
rest
      Keys a
_ -> [Elem Keys] -> [(ExifTag, ExifData)]
go [Elem Keys]
rest

-- | Search a metadata with the given key.

lookup :: Keys a -> Metadatas -> Maybe a
lookup :: forall a. Keys a -> Metadatas -> Maybe a
lookup Keys a
k = [Elem Keys] -> Maybe a
go ([Elem Keys] -> Maybe a)
-> (Metadatas -> [Elem Keys]) -> Metadatas -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadatas -> [Elem Keys]
getMetadatas where
  go :: [Elem Keys] -> Maybe a
go [] = Maybe a
forall a. Maybe a
Nothing
  go ((Keys a
k2 :=> a
v) : [Elem Keys]
rest) = case Keys a -> Keys a -> Maybe (Equiv a a)
forall a b. Keys a -> Keys b -> Maybe (Equiv a b)
keyEq Keys a
k Keys a
k2 of
    Maybe (Equiv a a)
Nothing -> [Elem Keys] -> Maybe a
go [Elem Keys]
rest
    Just Equiv a a
Refl -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
v

-- | Insert an element in the metadatas, if an element with

-- the same key is present, it is overwritten.

insert :: (Show a, NFData a) => Keys a -> a -> Metadatas -> Metadatas
insert :: forall a.
(Show a, NFData a) =>
Keys a -> a -> Metadatas -> Metadatas
insert Keys a
k a
val Metadatas
metas =
  [Elem Keys] -> Metadatas
Metadatas ([Elem Keys] -> Metadatas) -> [Elem Keys] -> Metadatas
forall a b. (a -> b) -> a -> b
$ (Keys a
k Keys a -> a -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> a
val) Elem Keys -> [Elem Keys] -> [Elem Keys]
forall a. a -> [a] -> [a]
: Metadatas -> [Elem Keys]
getMetadatas (Keys a -> Metadatas -> Metadatas
forall a. Keys a -> Metadatas -> Metadatas
delete Keys a
k Metadatas
metas)

-- | Create metadatas with a single element.

singleton :: (Show a, NFData a) => Keys a -> a -> Metadatas
singleton :: forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
singleton Keys a
k a
val = [Elem Keys] -> Metadatas
Metadatas [Keys a
k Keys a -> a -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> a
val]

-- | Empty metadatas. Favor 'mempty'

empty :: Metadatas
empty :: Metadatas
empty = [Elem Keys] -> Metadatas
Metadatas [Elem Keys]
forall a. Monoid a => a
mempty

-- | Conversion from dpm to dpi

dotsPerMeterToDotPerInch :: Word -> Word
dotsPerMeterToDotPerInch :: Word -> Word
dotsPerMeterToDotPerInch Word
z = Word
z Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
254 Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
10000

-- | Conversion from dpi to dpm

dotPerInchToDotsPerMeter :: Word -> Word
dotPerInchToDotsPerMeter :: Word -> Word
dotPerInchToDotsPerMeter Word
z = (Word
z Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
10000) Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
254

-- | Conversion dpcm -> dpi

dotsPerCentiMeterToDotPerInch :: Word -> Word
dotsPerCentiMeterToDotPerInch :: Word -> Word
dotsPerCentiMeterToDotPerInch Word
z = Word
z Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
254 Word -> Word -> Word
forall a. Integral a => a -> a -> a
`div` Word
100

-- | Create metadatas indicating the resolution, with DpiX == DpiY

mkDpiMetadata :: Word -> Metadatas
mkDpiMetadata :: Word -> Metadatas
mkDpiMetadata Word
w =
  [Elem Keys] -> Metadatas
Metadatas [Keys Word
DpiY Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> Word
w, Keys Word
DpiX Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> Word
w]

-- | Create metadatas holding width and height information.

mkSizeMetadata :: Integral n => n -> n -> Metadatas
mkSizeMetadata :: forall n. Integral n => n -> n -> Metadatas
mkSizeMetadata n
w n
h = 
  [Elem Keys] -> Metadatas
Metadatas [ Keys Word
Width Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> n -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
w, Keys Word
Height Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> n -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
h ]

-- | Create simple metadatas with Format, Width & Height

basicMetadata :: Integral nSize => SourceFormat -> nSize -> nSize -> Metadatas
basicMetadata :: forall nSize.
Integral nSize =>
SourceFormat -> nSize -> nSize -> Metadatas
basicMetadata SourceFormat
f nSize
w nSize
h =
  [Elem Keys] -> Metadatas
Metadatas [ Keys SourceFormat
Format Keys SourceFormat -> SourceFormat -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> SourceFormat
f
            , Keys Word
Width Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> nSize -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral nSize
w
            , Keys Word
Height Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> nSize -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral nSize
h
            ]

-- | Create simple metadatas with Format, Width, Height, DpiX & DpiY

simpleMetadata :: (Integral nSize, Integral nDpi)
               => SourceFormat -> nSize -> nSize -> nDpi -> nDpi -> Metadatas
simpleMetadata :: forall nSize nDpi.
(Integral nSize, Integral nDpi) =>
SourceFormat -> nSize -> nSize -> nDpi -> nDpi -> Metadatas
simpleMetadata SourceFormat
f nSize
w nSize
h nDpi
dpiX nDpi
dpiY =
  [Elem Keys] -> Metadatas
Metadatas [ Keys SourceFormat
Format Keys SourceFormat -> SourceFormat -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> SourceFormat
f
            , Keys Word
Width Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> nSize -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral nSize
w
            , Keys Word
Height Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> nSize -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral nSize
h
            , Keys Word
DpiX Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> nDpi -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral nDpi
dpiX
            , Keys Word
DpiY Keys Word -> Word -> Elem Keys
forall (k :: * -> *) a. (Show a, NFData a) => k a -> a -> Elem k
:=> nDpi -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral nDpi
dpiY
            ]