{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      :  Codec.Audio.FLAC.Metadata.Internal.Level2Interface.Helpers
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Wrappers around helpers for working with level 2 FLAC metadata interface.
--
-- The functions from this module are not safe, one only should attempt
-- calling them when 'Metadata' contains metadata of correct type.
module Codec.Audio.FLAC.Metadata.Internal.Level2Interface.Helpers
  ( -- * Stream info
    getMinBlockSize,
    getMaxBlockSize,
    getMinFrameSize,
    getMaxFrameSize,
    getSampleRate,
    getChannels,
    getBitsPerSample,
    getTotalSamples,
    getMd5Sum,

    -- * Application
    getApplicationId,
    getApplicationData,
    setApplicationId,
    setApplicationData,

    -- * Seek table
    getSeekPoints,
    setSeekPoints,

    -- * Vorbis comment
    getVorbisVendor,
    setVorbisVendor,
    getVorbisComment,
    setVorbisComment,
    deleteVorbisComment,
    isVorbisCommentEmpty,

    -- * CUE sheet
    getCueSheetData,
    setCueSheetData,

    -- * Picture
    getPictureType,
    getPictureData,
    setPictureType,
    setPictureData,
  )
where

import Codec.Audio.FLAC.Metadata.Internal.Object
import Codec.Audio.FLAC.Metadata.Internal.Types
import Codec.Audio.FLAC.Util
import Control.Monad
import Control.Monad.Catch
import Data.Bool (bool)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.List (uncons)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Foreign as T
import Data.Vector (Vector, (!))
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import Data.Word
import Foreign
import Foreign.C.String
import Foreign.C.Types

#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ((<>))
#endif

----------------------------------------------------------------------------
-- Stream info

-- | Get min block size.
getMinBlockSize :: Metadata -> IO Word32
getMinBlockSize :: Metadata -> IO Word32
getMinBlockSize = (CUInt -> Word32) -> IO CUInt -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Word32)
-> (Metadata -> IO CUInt) -> Metadata -> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO CUInt
c_get_min_blocksize

foreign import ccall unsafe "FLAC__metadata_get_min_blocksize"
  c_get_min_blocksize :: Metadata -> IO CUInt

-- | Get max block size.
getMaxBlockSize :: Metadata -> IO Word32
getMaxBlockSize :: Metadata -> IO Word32
getMaxBlockSize = (CUInt -> Word32) -> IO CUInt -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Word32)
-> (Metadata -> IO CUInt) -> Metadata -> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO CUInt
c_get_max_blocksize

foreign import ccall unsafe "FLAC__metadata_get_max_blocksize"
  c_get_max_blocksize :: Metadata -> IO CUInt

-- | Get min frame size.
getMinFrameSize :: Metadata -> IO Word32
getMinFrameSize :: Metadata -> IO Word32
getMinFrameSize = (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word32 -> IO Word32)
-> (Metadata -> IO Word32) -> Metadata -> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO Word32
c_get_min_framesize

foreign import ccall unsafe "FLAC__metadata_get_min_framesize"
  c_get_min_framesize :: Metadata -> IO Word32

-- | Get max frame size.
getMaxFrameSize :: Metadata -> IO Word32
getMaxFrameSize :: Metadata -> IO Word32
getMaxFrameSize = (Word32 -> Word32) -> IO Word32 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word32 -> IO Word32)
-> (Metadata -> IO Word32) -> Metadata -> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO Word32
c_get_max_framesize

foreign import ccall unsafe "FLAC__metadata_get_max_framesize"
  c_get_max_framesize :: Metadata -> IO Word32

-- | Get sample rate.
getSampleRate :: Metadata -> IO Word32
getSampleRate :: Metadata -> IO Word32
getSampleRate = (CUInt -> Word32) -> IO CUInt -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Word32)
-> (Metadata -> IO CUInt) -> Metadata -> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO CUInt
c_get_sample_rate

foreign import ccall unsafe "FLAC__metadata_get_sample_rate"
  c_get_sample_rate :: Metadata -> IO CUInt

-- | Get number of channels.
getChannels :: Metadata -> IO Word32
getChannels :: Metadata -> IO Word32
getChannels = (CUInt -> Word32) -> IO CUInt -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Word32)
-> (Metadata -> IO CUInt) -> Metadata -> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO CUInt
c_get_channels

foreign import ccall unsafe "FLAC__metadata_get_channels"
  c_get_channels :: Metadata -> IO CUInt

-- | Get number of bits per sample.
getBitsPerSample :: Metadata -> IO Word32
getBitsPerSample :: Metadata -> IO Word32
getBitsPerSample = (CUInt -> Word32) -> IO CUInt -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Word32)
-> (Metadata -> IO CUInt) -> Metadata -> IO Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO CUInt
c_get_bits_per_sample

foreign import ccall unsafe "FLAC__metadata_get_bits_per_sample"
  c_get_bits_per_sample :: Metadata -> IO CUInt

-- | Get total number of samples.
getTotalSamples :: Metadata -> IO Word64
getTotalSamples :: Metadata -> IO Word64
getTotalSamples = Metadata -> IO Word64
c_get_total_samples

foreign import ccall unsafe "FLAC__metadata_get_total_samples"
  c_get_total_samples :: Metadata -> IO Word64

-- | Get MD5 sum of original audio data.
getMd5Sum :: Metadata -> IO ByteString
getMd5Sum :: Metadata -> IO ByteString
getMd5Sum block :: Metadata
block = do
  CString
md5SumPtr <- Metadata -> IO CString
c_get_md5sum Metadata
block
  CStringLen -> IO ByteString
B.packCStringLen (CString
md5SumPtr, 16)

foreign import ccall unsafe "FLAC__metadata_get_md5sum"
  c_get_md5sum :: Metadata -> IO CString

----------------------------------------------------------------------------
-- Application

-- | Get application id from given 'Metadata' block.
getApplicationId :: Metadata -> IO ApplicationId
getApplicationId :: Metadata -> IO ApplicationId
getApplicationId block :: Metadata
block = do
  CString
idPtr <- Metadata -> IO CString
c_get_application_id Metadata
block
  ByteString -> ApplicationId
mkApplicationId (ByteString -> ApplicationId) -> IO ByteString -> IO ApplicationId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B.packCStringLen (CString
idPtr, 4)

foreign import ccall unsafe "FLAC__metadata_get_application_id"
  c_get_application_id :: Metadata -> IO CString

-- | Get data from given application metadata block.
getApplicationData :: Metadata -> IO ByteString
getApplicationData :: Metadata -> IO ByteString
getApplicationData block :: Metadata
block = (Ptr CUInt -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO ByteString) -> IO ByteString)
-> (Ptr CUInt -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \sizePtr :: Ptr CUInt
sizePtr -> do
  CString
dataPtr <- Metadata -> Ptr CUInt -> IO CString
c_get_application_data Metadata
block Ptr CUInt
sizePtr
  Int
size <- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
sizePtr
  CStringLen -> IO ByteString
B.packCStringLen (CString
dataPtr, Int
size)

foreign import ccall unsafe "FLAC__metadata_get_application_data"
  c_get_application_data :: Metadata -> Ptr CUInt -> IO CString

-- | Set application id for given metadata block.
setApplicationId :: Metadata -> ApplicationId -> IO ()
setApplicationId :: Metadata -> ApplicationId -> IO ()
setApplicationId block :: Metadata
block appId :: ApplicationId
appId =
  ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString (ApplicationId -> ByteString
unApplicationId ApplicationId
appId) (Metadata -> CString -> IO ()
c_set_application_id Metadata
block)

foreign import ccall unsafe "FLAC__metadata_set_application_id"
  c_set_application_id :: Metadata -> CString -> IO ()

-- | Set application data for given metadata block.
setApplicationData :: Metadata -> ByteString -> IO Bool
setApplicationData :: Metadata -> ByteString -> IO Bool
setApplicationData block :: Metadata
block data' :: ByteString
data' =
  ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
data' ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \dataPtr :: CString
dataPtr -> do
    let size :: CUInt
size = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
data')
    Metadata -> CString -> CUInt -> IO Bool
c_set_application_data Metadata
block CString
dataPtr CUInt
size

foreign import ccall unsafe "FLAC__metadata_set_application_data"
  c_set_application_data :: Metadata -> CString -> CUInt -> IO Bool

----------------------------------------------------------------------------
-- Seek table

-- | Get seek table as a 'Vector' of 'SeekPoint's.
getSeekPoints :: Metadata -> IO (Vector SeekPoint)
getSeekPoints :: Metadata -> IO (Vector SeekPoint)
getSeekPoints block :: Metadata
block = do
  Int
size <- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metadata -> IO CUInt
c_get_seek_points_num Metadata
block
  MVector RealWorld SeekPoint
v <- Int -> IO (MVector (PrimState IO) SeekPoint)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
VM.new Int
size
  let go :: Int -> IO ()
go n :: Int
n =
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Ptr SeekPoint
ptr <- Metadata -> CUInt -> IO (Ptr SeekPoint)
c_get_seek_point Metadata
block (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
          Word64
seekPointSampleNumber <- Ptr SeekPoint -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SeekPoint
ptr 0
          Word64
seekPointStreamOffset <- Ptr SeekPoint -> Int -> IO Word64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SeekPoint
ptr 8
          Word32
seekPointFrameSamples <- Ptr SeekPoint -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr SeekPoint
ptr 16
          MVector (PrimState IO) SeekPoint -> Int -> SeekPoint -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector RealWorld SeekPoint
MVector (PrimState IO) SeekPoint
v Int
n $WSeekPoint :: Word64 -> Word64 -> Word32 -> SeekPoint
SeekPoint {..}
          Int -> IO ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
  Int -> IO ()
go 0
  MVector (PrimState IO) SeekPoint -> IO (Vector SeekPoint)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector RealWorld SeekPoint
MVector (PrimState IO) SeekPoint
v

foreign import ccall unsafe "FLAC__metadata_get_seek_points_num"
  c_get_seek_points_num :: Metadata -> IO CUInt

foreign import ccall unsafe "FLAC__metadata_get_seek_point"
  c_get_seek_point :: Metadata -> CUInt -> IO (Ptr SeekPoint)

-- | Set seek table represented by a given 'Vector' of 'SeekPoint's. Return
-- 'False' in case of trouble.
setSeekPoints :: Metadata -> Vector SeekPoint -> IO Bool
setSeekPoints :: Metadata -> Vector SeekPoint -> IO Bool
setSeekPoints block :: Metadata
block seekPoints :: Vector SeekPoint
seekPoints = do
  let size :: Word32
size = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector SeekPoint -> Int
forall a. Vector a -> Int
V.length Vector SeekPoint
seekPoints)
  Bool
res <- Metadata -> Word32 -> IO Bool
objectSeektableResizePoints Metadata
block Word32
size
  if Bool
res
    then
      let go :: Word32 -> IO ()
go n :: Word32
n =
            if Word32
n Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
size
              then do
                let SeekPoint {..} = Vector SeekPoint
seekPoints Vector SeekPoint -> Int -> SeekPoint
forall a. Vector a -> Int -> a
! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n
                Metadata -> CUInt -> Word64 -> Word64 -> Word32 -> IO ()
c_set_seek_point
                  Metadata
block
                  (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
                  Word64
seekPointSampleNumber
                  Word64
seekPointStreamOffset
                  Word32
seekPointFrameSamples
                Word32 -> IO ()
go (Word32
n Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1)
              else do
                Bool
legal <- Metadata -> IO Bool
objectSeektableIsLegal Metadata
block
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
legal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  MetaException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM MetaException
MetaInvalidSeekTable
       in Word32 -> IO ()
go 0 IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

foreign import ccall unsafe "FLAC__metadata_set_seek_point"
  c_set_seek_point :: Metadata -> CUInt -> Word64 -> Word64 -> Word32 -> IO ()

----------------------------------------------------------------------------
-- Vorbis comment

-- | Get Vorbis vendor.
getVorbisVendor :: Metadata -> IO Text
getVorbisVendor :: Metadata -> IO Text
getVorbisVendor block :: Metadata
block = (Ptr Word32 -> IO Text) -> IO Text
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Text) -> IO Text)
-> (Ptr Word32 -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \sizePtr :: Ptr Word32
sizePtr -> do
  CString
vendorPtr <- Metadata -> Ptr Word32 -> IO CString
c_get_vorbis_vendor Metadata
block Ptr Word32
sizePtr
  Int
size <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
sizePtr
  CStringLen -> IO Text
T.peekCStringLen (CString
vendorPtr, Int
size)

foreign import ccall unsafe "FLAC__metadata_get_vorbis_vendor"
  c_get_vorbis_vendor :: Metadata -> Ptr Word32 -> IO CString

-- | Set Vorbis vendor.
setVorbisVendor :: Metadata -> Text -> IO Bool
setVorbisVendor :: Metadata -> Text -> IO Bool
setVorbisVendor block :: Metadata
block vendor :: Text
vendor =
  Text -> (CStringLen -> IO Bool) -> IO Bool
forall a. Text -> (CStringLen -> IO a) -> IO a
T.withCStringLen Text
vendor ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(vendorPtr :: CString
vendorPtr, size :: Int
size) ->
    Metadata -> CString -> Word32 -> IO Bool
c_set_vorbis_vendor Metadata
block CString
vendorPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)

foreign import ccall unsafe "FLAC__metadata_set_vorbis_vendor"
  c_set_vorbis_vendor :: Metadata -> CString -> Word32 -> IO Bool

-- | Get vorbis comment by name.
getVorbisComment :: ByteString -> Metadata -> IO (Maybe Text)
getVorbisComment :: ByteString -> Metadata -> IO (Maybe Text)
getVorbisComment name :: ByteString
name block :: Metadata
block = (Ptr Word32 -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Word32 -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \sizePtr :: Ptr Word32
sizePtr ->
  ByteString -> (CString -> IO (Maybe Text)) -> IO (Maybe Text)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name ((CString -> IO (Maybe Text)) -> IO (Maybe Text))
-> (CString -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \namePtr :: CString
namePtr -> do
    CString
commentPtr <- Metadata -> CString -> Ptr Word32 -> IO CString
c_get_vorbis_comment Metadata
block CString
namePtr Ptr Word32
sizePtr
    Int
commentSize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
sizePtr
    if CString
commentPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
      then Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
      else
        Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (ByteString -> Text) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop 1 (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '=') (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8
          (ByteString -> Maybe Text) -> IO ByteString -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B.packCStringLen (CString
commentPtr, Int
commentSize)

foreign import ccall unsafe "FLAC__metadata_get_vorbis_comment"
  c_get_vorbis_comment :: Metadata -> CString -> Ptr Word32 -> IO CString

-- | Set (replace or insert if necessary) a vorbis comment.
setVorbisComment :: ByteString -> Text -> Metadata -> IO Bool
setVorbisComment :: ByteString -> Text -> Metadata -> IO Bool
setVorbisComment name :: ByteString
name value :: Text
value block :: Metadata
block =
  Text -> (CStringLen -> IO Bool) -> IO Bool
forall a. Text -> (CStringLen -> IO a) -> IO a
T.withCStringLen (ByteString -> Text
T.decodeUtf8 ByteString
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value) ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$
    \(commentPtr :: CString
commentPtr, commentSize :: Int
commentSize) ->
      Metadata -> CString -> Word32 -> IO Bool
c_set_vorbis_comment Metadata
block CString
commentPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
commentSize)

foreign import ccall unsafe "FLAC__metadata_set_vorbis_comment"
  c_set_vorbis_comment :: Metadata -> CString -> Word32 -> IO Bool

-- | Delete a vorbis comment by name. If it doesn't exist, nothing will
-- happen.
deleteVorbisComment :: ByteString -> Metadata -> IO Bool
deleteVorbisComment :: ByteString -> Metadata -> IO Bool
deleteVorbisComment name :: ByteString
name block :: Metadata
block =
  ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name (Metadata -> CString -> IO Bool
c_delete_vorbis_comment Metadata
block)

foreign import ccall unsafe "FLAC__metadata_delete_vorbis_comment"
  c_delete_vorbis_comment :: Metadata -> CString -> IO Bool

-- | Determine a vorbis comment metadata block can be considered empty.
isVorbisCommentEmpty :: Metadata -> IO Bool
isVorbisCommentEmpty :: Metadata -> IO Bool
isVorbisCommentEmpty = Metadata -> IO Bool
c_is_vorbis_comment_empty

foreign import ccall unsafe "FLAC__metadata_is_vorbis_comment_empty"
  c_is_vorbis_comment_empty :: Metadata -> IO Bool

----------------------------------------------------------------------------
-- CUE sheet

-- | Get CUE sheet from 'Metadata' block assuming that it's a
-- 'CueSheetBlock'.
getCueSheetData :: Metadata -> IO CueSheetData
getCueSheetData :: Metadata -> IO CueSheetData
getCueSheetData block :: Metadata
block = do
  ByteString
cueCatalog <- Metadata -> IO CString
c_get_cue_sheet_mcn Metadata
block IO CString -> (CString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ByteString
B.packCString
  Word64
cueLeadIn <- Metadata -> IO Word64
c_get_cue_sheet_lead_in Metadata
block
  Bool
cueIsCd <- Metadata -> IO Bool
c_get_cue_sheet_is_cd Metadata
block
  Word8
numTracks <- Metadata -> IO Word8
c_get_cue_sheet_num_tracks Metadata
block
  (cueTracks :: [CueTrack]
cueTracks, cueLeadOutTrack :: CueTrack
cueLeadOutTrack) <-
    case Word8
numTracks of
      0 ->
        -- NOTE Should probably never happen unless FLAC file is invalid
        -- with respect to the spec.
        MetaException -> IO ([CueTrack], CueTrack)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> MetaException
MetaInvalidCueSheet "Cannot read CUE sheet without tracks")
      1 -> ([],) (CueTrack -> ([CueTrack], CueTrack))
-> IO CueTrack -> IO ([CueTrack], CueTrack)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metadata -> Word8 -> IO CueTrack
getCueSheetTrack Metadata
block 0
      _ -> do
        [CueTrack]
ts <- (Word8 -> IO CueTrack) -> [Word8] -> IO [CueTrack]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Metadata -> Word8 -> IO CueTrack
getCueSheetTrack Metadata
block) [0 .. Word8
numTracks Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 2]
        CueTrack
t' <- Metadata -> Word8 -> IO CueTrack
getCueSheetTrack Metadata
block (Word8
numTracks Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 1)
        ([CueTrack], CueTrack) -> IO ([CueTrack], CueTrack)
forall (m :: * -> *) a. Monad m => a -> m a
return ([CueTrack]
ts, CueTrack
t')
  CueSheetData -> IO CueSheetData
forall (m :: * -> *) a. Monad m => a -> m a
return $WCueSheetData :: ByteString
-> Word64 -> Bool -> [CueTrack] -> CueTrack -> CueSheetData
CueSheetData {..}

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_mcn"
  c_get_cue_sheet_mcn :: Metadata -> IO CString

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_lead_in"
  c_get_cue_sheet_lead_in :: Metadata -> IO Word64

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_is_cd"
  c_get_cue_sheet_is_cd :: Metadata -> IO Bool

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_num_tracks"
  c_get_cue_sheet_num_tracks :: Metadata -> IO Word8

-- | Peek a single 'CueSheetTrack' at given index.
getCueSheetTrack :: Metadata -> Word8 -> IO CueTrack
getCueSheetTrack :: Metadata -> Word8 -> IO CueTrack
getCueSheetTrack block :: Metadata
block n :: Word8
n = do
  Word64
cueTrackOffset <- Metadata -> Word8 -> IO Word64
c_get_cue_sheet_track_offset Metadata
block Word8
n
  ByteString
cueTrackIsrc <- Metadata -> Word8 -> IO CString
c_get_cue_sheet_track_isrc Metadata
block Word8
n IO CString -> (CString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO ByteString
B.packCString
  Bool
cueTrackAudio <- Metadata -> Word8 -> IO Bool
c_get_cue_sheet_track_audio Metadata
block Word8
n
  Bool
cueTrackPreEmphasis <- Metadata -> Word8 -> IO Bool
c_get_cue_sheet_track_preemphasis Metadata
block Word8
n
  Word8
numIndices <- Metadata -> Word8 -> IO Word8
c_get_cue_sheet_track_num_indices Metadata
block Word8
n
  (cueTrackPregapIndex :: Maybe Word64
cueTrackPregapIndex, cueTrackIndices :: NonEmpty Word64
cueTrackIndices) <-
    if Word8
numIndices Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0
      then MetaException -> IO (Maybe Word64, NonEmpty Word64)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> MetaException
MetaInvalidCueSheet "Cannot read CUE track without indices")
      else do
        Bool
hasPregap <- Metadata -> Word8 -> IO Bool
c_get_cue_sheet_track_has_pregap_index Metadata
block Word8
n
        let pregapOne :: Num a => a
            pregapOne :: a
pregapOne = if Bool
hasPregap then 1 else 0
            range :: [Word8]
range =
              if Word8
numIndices Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
forall a. Num a => a
pregapOne
                then [Word8
forall a. Num a => a
pregapOne .. Word8
numIndices Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 1]
                else []
        Maybe Word64
pregapIndex <-
          if Bool
hasPregap
            then Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> IO Word64 -> IO (Maybe Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metadata -> Word8 -> Word8 -> IO Word64
c_get_cue_sheet_track_index Metadata
block Word8
n 0
            else Maybe Word64 -> IO (Maybe Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word64
forall a. Maybe a
Nothing
        NonEmpty Word64
trackIndices <-
          (Word8 -> IO Word64) -> NonEmpty Word8 -> IO (NonEmpty Word64)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
            (Metadata -> Word8 -> Word8 -> IO Word64
c_get_cue_sheet_track_index Metadata
block Word8
n)
            ([Word8] -> NonEmpty Word8
forall a. [a] -> NonEmpty a
NE.fromList [Word8]
range)
        (Maybe Word64, NonEmpty Word64)
-> IO (Maybe Word64, NonEmpty Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Word64
pregapIndex, NonEmpty Word64
trackIndices)
  CueTrack -> IO CueTrack
forall (m :: * -> *) a. Monad m => a -> m a
return $WCueTrack :: Word64
-> ByteString
-> Bool
-> Bool
-> Maybe Word64
-> NonEmpty Word64
-> CueTrack
CueTrack {..}

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_track_offset"
  c_get_cue_sheet_track_offset :: Metadata -> Word8 -> IO Word64

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_track_isrc"
  c_get_cue_sheet_track_isrc :: Metadata -> Word8 -> IO CString

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_track_audio"
  c_get_cue_sheet_track_audio :: Metadata -> Word8 -> IO Bool

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_track_preemphasis"
  c_get_cue_sheet_track_preemphasis :: Metadata -> Word8 -> IO Bool

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_track_num_indices"
  c_get_cue_sheet_track_num_indices :: Metadata -> Word8 -> IO Word8

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_track_has_pregap_index"
  c_get_cue_sheet_track_has_pregap_index :: Metadata -> Word8 -> IO Bool

foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_track_index"
  c_get_cue_sheet_track_index :: Metadata -> Word8 -> Word8 -> IO Word64

-- | Set 'CueSheetData' in given 'Metadata' block of type 'CueSheetBlock'.
setCueSheetData :: Metadata -> CueSheetData -> IO Bool
setCueSheetData :: Metadata -> CueSheetData -> IO Bool
setCueSheetData block :: Metadata
block CueSheetData {..} = do
  ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
cueCatalog ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(mcnPtr :: CString
mcnPtr, mcnSize :: Int
mcnSize) ->
    Metadata -> CString -> CUInt -> IO ()
c_set_cue_sheet_mcn Metadata
block CString
mcnPtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mcnSize)
  Metadata -> Word64 -> IO ()
c_set_cue_sheet_lead_in Metadata
block Word64
cueLeadIn
  Metadata -> Bool -> IO ()
c_set_cue_sheet_is_cd Metadata
block Bool
cueIsCd
  let numTracks :: Word8
numTracks = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CueTrack] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CueTrack]
cueTracks Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
  Bool
res <- Metadata -> Word8 -> IO Bool
objectCueSheetResizeTracks Metadata
block Word8
numTracks
  Bool
goodOutcome <-
    if Bool
res
      then
        let go :: [(CueTrack, Word8)] -> IO Bool
go ts :: [(CueTrack, Word8)]
ts =
              case [(CueTrack, Word8)]
-> Maybe ((CueTrack, Word8), [(CueTrack, Word8)])
forall a. [a] -> Maybe (a, [a])
uncons [(CueTrack, Word8)]
ts of
                Nothing ->
                  Metadata -> CueTrack -> Word8 -> Word8 -> IO Bool
setCueSheetTrack Metadata
block CueTrack
cueLeadOutTrack (Word8
numTracks Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 1) 170
                Just ((t :: CueTrack
t, n :: Word8
n), ts' :: [(CueTrack, Word8)]
ts') -> do
                  Bool
res' <- Metadata -> CueTrack -> Word8 -> Word8 -> IO Bool
setCueSheetTrack Metadata
block CueTrack
t Word8
n (Word8
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 1)
                  if Bool
res'
                    then [(CueTrack, Word8)] -> IO Bool
go [(CueTrack, Word8)]
ts'
                    else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         in [(CueTrack, Word8)] -> IO Bool
go ([CueTrack] -> [Word8] -> [(CueTrack, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CueTrack]
cueTracks [0 ..])
      else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
goodOutcome (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe Text
res' <- Metadata -> Bool -> IO (Maybe Text)
objectCueSheetIsLegal Metadata
block Bool
cueIsCd
    case Maybe Text
res' of
      Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just msg :: Text
msg -> MetaException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> MetaException
MetaInvalidCueSheet Text
msg)
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
goodOutcome

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_mcn"
  c_set_cue_sheet_mcn :: Metadata -> CString -> CUInt -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_lead_in"
  c_set_cue_sheet_lead_in :: Metadata -> Word64 -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_is_cd"
  c_set_cue_sheet_is_cd :: Metadata -> Bool -> IO ()

-- | Poke a 'CueTrack' at a specified index.
setCueSheetTrack :: Metadata -> CueTrack -> Word8 -> Word8 -> IO Bool
setCueSheetTrack :: Metadata -> CueTrack -> Word8 -> Word8 -> IO Bool
setCueSheetTrack block :: Metadata
block CueTrack {..} n :: Word8
n n' :: Word8
n' = do
  Metadata -> Word8 -> Word64 -> IO ()
c_set_cue_sheet_track_offset Metadata
block Word8
n Word64
cueTrackOffset
  Metadata -> Word8 -> Word8 -> IO ()
c_set_cue_sheet_track_number Metadata
block Word8
n Word8
n'
  ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
cueTrackIsrc ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(isrcPtr :: CString
isrcPtr, isrcSize :: Int
isrcSize) ->
    Metadata -> Word8 -> CString -> CUInt -> IO ()
c_set_cue_sheet_track_isrc Metadata
block Word8
n CString
isrcPtr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
isrcSize)
  Metadata -> Word8 -> Bool -> IO ()
c_set_cue_sheet_track_audio Metadata
block Word8
n Bool
cueTrackAudio
  Metadata -> Word8 -> Bool -> IO ()
c_set_cue_sheet_track_pre_emphasis Metadata
block Word8
n Bool
cueTrackPreEmphasis
  let pregapOne :: Num a => a
      pregapOne :: a
pregapOne = if Maybe Word64 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Word64
cueTrackPregapIndex then 1 else 0
      numIndices :: Word8
numIndices = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NonEmpty Word64 -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty Word64
cueTrackIndices Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forall a. Num a => a
pregapOne)
  Bool
goodOutcome <- Metadata -> Word8 -> Word8 -> IO Bool
objectCueSheetTrackResizeIndices Metadata
block Word8
n Word8
numIndices
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
goodOutcome (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe Word64 -> (Word64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Word64
cueTrackPregapIndex ((Word64 -> IO ()) -> IO ()) -> (Word64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \offset :: Word64
offset ->
      Metadata -> Word8 -> Word8 -> Word8 -> Word64 -> IO ()
c_set_cue_sheet_track_index Metadata
block Word8
n 0 0 Word64
offset
    let range :: [(Word8, Word8)]
range = [Word8] -> [Word8] -> [(Word8, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word8
forall a. Num a => a
pregapOne ..] [1 ..]
    NonEmpty (Word64, (Word8, Word8))
-> ((Word64, (Word8, Word8)) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (NonEmpty Word64
-> NonEmpty (Word8, Word8) -> NonEmpty (Word64, (Word8, Word8))
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty Word64
cueTrackIndices ([(Word8, Word8)] -> NonEmpty (Word8, Word8)
forall a. [a] -> NonEmpty a
NE.fromList [(Word8, Word8)]
range)) (((Word64, (Word8, Word8)) -> IO ()) -> IO ())
-> ((Word64, (Word8, Word8)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(offset :: Word64
offset, (i :: Word8
i, i' :: Word8
i')) ->
      Metadata -> Word8 -> Word8 -> Word8 -> Word64 -> IO ()
c_set_cue_sheet_track_index Metadata
block Word8
n Word8
i Word8
i' Word64
offset
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
goodOutcome

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_track_offset"
  c_set_cue_sheet_track_offset :: Metadata -> Word8 -> Word64 -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_track_number"
  c_set_cue_sheet_track_number :: Metadata -> Word8 -> Word8 -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_track_isrc"
  c_set_cue_sheet_track_isrc :: Metadata -> Word8 -> CString -> CUInt -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_track_audio"
  c_set_cue_sheet_track_audio :: Metadata -> Word8 -> Bool -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_track_pre_emphasis"
  c_set_cue_sheet_track_pre_emphasis :: Metadata -> Word8 -> Bool -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_cue_sheet_track_index"
  c_set_cue_sheet_track_index :: Metadata -> Word8 -> Word8 -> Word8 -> Word64 -> IO ()

----------------------------------------------------------------------------
-- Picture

-- | Get type of picture assuming that given 'Metadata' block is a
-- 'PictureBlock'.
getPictureType :: Metadata -> IO PictureType
getPictureType :: Metadata -> IO PictureType
getPictureType = (CUInt -> PictureType) -> IO CUInt -> IO PictureType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> PictureType
forall a b. (Integral a, Enum b) => a -> b
toEnum' (IO CUInt -> IO PictureType)
-> (Metadata -> IO CUInt) -> Metadata -> IO PictureType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO CUInt
c_get_picture_type

foreign import ccall unsafe "FLAC__metadata_get_picture_type"
  c_get_picture_type :: Metadata -> IO CUInt

-- | Get picture data from a given 'Metadata' block.
getPictureData :: Metadata -> IO PictureData
getPictureData :: Metadata -> IO PictureData
getPictureData block :: Metadata
block = do
  Text
pictureMimeType <- Metadata -> IO CString
c_get_picture_mime_type Metadata
block IO CString -> (CString -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
peekCStringText
  Text
pictureDescription <- Metadata -> IO CString
c_get_picture_description Metadata
block IO CString -> (CString -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
peekCStringText
  Word32
pictureWidth <- Metadata -> IO Word32
c_get_picture_width Metadata
block
  Word32
pictureHeight <- Metadata -> IO Word32
c_get_picture_height Metadata
block
  Word32
pictureDepth <- Metadata -> IO Word32
c_get_picture_depth Metadata
block
  Word32
pictureColors <- Metadata -> IO Word32
c_get_picture_colors Metadata
block
  ByteString
pictureData <- (Ptr Word32 -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO ByteString) -> IO ByteString)
-> (Ptr Word32 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \dataSizePtr :: Ptr Word32
dataSizePtr -> do
    CString
dataPtr <- Metadata -> Ptr Word32 -> IO CString
c_get_picture_data Metadata
block Ptr Word32
dataSizePtr
    Int
dataSize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
dataSizePtr
    CStringLen -> IO ByteString
B.packCStringLen (CString
dataPtr, Int
dataSize)
  PictureData -> IO PictureData
forall (m :: * -> *) a. Monad m => a -> m a
return $WPictureData :: Text
-> Text
-> Word32
-> Word32
-> Word32
-> Word32
-> ByteString
-> PictureData
PictureData {..}

foreign import ccall unsafe "FLAC__metadata_get_picture_mime_type"
  c_get_picture_mime_type :: Metadata -> IO CString

foreign import ccall unsafe "FLAC__metadata_get_picture_description"
  c_get_picture_description :: Metadata -> IO CString

foreign import ccall unsafe "FLAC__metadata_get_picture_width"
  c_get_picture_width :: Metadata -> IO Word32

foreign import ccall unsafe "FLAC__metadata_get_picture_height"
  c_get_picture_height :: Metadata -> IO Word32

foreign import ccall unsafe "FLAC__metadata_get_picture_depth"
  c_get_picture_depth :: Metadata -> IO Word32

foreign import ccall unsafe "FLAC__metadata_get_picture_colors"
  c_get_picture_colors :: Metadata -> IO Word32

foreign import ccall unsafe "FLAC__metadata_get_picture_data"
  c_get_picture_data :: Metadata -> Ptr Word32 -> IO CString

-- | Set 'PictureType' to a given 'Metadata' block that should be a
-- 'PictureBlock'.
setPictureType :: Metadata -> PictureType -> IO ()
setPictureType :: Metadata -> PictureType -> IO ()
setPictureType block :: Metadata
block pictureType :: PictureType
pictureType =
  Metadata -> CUInt -> IO ()
c_set_picture_type Metadata
block (PictureType -> CUInt
forall a b. (Integral a, Enum b) => b -> a
fromEnum' PictureType
pictureType)

foreign import ccall unsafe "FLAC__metadata_set_picture_type"
  c_set_picture_type :: Metadata -> CUInt -> IO ()

-- | Set 'PictureData' in given 'Metadata' block of type 'PictureBlock'.
setPictureData :: Metadata -> PictureData -> IO Bool
setPictureData :: Metadata -> PictureData -> IO Bool
setPictureData block :: Metadata
block PictureData {..} = do
  Metadata -> Word32 -> IO ()
c_set_picture_width Metadata
block Word32
pictureWidth
  Metadata -> Word32 -> IO ()
c_set_picture_height Metadata
block Word32
pictureHeight
  Metadata -> Word32 -> IO ()
c_set_picture_depth Metadata
block Word32
pictureDepth
  Metadata -> Word32 -> IO ()
c_set_picture_colors Metadata
block Word32
pictureColors
  Bool
goodOutcome <-
    [IO Bool] -> IO Bool
shortcutFalse
      [ Metadata -> Text -> IO Bool
objectPictureSetMimeType Metadata
block Text
pictureMimeType,
        Metadata -> Text -> IO Bool
objectPictureSetDescription Metadata
block Text
pictureDescription,
        Metadata -> ByteString -> IO Bool
objectPictureSetData Metadata
block ByteString
pictureData
      ]
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
goodOutcome (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe Text
res <- Metadata -> IO (Maybe Text)
objectPictureIsLegal Metadata
block
    case Maybe Text
res of
      Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just msg :: Text
msg -> MetaException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> MetaException
MetaInvalidPicture Text
msg)
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
goodOutcome

foreign import ccall unsafe "FLAC__metadata_set_picture_width"
  c_set_picture_width :: Metadata -> Word32 -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_picture_height"
  c_set_picture_height :: Metadata -> Word32 -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_picture_depth"
  c_set_picture_depth :: Metadata -> Word32 -> IO ()

foreign import ccall unsafe "FLAC__metadata_set_picture_colors"
  c_set_picture_colors :: Metadata -> Word32 -> IO ()

-- | Execute a collection of actions that return 'False' on failure. As soon
-- as failure is reported, stop the execution and return 'False'. Return
-- 'True' in the case of success.
shortcutFalse :: [IO Bool] -> IO Bool
shortcutFalse :: [IO Bool] -> IO Bool
shortcutFalse [] = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
shortcutFalse (m :: IO Bool
m : ms :: [IO Bool]
ms) = IO Bool
m IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Bool -> IO Bool -> Bool -> IO Bool
forall a. a -> a -> Bool -> a
bool (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) ([IO Bool] -> IO Bool
shortcutFalse [IO Bool]
ms)