{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Module      : Data.Massiv.Array.IO.Base
-- Copyright   : (c) Alexey Kuleshevich 2018-2021
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Massiv.Array.IO.Base
  ( FileFormat(..)
  , selectFileFormat
  , Readable(..)
  , decode'
  , Writable(..)
  , encode'
  , ConvertError(..)
  , EncodeError(..)
  , DecodeError(..)
  , Sequence(..)
  , Default(..)
  , Auto(..)
  , Image
  , convertImage
  , toImageBaseModel
  , fromImageBaseModel
  , coerceBinaryImage
  , demoteLumaImage
  , promoteLumaImage
  , demoteLumaAlphaImage
  , promoteLumaAlphaImage
  , defaultWriteOptions
  , encodeError
  , decodeError
  , toProxy
  , fromMaybeEncode
  , fromMaybeDecodeM
  , fromMaybeDecode
  , convertEither
  , unsafeFromStorableVectorM
  , MonadThrow(..)
  ) where

import Control.Exception (Exception, throw)
import Control.Monad.Catch (MonadThrow(..))
import qualified Data.ByteString as B (ByteString)
import qualified Data.ByteString.Lazy as BL (ByteString)
import Data.Char (toLower)
import Data.Default.Class (Default(..))
import qualified Data.Massiv.Array as A
import Data.Typeable
import qualified Data.Vector.Storable as V
import Graphics.Pixel as CM
import Graphics.Pixel.ColorSpace
import Prelude as P
import System.FilePath (takeExtension)
import Unsafe.Coerce
#if !MIN_VERSION_massiv(0,5,0)
import Data.Massiv.Array.Manifest.Vector
#endif
type Image r cs e = A.Array r A.Ix2 (Pixel cs e)

-- | Conversion error, which is thrown when there is a mismatch between the expected array
-- type and the one supported by the file format. It is also thrown upon a failure of
-- automatic conversion between those types, in case when such conversion is utilized.
newtype ConvertError = ConvertError String deriving Int -> ConvertError -> ShowS
[ConvertError] -> ShowS
ConvertError -> String
(Int -> ConvertError -> ShowS)
-> (ConvertError -> String)
-> ([ConvertError] -> ShowS)
-> Show ConvertError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConvertError] -> ShowS
$cshowList :: [ConvertError] -> ShowS
show :: ConvertError -> String
$cshow :: ConvertError -> String
showsPrec :: Int -> ConvertError -> ShowS
$cshowsPrec :: Int -> ConvertError -> ShowS
Show

instance Exception ConvertError where
  displayException :: ConvertError -> String
displayException (ConvertError String
str) = String
"ConvertError: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str

-- | This exception can be thrown while reading/decoding a file and indicates an
-- error in the file itself.
newtype DecodeError = DecodeError String deriving Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodeError] -> ShowS
$cshowList :: [DecodeError] -> ShowS
show :: DecodeError -> String
$cshow :: DecodeError -> String
showsPrec :: Int -> DecodeError -> ShowS
$cshowsPrec :: Int -> DecodeError -> ShowS
Show

instance Exception DecodeError where
  displayException :: DecodeError -> String
displayException (DecodeError String
str) = String
"DecodeError: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str

-- | This exception can be thrown while writing/encoding into a file and
-- indicates an error in an array that is being encoded.
newtype EncodeError = EncodeError String deriving Int -> EncodeError -> ShowS
[EncodeError] -> ShowS
EncodeError -> String
(Int -> EncodeError -> ShowS)
-> (EncodeError -> String)
-> ([EncodeError] -> ShowS)
-> Show EncodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodeError] -> ShowS
$cshowList :: [EncodeError] -> ShowS
show :: EncodeError -> String
$cshow :: EncodeError -> String
showsPrec :: Int -> EncodeError -> ShowS
$cshowsPrec :: Int -> EncodeError -> ShowS
Show

instance Exception EncodeError


-- | Generate default write options for a file format
defaultWriteOptions :: FileFormat f => f -> WriteOptions f
defaultWriteOptions :: f -> WriteOptions f
defaultWriteOptions f
_ = WriteOptions f
forall a. Default a => a
def


-- | Special wrapper for formats that support encoding/decoding sequence of array.
newtype Sequence f = Sequence f deriving Int -> Sequence f -> ShowS
[Sequence f] -> ShowS
Sequence f -> String
(Int -> Sequence f -> ShowS)
-> (Sequence f -> String)
-> ([Sequence f] -> ShowS)
-> Show (Sequence f)
forall f. Show f => Int -> Sequence f -> ShowS
forall f. Show f => [Sequence f] -> ShowS
forall f. Show f => Sequence f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sequence f] -> ShowS
$cshowList :: forall f. Show f => [Sequence f] -> ShowS
show :: Sequence f -> String
$cshow :: forall f. Show f => Sequence f -> String
showsPrec :: Int -> Sequence f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Sequence f -> ShowS
Show

newtype Auto f = Auto f deriving Int -> Auto f -> ShowS
[Auto f] -> ShowS
Auto f -> String
(Int -> Auto f -> ShowS)
-> (Auto f -> String) -> ([Auto f] -> ShowS) -> Show (Auto f)
forall f. Show f => Int -> Auto f -> ShowS
forall f. Show f => [Auto f] -> ShowS
forall f. Show f => Auto f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Auto f] -> ShowS
$cshowList :: forall f. Show f => [Auto f] -> ShowS
show :: Auto f -> String
$cshow :: forall f. Show f => Auto f -> String
showsPrec :: Int -> Auto f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Auto f -> ShowS
Show

-- | File format. Helps in guessing file format from a file extension,
-- as well as supplying format specific options during saving the file.
class (Default (WriteOptions f), Show f) => FileFormat f where
  -- | Options that can be used during writing a file in this format.
  type WriteOptions f
  type WriteOptions f = ()

  type Metadata f
  type Metadata f = ()

  -- | Default file extension for this file format.
  ext :: f -> String

  -- | Other known file extensions for this file format, eg. ".jpeg", ".jpg".
  exts :: f -> [String]
  exts f
f = [f -> String
forall f. FileFormat f => f -> String
ext f
f]

  -- | Checks if a file extension corresponds to the format, eg.
  -- @isFormat ".png" PNG == True@
  isFormat :: String -> f -> Bool
  isFormat String
e f
f = String
e String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` f -> [String]
forall f. FileFormat f => f -> [String]
exts f
f


instance FileFormat f => FileFormat (Auto f) where
  type WriteOptions (Auto f) = WriteOptions f
  type Metadata (Auto f) = Metadata f

  ext :: Auto f -> String
ext (Auto f
f) = f -> String
forall f. FileFormat f => f -> String
ext f
f
  exts :: Auto f -> [String]
exts (Auto f
f) = f -> [String]
forall f. FileFormat f => f -> [String]
exts f
f

-- | Try to select a file format by looking at the file extension and matching it to one
-- of the formats in the list
--
-- @since 0.4.1
selectFileFormat :: (FileFormat f, MonadThrow m) => [f] -> FilePath -> m f
selectFileFormat :: [f] -> String -> m f
selectFileFormat [f]
formats String
path = do
  let ext' :: String
ext' = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
P.map Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
path
  case (f -> Bool) -> [f] -> [f]
forall a. (a -> Bool) -> [a] -> [a]
P.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (f -> Bool) -> f -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> f -> Bool
forall f. FileFormat f => String -> f -> Bool
isFormat String
ext') [f]
formats of
    []    -> EncodeError -> m f
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (EncodeError -> m f) -> EncodeError -> m f
forall a b. (a -> b) -> a -> b
$ String -> EncodeError
EncodeError (String -> EncodeError) -> String -> EncodeError
forall a b. (a -> b) -> a -> b
$ String
"File format is not supported: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ext'
    (f
f:[f]
_) -> f -> m f
forall (f :: * -> *) a. Applicative f => a -> f a
pure f
f


-- | File formats that can be read into arrays.
class FileFormat f => Readable f arr where
  {-# MINIMAL (decodeM | decodeWithMetadataM) #-}
  -- | Decode a `B.ByteString` into an array. Can also return whatever left over data that
  -- was not consumed during decoding.
  --
  -- @since 0.2.0
  decodeM :: MonadThrow m => f -> B.ByteString -> m arr
  decodeM f
f ByteString
bs = (arr, Metadata f) -> arr
forall a b. (a, b) -> a
fst ((arr, Metadata f) -> arr) -> m (arr, Metadata f) -> m arr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f -> ByteString -> m (arr, Metadata f)
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m (arr, Metadata f)
decodeWithMetadataM f
f ByteString
bs
  -- | Just as `decodeM`, but also return any format type specific metadata
  --
  -- @since 0.2.0
  decodeWithMetadataM :: MonadThrow m => f -> B.ByteString -> m (arr, Metadata f)
  default decodeWithMetadataM :: (Metadata f ~ (), MonadThrow m) =>
    f -> B.ByteString -> m (arr, Metadata f)
  decodeWithMetadataM f
f ByteString
bs = do
    arr
arr <- f -> ByteString -> m arr
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m arr
decodeM f
f ByteString
bs
    (arr, ()) -> m (arr, ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (arr
arr, ())

-- | Encode an array into a `BL.ByteString`.
encode' :: Writable f arr => f -> WriteOptions f -> arr -> BL.ByteString
encode' :: f -> WriteOptions f -> arr -> ByteString
encode' f
f WriteOptions f
opts = (SomeException -> ByteString)
-> (ByteString -> ByteString)
-> Either SomeException ByteString
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> ByteString
forall a e. Exception e => e -> a
throw ByteString -> ByteString
forall a. a -> a
id (Either SomeException ByteString -> ByteString)
-> (arr -> Either SomeException ByteString) -> arr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> WriteOptions f -> arr -> Either SomeException ByteString
forall f arr (m :: * -> *).
(Writable f arr, MonadThrow m) =>
f -> WriteOptions f -> arr -> m ByteString
encodeM f
f WriteOptions f
opts

-- | Decode a `B.ByteString` into an Array.
decode' :: Readable f arr => f -> B.ByteString -> arr
decode' :: f -> ByteString -> arr
decode' f
f = (SomeException -> arr)
-> (arr -> arr) -> Either SomeException arr -> arr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> arr
forall a e. Exception e => e -> a
throw arr -> arr
forall a. a -> a
id (Either SomeException arr -> arr)
-> (ByteString -> Either SomeException arr) -> ByteString -> arr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> ByteString -> Either SomeException arr
forall f arr (m :: * -> *).
(Readable f arr, MonadThrow m) =>
f -> ByteString -> m arr
decodeM f
f


-- | Arrays that can be written into a file.
class FileFormat f => Writable f arr where

  -- | Encode an array into a `BL.ByteString`.
  --
  -- @since 0.2.0
  encodeM :: MonadThrow m => f -> WriteOptions f -> arr -> m BL.ByteString


-- | Helper function to create a `Proxy` from the value.
toProxy :: a -> Proxy a
toProxy :: a -> Proxy a
toProxy a
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

showImageType ::
     forall r cs e. (Typeable r, ColorModel cs e)
  => Proxy (Image r cs e)
  -> String
showImageType :: Proxy (Image r cs e) -> String
showImageType Proxy (Image r cs e)
_ =
  (String
"<Image " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  TypeRep -> ShowS
showsTypeRep (Proxy r -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy r
forall k (t :: k). Proxy t
Proxy :: Proxy r)) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Proxy (Color cs e) -> ShowS
forall cs e. ColorModel cs e => Proxy (Color cs e) -> ShowS
showsColorModelName (Proxy (Color cs e)
forall k (t :: k). Proxy t
Proxy :: Proxy (Color cs e)) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> ShowS
showsTypeRep (Proxy e -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy e
forall k (t :: k). Proxy t
Proxy :: Proxy e)) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
  String
">"


-- | Encode an image using the supplied function or throw an error in case of failure.
fromMaybeEncode
  :: 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 :: f -> Proxy (Image r cs e) -> Maybe b -> m b
fromMaybeEncode f
f Proxy (Image r cs e)
imgProxy =
  \case
    Just b
b -> b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b
    Maybe b
Nothing ->
      ConvertError -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ConvertError -> m b) -> ConvertError -> m b
forall a b. (a -> b) -> a -> b
$
      String -> ConvertError
ConvertError (String
"Format " String -> ShowS
forall a. [a] -> [a] -> [a]
++ f -> String
forall a. Show a => a -> String
show f
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" cannot be encoded as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy (Image r cs e) -> String
forall r cs e.
(Typeable r, ColorModel cs e) =>
Proxy (Image r cs e) -> String
showImageType Proxy (Image r cs e)
imgProxy)


-- | Decode an image using the supplied function or throw an error in case of failure.
fromMaybeDecode ::
     forall r cs e a f m. (ColorModel cs e, FileFormat f, Typeable r, MonadThrow m)
  => f
  -> (a -> String)
  -> (a -> Maybe (Image r cs e))
  -> a
  -> m (Image r cs e)
fromMaybeDecode :: f
-> (a -> String)
-> (a -> Maybe (Image r cs e))
-> a
-> m (Image r cs e)
fromMaybeDecode f
f a -> String
showCS a -> Maybe (Image r cs e)
conv a
eImg =
  case a -> Maybe (Image r cs e)
conv a
eImg of
    Maybe (Image r cs e)
Nothing ->
      ConvertError -> m (Image r cs e)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ConvertError -> m (Image r cs e))
-> ConvertError -> m (Image r cs e)
forall a b. (a -> b) -> a -> b
$
      String -> ConvertError
ConvertError (String -> ConvertError) -> String -> ConvertError
forall a b. (a -> b) -> a -> b
$
      String
"Cannot decode " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      f -> String
forall a. Show a => a -> String
show f
f String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
" image <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
showCS a
eImg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy (Image r cs e) -> String
forall r cs e.
(Typeable r, ColorModel cs e) =>
Proxy (Image r cs e) -> String
showImageType (Proxy (Image r cs e)
forall k (t :: k). Proxy t
Proxy :: Proxy (Image r cs e))
    Just Image r cs e
img -> Image r cs e -> m (Image r cs e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Image r cs e
img

-- | Decode an image using the supplied function or throw an error in case of failure.
fromMaybeDecodeM ::
     forall r cs e a f m. (ColorModel cs e, FileFormat f, Typeable r, MonadThrow m)
  => f
  -> (a -> String)
  -> (a -> m (Maybe (Image r cs e)))
  -> a
  -> m (Image r cs e)
fromMaybeDecodeM :: f
-> (a -> String)
-> (a -> m (Maybe (Image r cs e)))
-> a
-> m (Image r cs e)
fromMaybeDecodeM f
f a -> String
showCS a -> m (Maybe (Image r cs e))
conv a
eImg =
  a -> m (Maybe (Image r cs e))
conv a
eImg m (Maybe (Image r cs e))
-> (Maybe (Image r cs e) -> m (Image r cs e)) -> m (Image r cs e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Image r cs e)
Nothing ->
      ConvertError -> m (Image r cs e)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ConvertError -> m (Image r cs e))
-> ConvertError -> m (Image r cs e)
forall a b. (a -> b) -> a -> b
$
      String -> ConvertError
ConvertError (String -> ConvertError) -> String -> ConvertError
forall a b. (a -> b) -> a -> b
$
      String
"Cannot decode " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      f -> String
forall a. Show a => a -> String
show f
f String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
" image <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
showCS a
eImg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy (Image r cs e) -> String
forall r cs e.
(Typeable r, ColorModel cs e) =>
Proxy (Image r cs e) -> String
showImageType (Proxy (Image r cs e)
forall k (t :: k). Proxy t
Proxy :: Proxy (Image r cs e))
    Just Image r cs e
img -> Image r cs e -> m (Image r cs e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Image r cs e
img


-- | Convert an image using the supplied function and return ConvertError error in case of failure.
convertEither ::
     forall r cs i e a f m. (ColorSpace cs i e, FileFormat f, Typeable r, MonadThrow m)
  => f
  -> (a -> String)
  -> (a -> Maybe (Image r cs e))
  -> a
  -> m (Image r cs e)
convertEither :: f
-> (a -> String)
-> (a -> Maybe (Image r cs e))
-> a
-> m (Image r cs e)
convertEither f
f a -> String
showCS a -> Maybe (Image r cs e)
conv a
eImg =
  m (Image r cs e)
-> (Image r cs e -> m (Image r cs e))
-> Maybe (Image r cs e)
-> m (Image r cs e)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (ConvertError -> m (Image r cs e)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ConvertError -> m (Image r cs e))
-> ConvertError -> m (Image r cs e)
forall a b. (a -> b) -> a -> b
$
     String -> ConvertError
ConvertError
       (String
"Cannot convert " String -> ShowS
forall a. [a] -> [a] -> [a]
++
        f -> String
forall a. Show a => a -> String
show f
f String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
" image <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
showCS a
eImg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"> as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy (Image r cs e) -> String
forall r cs e.
(Typeable r, ColorModel cs e) =>
Proxy (Image r cs e) -> String
showImageType (Proxy (Image r cs e)
forall k (t :: k). Proxy t
Proxy :: Proxy (Image r cs e))))
    Image r cs e -> m (Image r cs e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (a -> Maybe (Image r cs e)
conv a
eImg)


encodeError :: MonadThrow m => Either String a -> m a
encodeError :: Either String a -> m a
encodeError = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EncodeError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (EncodeError -> m a) -> (String -> EncodeError) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EncodeError
EncodeError) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

decodeError :: MonadThrow m => Either String a -> m a
decodeError :: Either String a -> m a
decodeError = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (DecodeError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (DecodeError -> m a) -> (String -> DecodeError) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DecodeError
DecodeError) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure


-- | Convert image to any supported color space
--
-- @since 0.2.0
convertImage ::
     (A.Source r' A.Ix2 (Pixel cs' e'), ColorSpace cs' i' e', ColorSpace cs i e)
  => Image r' cs' e'
  -> Image A.D cs e
convertImage :: Image r' cs' e' -> Image D cs e
convertImage = (Pixel cs' e' -> Pixel cs e) -> Image r' cs' e' -> Image D cs e
forall r ix e' e.
Source r ix e' =>
(e' -> e) -> Array r ix e' -> Array D ix e
A.map Pixel cs' e' -> Pixel cs e
forall k1 k2 cs (i :: k1) e cs' (i' :: k2) e'.
(ColorSpace cs' i' e', ColorSpace cs i e) =>
Pixel cs' e' -> Pixel cs e
convertPixel

-- | Cast an array. This is theoretically unsafe operation, but for all currently
-- available `ColorSpace` instances this function is perfectly safe.
--
-- @since 0.2.0
toImageBaseModel :: A.Array A.S A.Ix2 (Pixel cs e) -> A.Array A.S A.Ix2 (Pixel (BaseModel cs) e)
toImageBaseModel :: Array S Ix2 (Pixel cs e) -> Array S Ix2 (Pixel (BaseModel cs) e)
toImageBaseModel = Array S Ix2 (Pixel cs e) -> Array S Ix2 (Pixel (BaseModel cs) e)
forall a b. a -> b
unsafeCoerce


-- | Cast an array. This is theoretically unsafe operation, but for all currently
-- available `ColorSpace` instances this function is perfectly safe.
--
-- @since 0.2.0
fromImageBaseModel :: A.Array A.S A.Ix2 (Pixel (BaseModel cs) e) -> A.Array A.S A.Ix2 (Pixel cs e)
fromImageBaseModel :: Array S Ix2 (Pixel (BaseModel cs) e) -> Array S Ix2 (Pixel cs e)
fromImageBaseModel = Array S Ix2 (Pixel (BaseModel cs) e) -> Array S Ix2 (Pixel cs e)
forall a b. a -> b
unsafeCoerce

-- | Convert Binary image to its Word8 backed pixel without copy
--
-- @since 0.4.1
coerceBinaryImage :: A.Array A.S A.Ix2 (Pixel CM.X Bit) -> A.Array A.S A.Ix2 (Pixel CM.X Word8)
coerceBinaryImage :: Array S Ix2 (Pixel X Bit) -> Array S Ix2 (Pixel X Word8)
coerceBinaryImage = Array S Ix2 (Pixel X Bit) -> Array S Ix2 (Pixel X Word8)
forall a b. a -> b
unsafeCoerce

-- | Cast an array with Luma pixels to an array with pixels in a plain single channel
-- `CM.X` color model
--
-- @since 0.2.1
demoteLumaImage :: A.Array A.S A.Ix2 (Pixel (Y' cs) e) -> A.Array A.S A.Ix2 (Pixel CM.X e)
demoteLumaImage :: Array S Ix2 (Pixel (Y' cs) e) -> Array S Ix2 (Pixel X e)
demoteLumaImage = Array S Ix2 (Pixel (Y' cs) e) -> Array S Ix2 (Pixel X e)
forall a b. a -> b
unsafeCoerce
{-# DEPRECATED demoteLumaImage "In favor of `toImageBaseModel`" #-}

-- | Cast an array with pixels in a plain single channel `CM.X` color model to an array
-- with Luma pixels
--
-- @since 0.2.1
promoteLumaImage :: A.Array A.S A.Ix2 (Pixel CM.X e) -> A.Array A.S A.Ix2 (Pixel (Y' cs) e)
promoteLumaImage :: Array S Ix2 (Pixel X e) -> Array S Ix2 (Pixel (Y' cs) e)
promoteLumaImage = Array S Ix2 (Pixel X e) -> Array S Ix2 (Pixel (Y' cs) e)
forall a b. a -> b
unsafeCoerce
{-# DEPRECATED promoteLumaImage "In favor of `fromImageBaseModel`" #-}

-- | Same as `demoteLumaImage`, but with Alpha channel
--
-- @since 0.2.1
demoteLumaAlphaImage ::
     A.Array A.S A.Ix2 (Pixel (Alpha (Y' cs)) e) -> A.Array A.S A.Ix2 (Pixel (Alpha CM.X) e)
demoteLumaAlphaImage :: Array S Ix2 (Pixel (Alpha (Y' cs)) e)
-> Array S Ix2 (Pixel (Alpha X) e)
demoteLumaAlphaImage = Array S Ix2 (Pixel (Alpha (Y' cs)) e)
-> Array S Ix2 (Pixel (Alpha X) e)
forall a b. a -> b
unsafeCoerce
{-# DEPRECATED demoteLumaAlphaImage "In favor of `toImageBaseModel`" #-}


-- | Same as `promoteLumaImage` but with Alpha channel
--
-- @since 0.2.1
promoteLumaAlphaImage ::
     A.Array A.S A.Ix2 (Pixel (Alpha CM.X) e) -> A.Array A.S A.Ix2 (Pixel (Alpha (Y' cs)) e)
promoteLumaAlphaImage :: Array S Ix2 (Pixel (Alpha X) e)
-> Array S Ix2 (Pixel (Alpha (Y' cs)) e)
promoteLumaAlphaImage = Array S Ix2 (Pixel (Alpha X) e)
-> Array S Ix2 (Pixel (Alpha (Y' cs)) e)
forall a b. a -> b
unsafeCoerce
{-# DEPRECATED promoteLumaAlphaImage "In favor of `fromImageBaseModel`" #-}



unsafeFromStorableVectorM ::
     (MonadThrow m, A.Index ix, A.Storable a, A.Storable b)
  => A.Sz ix
  -> V.Vector a
  -> m (A.Array A.S ix b)
unsafeFromStorableVectorM :: Sz ix -> Vector a -> m (Array S ix b)
unsafeFromStorableVectorM Sz ix
sz Vector a
v =
#if MIN_VERSION_massiv(0,5,0)
    Sz ix -> Array S Int b -> m (Array S ix b)
forall (m :: * -> *) ix' r ix e.
(MonadThrow m, Index ix', Load r ix e, Resize r ix) =>
Sz ix' -> Array r ix e -> m (Array r ix' e)
A.resizeM Sz ix
sz (Array S Int b -> m (Array S ix b))
-> Array S Int b -> m (Array S ix b)
forall a b. (a -> b) -> a -> b
$ Comp -> Vector b -> Array S Int b
forall e. Storable e => Comp -> Vector e -> Array S Int e
A.fromStorableVector Comp
A.Par (Vector b -> Array S Int b) -> Vector b -> Array S Int b
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
V.unsafeCast Vector a
v
#else
    fromVectorM A.Par sz $ V.unsafeCast v
#endif