{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Module      : Data.Massiv.Array.IO.Image.JuicyPixels.BMP
-- Copyright   : (c) Alexey Kuleshevich 2019-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Massiv.Array.IO.Image.JuicyPixels.BMP
  ( BMP(..)
  , BitmapOptions(..)
  , decodeBMP
  , decodeWithMetadataBMP
  , decodeAutoBMP
  , decodeAutoWithMetadataBMP
  , encodeBMP
  , encodeAutoBMP
  ) where

import qualified Codec.Picture as JP
import qualified Codec.Picture.Bitmap as JP
import qualified Codec.Picture.Metadata as JP
import Control.Monad (msum)
import Data.Bifunctor (first)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL (ByteString)
import Data.Massiv.Array as A
import Data.Massiv.Array.IO.Base
import Data.Massiv.Array.IO.Image.JuicyPixels.Base
import Data.Maybe (fromMaybe)
import Data.Typeable
import qualified Graphics.Pixel as CM
import Graphics.Pixel.ColorSpace
import Prelude as P

--------------------------------------------------------------------------------
-- BMP Format ------------------------------------------------------------------
--------------------------------------------------------------------------------

newtype BitmapOptions = BitmapOptions
  { BitmapOptions -> Metadatas
bitmapMetadata :: JP.Metadatas
  } deriving (Int -> BitmapOptions -> ShowS
[BitmapOptions] -> ShowS
BitmapOptions -> String
(Int -> BitmapOptions -> ShowS)
-> (BitmapOptions -> String)
-> ([BitmapOptions] -> ShowS)
-> Show BitmapOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitmapOptions] -> ShowS
$cshowList :: [BitmapOptions] -> ShowS
show :: BitmapOptions -> String
$cshow :: BitmapOptions -> String
showsPrec :: Int -> BitmapOptions -> ShowS
$cshowsPrec :: Int -> BitmapOptions -> ShowS
Show)

instance Default BitmapOptions where
  def :: BitmapOptions
def = Metadatas -> BitmapOptions
BitmapOptions Metadatas
forall a. Monoid a => a
mempty

-- | Bitmap image with @.bmp@ extension.
data BMP = BMP deriving Int -> BMP -> ShowS
[BMP] -> ShowS
BMP -> String
(Int -> BMP -> ShowS)
-> (BMP -> String) -> ([BMP] -> ShowS) -> Show BMP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BMP] -> ShowS
$cshowList :: [BMP] -> ShowS
show :: BMP -> String
$cshow :: BMP -> String
showsPrec :: Int -> BMP -> ShowS
$cshowsPrec :: Int -> BMP -> ShowS
Show

instance FileFormat BMP where
  type WriteOptions BMP = BitmapOptions
  type Metadata BMP = JP.Metadatas

  ext :: BMP -> String
ext BMP
_ = String
".bmp"

instance Writable BMP (Image A.S CM.X Bit) where
  encodeM :: BMP -> WriteOptions BMP -> Image S X Bit -> m ByteString
encodeM BMP
f WriteOptions BMP
opts Image S X Bit
img = BMP
-> WriteOptions BMP -> Array S Ix2 (Pixel X Word8) -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM BMP
f WriteOptions BMP
opts (Image S X Bit -> Array S Ix2 (Pixel X Word8)
coerceBinaryImage Image S X Bit
img)

instance Writable BMP (Image S CM.X Word8) where
  encodeM :: BMP
-> WriteOptions BMP -> Array S Ix2 (Pixel X Word8) -> m ByteString
encodeM BMP
BMP BitmapOptions {bitmapMetadata} =
    ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Array S Ix2 (Pixel X Word8) -> ByteString)
-> Array S Ix2 (Pixel X Word8)
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadatas -> Image Word8 -> ByteString
forall pixel.
BmpEncodable pixel =>
Metadatas -> Image pixel -> ByteString
JP.encodeBitmapWithMetadata Metadatas
bitmapMetadata (Image Word8 -> ByteString)
-> (Array S Ix2 (Pixel X Word8) -> Image Word8)
-> Array S Ix2 (Pixel X Word8)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array S Ix2 (Pixel X Word8) -> Image Word8
forall r.
Source r Ix2 (Pixel X Word8) =>
Image r X Word8 -> Image Word8
toJPImageY8

instance Writable BMP (Image S CM.RGB Word8) where
  encodeM :: BMP -> WriteOptions BMP -> Image S RGB Word8 -> m ByteString
encodeM BMP
BMP BitmapOptions {bitmapMetadata} =
    ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Image S RGB Word8 -> ByteString)
-> Image S RGB Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadatas -> Image PixelRGB8 -> ByteString
forall pixel.
BmpEncodable pixel =>
Metadatas -> Image pixel -> ByteString
JP.encodeBitmapWithMetadata Metadatas
bitmapMetadata (Image PixelRGB8 -> ByteString)
-> (Image S RGB Word8 -> Image PixelRGB8)
-> Image S RGB Word8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S RGB Word8 -> Image PixelRGB8
forall r.
Source r Ix2 (Pixel RGB Word8) =>
Image r RGB Word8 -> Image PixelRGB8
toJPImageRGB8

instance Writable BMP (Image S (Alpha CM.RGB) Word8) where
  encodeM :: BMP
-> WriteOptions BMP -> Image S (Alpha RGB) Word8 -> m ByteString
encodeM BMP
BMP BitmapOptions {bitmapMetadata} =
    ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Image S (Alpha RGB) Word8 -> ByteString)
-> Image S (Alpha RGB) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadatas -> Image PixelRGBA8 -> ByteString
forall pixel.
BmpEncodable pixel =>
Metadatas -> Image pixel -> ByteString
JP.encodeBitmapWithMetadata Metadatas
bitmapMetadata (Image PixelRGBA8 -> ByteString)
-> (Image S (Alpha RGB) Word8 -> Image PixelRGBA8)
-> Image S (Alpha RGB) Word8
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Alpha RGB) Word8 -> Image PixelRGBA8
forall r.
Source r Ix2 (Pixel (Alpha RGB) Word8) =>
Image r (Alpha RGB) Word8 -> Image PixelRGBA8
toJPImageRGBA8


instance Writable BMP (Image S (Y' SRGB) Word8) where
  encodeM :: BMP -> WriteOptions BMP -> Image S (Y' SRGB) Word8 -> m ByteString
encodeM BMP
f WriteOptions BMP
opts = BMP
-> WriteOptions BMP -> Array S Ix2 (Pixel X Word8) -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM BMP
f WriteOptions BMP
opts (Array S Ix2 (Pixel X Word8) -> m ByteString)
-> (Image S (Y' SRGB) Word8 -> Array S Ix2 (Pixel X Word8))
-> Image S (Y' SRGB) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y' SRGB) Word8 -> Array S Ix2 (Pixel X Word8)
forall cs e.
Array S Ix2 (Pixel cs e) -> Array S Ix2 (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable BMP (Image S (Y D65) Word8) where
  encodeM :: BMP -> WriteOptions BMP -> Image S (Y D65) Word8 -> m ByteString
encodeM BMP
f WriteOptions BMP
opts = BMP
-> WriteOptions BMP -> Array S Ix2 (Pixel X Word8) -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM BMP
f WriteOptions BMP
opts (Array S Ix2 (Pixel X Word8) -> m ByteString)
-> (Image S (Y D65) Word8 -> Array S Ix2 (Pixel X Word8))
-> Image S (Y D65) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Y D65) Word8 -> Array S Ix2 (Pixel X Word8)
forall cs e.
Array S Ix2 (Pixel cs e) -> Array S Ix2 (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable BMP (Image S (SRGB 'NonLinear) Word8) where
  encodeM :: BMP
-> WriteOptions BMP
-> Image S (SRGB 'NonLinear) Word8
-> m ByteString
encodeM BMP
f WriteOptions BMP
opts = BMP -> WriteOptions BMP -> Image S RGB Word8 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM BMP
f WriteOptions BMP
opts (Image S RGB Word8 -> m ByteString)
-> (Image S (SRGB 'NonLinear) Word8 -> Image S RGB Word8)
-> Image S (SRGB 'NonLinear) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (SRGB 'NonLinear) Word8 -> Image S RGB Word8
forall cs e.
Array S Ix2 (Pixel cs e) -> Array S Ix2 (Pixel (BaseModel cs) e)
toImageBaseModel

instance Writable BMP (Image S (Alpha (SRGB 'NonLinear)) Word8) where
  encodeM :: BMP
-> WriteOptions BMP
-> Image S (Alpha (SRGB 'NonLinear)) Word8
-> m ByteString
encodeM BMP
f WriteOptions BMP
opts = BMP
-> WriteOptions BMP -> Image S (Alpha RGB) Word8 -> m ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM BMP
f WriteOptions BMP
opts (Image S (Alpha RGB) Word8 -> m ByteString)
-> (Image S (Alpha (SRGB 'NonLinear)) Word8
    -> Image S (Alpha RGB) Word8)
-> Image S (Alpha (SRGB 'NonLinear)) Word8
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image S (Alpha (SRGB 'NonLinear)) Word8
-> Image S (Alpha RGB) Word8
forall cs e.
Array S Ix2 (Pixel cs e) -> Array S Ix2 (Pixel (BaseModel cs) e)
toImageBaseModel

instance (ColorSpace cs i e, ColorSpace (BaseSpace cs) i e, Source r Ix2 (Pixel cs e)) =>
         Writable (Auto BMP) (Image r cs e) where
  encodeM :: Auto BMP -> WriteOptions (Auto BMP) -> Image r cs e -> m ByteString
encodeM Auto BMP
f WriteOptions (Auto BMP)
opts = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Image r cs e -> ByteString) -> Image r cs e -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Auto BMP -> BitmapOptions -> Image r cs e -> ByteString
forall r cs i e.
(ColorSpace (BaseSpace cs) i e, ColorSpace cs i e,
 Source r Ix2 (Pixel cs e)) =>
Auto BMP -> BitmapOptions -> Image r cs e -> ByteString
encodeAutoBMP Auto BMP
f WriteOptions (Auto BMP)
BitmapOptions
opts

instance Readable BMP (Image S CM.X Word8) where
  decodeWithMetadataM :: BMP -> ByteString -> m (Array S Ix2 (Pixel X Word8), Metadata BMP)
decodeWithMetadataM = BMP -> ByteString -> m (Array S Ix2 (Pixel X Word8), Metadata BMP)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
BMP -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataBMP

instance Readable BMP (Image S CM.RGB Word8) where
  decodeWithMetadataM :: BMP -> ByteString -> m (Image S RGB Word8, Metadata BMP)
decodeWithMetadataM = BMP -> ByteString -> m (Image S RGB Word8, Metadata BMP)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
BMP -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataBMP

instance Readable BMP (Image S (Alpha CM.RGB) Word8) where
  decodeWithMetadataM :: BMP -> ByteString -> m (Image S (Alpha RGB) Word8, Metadata BMP)
decodeWithMetadataM = BMP -> ByteString -> m (Image S (Alpha RGB) Word8, Metadata BMP)
forall cs e (m :: * -> *).
(ColorModel cs e, MonadThrow m) =>
BMP -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataBMP

instance Readable BMP (Image S (Y' SRGB) Word8) where
  decodeWithMetadataM :: BMP -> ByteString -> m (Image S (Y' SRGB) Word8, Metadata BMP)
decodeWithMetadataM BMP
f = ((Array S Ix2 (Pixel X Word8), Metadatas)
 -> (Image S (Y' SRGB) Word8, Metadatas))
-> m (Array S Ix2 (Pixel X Word8), Metadatas)
-> m (Image S (Y' SRGB) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Array S Ix2 (Pixel X Word8) -> Image S (Y' SRGB) Word8)
-> (Array S Ix2 (Pixel X Word8), Metadatas)
-> (Image S (Y' SRGB) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Array S Ix2 (Pixel X Word8) -> Image S (Y' SRGB) Word8
forall cs e.
Array S Ix2 (Pixel (BaseModel cs) e) -> Array S Ix2 (Pixel cs e)
fromImageBaseModel) (m (Array S Ix2 (Pixel X Word8), Metadatas)
 -> m (Image S (Y' SRGB) Word8, Metadatas))
-> (ByteString -> m (Array S Ix2 (Pixel X Word8), Metadatas))
-> ByteString
-> m (Image S (Y' SRGB) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BMP -> ByteString -> m (Array S Ix2 (Pixel X Word8), Metadata BMP)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM BMP
f

instance Readable BMP (Image S (Y D65) Word8) where
  decodeWithMetadataM :: BMP -> ByteString -> m (Image S (Y D65) Word8, Metadata BMP)
decodeWithMetadataM BMP
f = ((Array S Ix2 (Pixel X Word8), Metadatas)
 -> (Image S (Y D65) Word8, Metadatas))
-> m (Array S Ix2 (Pixel X Word8), Metadatas)
-> m (Image S (Y D65) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Array S Ix2 (Pixel X Word8) -> Image S (Y D65) Word8)
-> (Array S Ix2 (Pixel X Word8), Metadatas)
-> (Image S (Y D65) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Array S Ix2 (Pixel X Word8) -> Image S (Y D65) Word8
forall cs e.
Array S Ix2 (Pixel (BaseModel cs) e) -> Array S Ix2 (Pixel cs e)
fromImageBaseModel) (m (Array S Ix2 (Pixel X Word8), Metadatas)
 -> m (Image S (Y D65) Word8, Metadatas))
-> (ByteString -> m (Array S Ix2 (Pixel X Word8), Metadatas))
-> ByteString
-> m (Image S (Y D65) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BMP -> ByteString -> m (Array S Ix2 (Pixel X Word8), Metadata BMP)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM BMP
f

instance Readable BMP (Image S (SRGB 'NonLinear) Word8) where
  decodeWithMetadataM :: BMP
-> ByteString -> m (Image S (SRGB 'NonLinear) Word8, Metadata BMP)
decodeWithMetadataM BMP
f = ((Image S RGB Word8, Metadatas)
 -> (Image S (SRGB 'NonLinear) Word8, Metadatas))
-> m (Image S RGB Word8, Metadatas)
-> m (Image S (SRGB 'NonLinear) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S RGB Word8 -> Image S (SRGB 'NonLinear) Word8)
-> (Image S RGB Word8, Metadatas)
-> (Image S (SRGB 'NonLinear) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S RGB Word8 -> Image S (SRGB 'NonLinear) Word8
forall cs e.
Array S Ix2 (Pixel (BaseModel cs) e) -> Array S Ix2 (Pixel cs e)
fromImageBaseModel) (m (Image S RGB Word8, Metadatas)
 -> m (Image S (SRGB 'NonLinear) Word8, Metadatas))
-> (ByteString -> m (Image S RGB Word8, Metadatas))
-> ByteString
-> m (Image S (SRGB 'NonLinear) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BMP -> ByteString -> m (Image S RGB Word8, Metadata BMP)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM BMP
f

instance Readable BMP (Image S (Alpha (SRGB 'NonLinear)) Word8) where
  decodeWithMetadataM :: BMP
-> ByteString
-> m (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadata BMP)
decodeWithMetadataM BMP
f = ((Image S (Alpha RGB) Word8, Metadatas)
 -> (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas))
-> m (Image S (Alpha RGB) Word8, Metadatas)
-> m (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Image S (Alpha RGB) Word8
 -> Image S (Alpha (SRGB 'NonLinear)) Word8)
-> (Image S (Alpha RGB) Word8, Metadatas)
-> (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Image S (Alpha RGB) Word8
-> Image S (Alpha (SRGB 'NonLinear)) Word8
forall cs e.
Array S Ix2 (Pixel (BaseModel cs) e) -> Array S Ix2 (Pixel cs e)
fromImageBaseModel) (m (Image S (Alpha RGB) Word8, Metadatas)
 -> m (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas))
-> (ByteString -> m (Image S (Alpha RGB) Word8, Metadatas))
-> ByteString
-> m (Image S (Alpha (SRGB 'NonLinear)) Word8, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BMP -> ByteString -> m (Image S (Alpha RGB) Word8, Metadata BMP)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM BMP
f

-- | Decode a Bitmap Image
decodeBMP :: (ColorModel cs e, MonadThrow m) => BMP -> B.ByteString -> m (Image S cs e)
decodeBMP :: BMP -> ByteString -> m (Image S cs e)
decodeBMP BMP
f ByteString
bs = BMP -> Either String DynamicImage -> m (Image S cs e)
forall (m :: * -> *) cs e f.
(MonadThrow m, ColorModel cs e, FileFormat f) =>
f -> Either String DynamicImage -> m (Image S cs e)
convertWith BMP
f (ByteString -> Either String DynamicImage
JP.decodeBitmap ByteString
bs)

-- | Decode a Bitmap Image
decodeWithMetadataBMP ::
     (ColorModel cs e, MonadThrow m) => BMP -> B.ByteString -> m (Image S cs e, JP.Metadatas)
decodeWithMetadataBMP :: BMP -> ByteString -> m (Image S cs e, Metadatas)
decodeWithMetadataBMP BMP
f ByteString
bs = BMP
-> Either String (DynamicImage, Metadata BMP)
-> m (Image S cs e, Metadata BMP)
forall (m :: * -> *) cs e f.
(MonadThrow m, ColorModel cs e, FileFormat f) =>
f
-> Either String (DynamicImage, Metadata f)
-> m (Image S cs e, Metadata f)
convertWithMetadata BMP
f (ByteString -> Either String (DynamicImage, Metadatas)
JP.decodeBitmapWithMetadata ByteString
bs)


-- | Decode a Bitmap Image
decodeAutoBMP ::
     (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e, MonadThrow m)
  => Auto BMP
  -> B.ByteString
  -> m (Image r cs e)
decodeAutoBMP :: Auto BMP -> ByteString -> m (Image r cs e)
decodeAutoBMP Auto BMP
f ByteString
bs = Auto BMP -> Either String DynamicImage -> m (Image r cs e)
forall (m :: * -> *) r cs e i f.
(MonadThrow m, Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) =>
Auto f -> Either String DynamicImage -> m (Image r cs e)
convertAutoWith Auto BMP
f (ByteString -> Either String DynamicImage
JP.decodeBitmap ByteString
bs)

-- | Decode a Bitmap Image
decodeAutoWithMetadataBMP ::
     (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e, MonadThrow m)
  => Auto BMP
  -> B.ByteString
  -> m (Image r cs e, JP.Metadatas)
decodeAutoWithMetadataBMP :: Auto BMP -> ByteString -> m (Image r cs e, Metadatas)
decodeAutoWithMetadataBMP Auto BMP
f ByteString
bs = Auto BMP
-> Either String (DynamicImage, Metadata BMP)
-> m (Image r cs e, Metadata BMP)
forall (m :: * -> *) r cs e i f.
(MonadThrow m, Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) =>
Auto f
-> Either String (DynamicImage, Metadata f)
-> m (Image r cs e, Metadata f)
convertAutoWithMetadata Auto BMP
f (ByteString -> Either String (DynamicImage, Metadatas)
JP.decodeBitmapWithMetadata ByteString
bs)

instance (Mutable r Ix2 (Pixel cs e), ColorSpace cs i e) =>
         Readable (Auto BMP) (Image r cs e) where
  decodeM :: Auto BMP -> ByteString -> m (Image r cs e)
decodeM = Auto BMP -> ByteString -> m (Image r cs e)
forall r cs e i (m :: * -> *).
(Mutable r Ix2 (Pixel cs e), ColorSpace cs i e, MonadThrow m) =>
Auto BMP -> ByteString -> m (Image r cs e)
decodeAutoBMP
  decodeWithMetadataM :: Auto BMP -> ByteString -> m (Image r cs e, Metadata (Auto BMP))
decodeWithMetadataM = Auto BMP -> ByteString -> m (Image r cs e, Metadata (Auto BMP))
forall r cs e i (m :: * -> *).
(Mutable r Ix2 (Pixel cs e), ColorSpace cs i e, MonadThrow m) =>
Auto BMP -> ByteString -> m (Image r cs e, Metadatas)
decodeAutoWithMetadataBMP

encodeBMP ::
     forall cs e m. (ColorModel cs e, MonadThrow m)
  => BMP
  -> BitmapOptions
  -> Image S cs e
  -> m BL.ByteString
encodeBMP :: BMP -> BitmapOptions -> Image S cs e -> m ByteString
encodeBMP BMP
f opts :: BitmapOptions
opts@BitmapOptions {Metadatas
bitmapMetadata :: Metadatas
bitmapMetadata :: BitmapOptions -> Metadatas
bitmapMetadata} Image S cs e
img =
  BMP -> Proxy (Image S cs e) -> Maybe ByteString -> m ByteString
forall f r cs e b (m :: * -> *).
(ColorModel cs e, FileFormat f, Typeable r, MonadThrow m) =>
f -> Proxy (Image r cs e) -> Maybe b -> m b
fromMaybeEncode BMP
f (Proxy (Image S cs e)
forall k (t :: k). Proxy t
Proxy :: Proxy (Image S cs e)) Maybe ByteString
encoded
  where
    encoded :: Maybe ByteString
encoded
      | Just Pixel cs e :~: Pixel X Bit
Refl <- Maybe (Pixel cs e :~: Pixel X Bit)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (Pixel cs e :~: Pixel CM.X Bit) = BMP -> WriteOptions BMP -> Image S cs e -> Maybe ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM BMP
BMP WriteOptions BMP
BitmapOptions
opts Image S cs e
img
      | Just e :~: Word8
Refl <- Maybe (e :~: Word8)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Word8) = do
        [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ Metadatas -> Image Word8 -> ByteString
forall pixel.
BmpEncodable pixel =>
Metadatas -> Image pixel -> ByteString
JP.encodeBitmapWithMetadata Metadatas
bitmapMetadata (Image Word8 -> ByteString)
-> Maybe (Image Word8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word8 -> Maybe (Image Word8)
forall cs.
(Typeable cs, Source S Ix2 (Pixel cs Word8)) =>
Image S cs Word8 -> Maybe (Image Word8)
maybeJPImageY8 Image S cs e
Image S cs Word8
img
          , Metadatas -> Image PixelRGB8 -> ByteString
forall pixel.
BmpEncodable pixel =>
Metadatas -> Image pixel -> ByteString
JP.encodeBitmapWithMetadata Metadatas
bitmapMetadata (Image PixelRGB8 -> ByteString)
-> Maybe (Image PixelRGB8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S cs Word8 -> Maybe (Image PixelRGB8)
forall cs.
(Typeable cs, Source S Ix2 (Pixel cs Word8)) =>
Image S cs Word8 -> Maybe (Image PixelRGB8)
maybeJPImageRGB8 Image S cs e
Image S cs Word8
img
          , do cs :~: Alpha (Opaque cs)
Refl <- Maybe (cs :~: Alpha (Opaque cs))
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (cs :~: Alpha (Opaque cs))
               Metadatas -> Image PixelRGBA8 -> ByteString
forall pixel.
BmpEncodable pixel =>
Metadatas -> Image pixel -> ByteString
JP.encodeBitmapWithMetadata Metadatas
bitmapMetadata (Image PixelRGBA8 -> ByteString)
-> Maybe (Image PixelRGBA8) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image S (Alpha (Opaque cs)) Word8 -> Maybe (Image PixelRGBA8)
forall cs.
(Typeable cs, Source S Ix2 (Pixel (Alpha cs) Word8)) =>
Image S (Alpha cs) Word8 -> Maybe (Image PixelRGBA8)
maybeJPImageRGBA8 Image S cs e
Image S (Alpha (Opaque cs)) Word8
img
          ]
      | Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing



encodeAutoBMP ::
     forall r cs i e. (ColorSpace (BaseSpace cs) i e, ColorSpace cs i e, Source r Ix2 (Pixel cs e))
  => Auto BMP
  -> BitmapOptions
  -> Image r cs e
  -> BL.ByteString
encodeAutoBMP :: Auto BMP -> BitmapOptions -> Image r cs e -> ByteString
encodeAutoBMP Auto BMP
_ BitmapOptions {Metadatas
bitmapMetadata :: Metadatas
bitmapMetadata :: BitmapOptions -> Metadatas
bitmapMetadata} Image r cs e
img =
  ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ((Array D Ix2 (Pixel RGB Word8) -> Image PixelRGB8)
-> (Pixel cs e -> Pixel RGB Word8) -> Image r cs e -> ByteString
forall px ix a b.
(BmpEncodable px, Source r ix a) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toBitmap Array D Ix2 (Pixel RGB Word8) -> Image PixelRGB8
forall r.
Source r Ix2 (Pixel RGB Word8) =>
Image r RGB Word8 -> Image PixelRGB8
toJPImageRGB8 Pixel cs e -> Pixel RGB Word8
forall cs i e. ColorSpace cs i e => Pixel cs e -> Pixel RGB Word8
toSRGB8 Image r cs e
img) (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
    [ do BaseModel cs :~: X
Refl <- Maybe (BaseModel cs :~: X)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (BaseModel cs :~: CM.X)
         [Maybe ByteString] -> Maybe ByteString
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
           [ do e :~: Bit
Refl <- Maybe (e :~: Bit)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (e :~: Bit)
                ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel X Word8) -> Image Word8)
-> (Pixel cs e -> Pixel X Word8) -> Image r cs e -> ByteString
forall px ix a b.
(BmpEncodable px, Source r ix a) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toBitmap Array D Ix2 (Pixel X Word8) -> Image Word8
forall r.
Source r Ix2 (Pixel X Word8) =>
Image r X Word8 -> Image Word8
toJPImageY8 (Pixel X e -> Pixel X Word8
forall cs e. ColorModel cs e => Pixel cs e -> Pixel cs Word8
toPixel8 (Pixel X e -> Pixel X Word8)
-> (Pixel cs e -> Pixel X e) -> Pixel cs e -> Pixel X Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pixel cs e -> Pixel X e
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel) Image r cs e
img
           , ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel X Word8) -> Image Word8)
-> (Pixel cs e -> Pixel X Word8) -> Image r cs e -> ByteString
forall px ix a b.
(BmpEncodable px, Source r ix a) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toBitmap Array D Ix2 (Pixel X Word8) -> Image Word8
forall r.
Source r Ix2 (Pixel X Word8) =>
Image r X Word8 -> Image Word8
toJPImageY8 (Pixel X e -> Pixel X Word8
forall cs e. ColorModel cs e => Pixel cs e -> Pixel cs Word8
toPixel8 (Pixel X e -> Pixel X Word8)
-> (Pixel cs e -> Pixel X e) -> Pixel cs e -> Pixel X Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pixel cs e -> Pixel X e
forall k cs (i :: k) e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (BaseModel cs) e
toPixelBaseModel) Image r cs e
img
           ]
    , do cs :~: Alpha (Opaque cs)
Refl <- Maybe (cs :~: Alpha (Opaque cs))
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (cs :~: Alpha (Opaque cs))
         ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (Array D Ix2 (Pixel (Alpha RGB) Word8) -> Image PixelRGBA8)
-> (Pixel cs e -> Pixel (Alpha RGB) Word8)
-> Image r cs e
-> ByteString
forall px ix a b.
(BmpEncodable px, Source r ix a) =>
(Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toBitmap Array D Ix2 (Pixel (Alpha RGB) Word8) -> Image PixelRGBA8
forall r.
Source r Ix2 (Pixel (Alpha RGB) Word8) =>
Image r (Alpha RGB) Word8 -> Image PixelRGBA8
toJPImageRGBA8 Pixel cs e -> Pixel (Alpha RGB) Word8
forall cs i e.
ColorSpace cs i e =>
Pixel cs e -> Pixel (Alpha RGB) Word8
toSRGBA8 Image r cs e
img
    ]
  where
    toBitmap ::
         (JP.BmpEncodable px, Source r ix a)
      => (Array D ix b -> JP.Image px)
      -> (a -> b)
      -> Array r ix a
      -> BL.ByteString
    toBitmap :: (Array D ix b -> Image px)
-> (a -> b) -> Array r ix a -> ByteString
toBitmap Array D ix b -> Image px
toJP a -> b
adjustPixel =
      Metadatas -> Image px -> ByteString
forall pixel.
BmpEncodable pixel =>
Metadatas -> Image pixel -> ByteString
JP.encodeBitmapWithMetadata Metadatas
bitmapMetadata (Image px -> ByteString)
-> (Array r ix a -> Image px) -> Array r ix a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array D ix b -> Image px
toJP (Array D ix b -> Image px)
-> (Array r ix a -> Array D ix b) -> Array r ix a -> Image px
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Array r ix a -> Array D ix b
forall r ix e' e.
Source r ix e' =>
(e' -> e) -> Array r ix e' -> Array D ix e
A.map a -> b
adjustPixel