HEIF.hs

module Codec.HEIF
  ( -- * Re-exports
    module Codec.HEIF.Error,

    -- * Types
    DecodeOptions (..),
    Decoded (..),
    EncodeOptions (..),
    EncodeQuality (..),
    Image (..),
    Metadata (..),
    MetadataBlock (..),
    MetadataType (..),

    -- * Decoding HEIF contents
    decode,
    decodeThrow,
    decodeFromFile,
    decodeFromFileThrow,

    -- * Encoding HEIF contents
    encode,
    encodeThrow,
    encodeToFile,
    encodeToFileThrow,

    -- * Misc.
    heifVersion,
    defaultDecodeOptions,
    defaultEncodeOptions,
  )
where

import Codec.HEIF.Bindings
import Codec.HEIF.Error
import Control.Exception (try)
import Control.Monad
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL

data Decoded = Decoded
  { decodedImage :: Image,
    decodedMetadata :: Metadata
  }

defaultDecodeOptions :: DecodeOptions
defaultDecodeOptions = DecodeOptions {..}
  where
    doIgnoreTransformations = False
    doConvertHDRTo8Bit = True

defaultEncodeOptions :: EncodeOptions
defaultEncodeOptions = EncodeOptions {..}
  where
    eoQuality = Lossy 95

-- Decoding --------------------------------

-- | Same as 'decode' but throws 'HeifException'.
decodeThrow :: DecodeOptions -> BS.ByteString -> IO Decoded
decodeThrow decodeOptions imageHEIC =
  withContext $ \context -> do
    readByteStringIntoContext context imageHEIC
    withPrimaryImage context $ \primaryImage -> do
      decodedMetadata <- extractMetadata primaryImage
      decodedImage <- withDecodedRGB decodeOptions primaryImage extractImageData
      pure Decoded {..}

-- | Same as 'decodeThrow' but loads from a file.
decodeFromFileThrow :: DecodeOptions -> FilePath -> IO Decoded
decodeFromFileThrow decodeOptions heicFile =
  withContext $ \context -> do
    readFileIntoContext context heicFile
    withPrimaryImage context $ \primaryImage -> do
      decodedMetadata <- extractMetadata primaryImage
      decodedImage <- withDecodedRGB decodeOptions primaryImage extractImageData
      pure Decoded {..}

-- | Converts HEIC bytes into a 'Decoded'. The image is buffered in memory.
-- It is not streaming because libheif buffers the image too,
-- as HEIF is not a streaming format. Hence the strict ByteString parameter.
decode :: DecodeOptions -> BS.ByteString -> IO (Either HeifException Decoded)
decode decodeOptions = try . decodeThrow decodeOptions

-- | Same as 'decode' but loads from a file
decodeFromFile :: DecodeOptions -> FilePath -> IO (Either HeifException Decoded)
decodeFromFile decodeOptions = try . decodeFromFileThrow decodeOptions

-- Encoding --------------------------------

-- | Same as 'encode' but throws 'HeifException'.
encodeThrow :: EncodeOptions -> Decoded -> IO BSL.ByteString
encodeThrow EncodeOptions {..} Decoded {..} = withContext $ \context -> do
  withEncoder context $ \encoder -> do
    encodeQuality eoQuality encoder
    withRGBImage imageWidth imageHeight $ \writableImage -> do
      withNewRGBPlane writableImage imageWidth imageHeight $ \plane -> do
        fillPlaneFromByteString plane imagePixelsRGB
      withEncodeImage context writableImage encoder $ \imageHandle -> do
        forM_ metadataBlocks $ addMetadataBlock context imageHandle
        encodeToByteString context
  where
    Image {..} = decodedImage
    Metadata {..} = decodedMetadata

-- | Same as 'encodeThrow' but writes to a file.
encodeToFileThrow :: EncodeOptions -> FilePath -> Decoded -> IO ()
encodeToFileThrow EncodeOptions {..} file Decoded {..} = withContext $ \context -> do
  withEncoder context $ \encoder -> do
    encodeQuality eoQuality encoder
    withRGBImage imageWidth imageHeight $ \writableImage -> do
      withNewRGBPlane writableImage imageWidth imageHeight $ \plane -> do
        fillPlaneFromByteString plane imagePixelsRGB
      withEncodeImage context writableImage encoder $ \imageHandle -> do
        forM_ metadataBlocks $ addMetadataBlock context imageHandle
        encodeWriteToFile context file
  where
    Image {..} = decodedImage
    Metadata {..} = decodedMetadata

-- | Converts a 'Decoded' value into HEIC bytes.
encode :: EncodeOptions -> Decoded -> IO (Either HeifException BSL.ByteString)
encode encodeOptions = try . encodeThrow encodeOptions

-- | Same as 'encode' but writes to a file.
encodeToFile :: EncodeOptions -> FilePath -> Decoded -> IO (Either HeifException ())
encodeToFile encodeOptions filePath = try . encodeToFileThrow encodeOptions filePath