{-# LANGUAGE ForeignFunctionInterface #-}

-- |
-- Module      :  Codec.Audio.FLAC.Metadata.Internal.Object
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Wrappers for the functions to work with metadata objects, see:
--
-- <https://xiph.org/flac/api/group__flac__metadata__object.html>.
module Codec.Audio.FLAC.Metadata.Internal.Object
  ( objectNew,
    objectDelete,
    objectSeektableResizePoints,
    objectSeektableIsLegal,
    objectCueSheetResizeTracks,
    objectCueSheetTrackResizeIndices,
    objectCueSheetIsLegal,
    objectPictureSetMimeType,
    objectPictureSetDescription,
    objectPictureSetData,
    objectPictureIsLegal,
  )
where

import Codec.Audio.FLAC.Metadata.Internal.Types
import Codec.Audio.FLAC.Util
import Data.ByteString (ByteString)
import qualified Data.ByteString.Unsafe as B
import Data.Text (Text)
import Foreign
import Foreign.C.String
import Foreign.C.Types

-- | Create a new metadata object given its type.
objectNew :: MetadataType -> IO (Maybe Metadata)
objectNew :: MetadataType -> IO (Maybe Metadata)
objectNew = (Metadata -> Maybe Metadata) -> IO Metadata -> IO (Maybe Metadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Metadata -> Maybe Metadata
forall a p. Coercible a (Ptr p) => a -> Maybe a
maybePtr (IO Metadata -> IO (Maybe Metadata))
-> (MetadataType -> IO Metadata)
-> MetadataType
-> IO (Maybe Metadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> IO Metadata
c_object_new (CUInt -> IO Metadata)
-> (MetadataType -> CUInt) -> MetadataType -> IO Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> CUInt
forall a b. (Integral a, Enum b) => b -> a
fromEnum'

foreign import ccall unsafe "FLAC__metadata_object_new"
  c_object_new :: CUInt -> IO Metadata

-- | Free a metadata object.
objectDelete :: Metadata -> IO ()
objectDelete :: Metadata -> IO ()
objectDelete = Metadata -> IO ()
c_object_delete

foreign import ccall unsafe "FLAC__metadata_object_delete"
  c_object_delete :: Metadata -> IO ()

-- | Resize the seekpoint array. In case of trouble return 'False'.
objectSeektableResizePoints :: Metadata -> Word32 -> IO Bool
objectSeektableResizePoints :: Metadata -> Word32 -> IO Bool
objectSeektableResizePoints block :: Metadata
block newSize :: Word32
newSize =
  Metadata -> CUInt -> IO Bool
c_object_seektable_resize_points Metadata
block (Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
newSize)

foreign import ccall unsafe "FLAC__metadata_object_seektable_resize_points"
  c_object_seektable_resize_points :: Metadata -> CUInt -> IO Bool

-- | Check a seek table to see if it conforms to the FLAC specification.
-- Return 'False' if the seek table is illegal.
objectSeektableIsLegal :: Metadata -> IO Bool
objectSeektableIsLegal :: Metadata -> IO Bool
objectSeektableIsLegal = Metadata -> IO Bool
c_object_seektable_is_legal

foreign import ccall unsafe "FLAC__metadata_object_seektable_is_legal"
  c_object_seektable_is_legal :: Metadata -> IO Bool

-- | Resize the track array.
objectCueSheetResizeTracks :: Metadata -> Word8 -> IO Bool
objectCueSheetResizeTracks :: Metadata -> Word8 -> IO Bool
objectCueSheetResizeTracks block :: Metadata
block n :: Word8
n =
  Metadata -> CUInt -> IO Bool
c_object_cuesheet_resize_tracks Metadata
block (Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)

foreign import ccall unsafe "FLAC__metadata_object_cuesheet_resize_tracks"
  c_object_cuesheet_resize_tracks :: Metadata -> CUInt -> IO Bool

-- | Resize a track's index point array.
objectCueSheetTrackResizeIndices :: Metadata -> Word8 -> Word8 -> IO Bool
objectCueSheetTrackResizeIndices :: Metadata -> Word8 -> Word8 -> IO Bool
objectCueSheetTrackResizeIndices block :: Metadata
block n :: Word8
n i :: Word8
i =
  Metadata -> CUInt -> CUInt -> IO Bool
c_object_cuesheet_track_resize_indices Metadata
block (Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) (Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i)

foreign import ccall unsafe "FLAC__metadata_object_cuesheet_track_resize_indices"
  c_object_cuesheet_track_resize_indices :: Metadata -> CUInt -> CUInt -> IO Bool

-- | Check a CUE sheet to see if it conforms to the FLAC specification. If
-- something is wrong, the explanation is returned in 'Just', otherwise
-- 'Nothing' is returned.
objectCueSheetIsLegal :: Metadata -> Bool -> IO (Maybe Text)
objectCueSheetIsLegal :: Metadata -> Bool -> IO (Maybe Text)
objectCueSheetIsLegal block :: Metadata
block checkCdda :: Bool
checkCdda = (Ptr CString -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr CString -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \cstrPtr :: Ptr CString
cstrPtr -> do
  Bool
res <- Metadata -> Bool -> Ptr CString -> IO Bool
c_object_cuesheet_is_legal Metadata
block Bool
checkCdda Ptr CString
cstrPtr
  if Bool
res
    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) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
cstrPtr IO CString -> (CString -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
peekCStringText)

foreign import ccall unsafe "FLAC__metadata_object_cuesheet_is_legal"
  c_object_cuesheet_is_legal :: Metadata -> Bool -> Ptr CString -> IO Bool

-- | Check a picture and return description of what is wrong, otherwise
-- 'Nothing'.
objectPictureIsLegal :: Metadata -> IO (Maybe Text)
objectPictureIsLegal :: Metadata -> IO (Maybe Text)
objectPictureIsLegal block :: Metadata
block = (Ptr CString -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr CString -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \cstrPtr :: Ptr CString
cstrPtr -> do
  Bool
res <- Metadata -> Ptr CString -> IO Bool
c_object_picture_is_legal Metadata
block Ptr CString
cstrPtr
  if Bool
res
    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) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
cstrPtr IO CString -> (CString -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO Text
peekCStringText)

foreign import ccall unsafe "FLAC__metadata_object_picture_is_legal"
  c_object_picture_is_legal :: Metadata -> Ptr CString -> IO Bool

-- | Set the MIME type of a given picture block.
objectPictureSetMimeType :: Metadata -> Text -> IO Bool
objectPictureSetMimeType :: Metadata -> Text -> IO Bool
objectPictureSetMimeType block :: Metadata
block mimeType :: Text
mimeType =
  Text -> (CString -> IO Bool) -> IO Bool
forall a. Text -> (CString -> IO a) -> IO a
withCStringText Text
mimeType ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr ->
    Metadata -> CString -> Bool -> IO Bool
c_object_picture_set_mime_type Metadata
block CString
cstr Bool
True

foreign import ccall unsafe "FLAC__metadata_object_picture_set_mime_type"
  c_object_picture_set_mime_type :: Metadata -> CString -> Bool -> IO Bool

-- | Set the description of a given picture block.
objectPictureSetDescription :: Metadata -> Text -> IO Bool
objectPictureSetDescription :: Metadata -> Text -> IO Bool
objectPictureSetDescription block :: Metadata
block desc :: Text
desc =
  Text -> (CString -> IO Bool) -> IO Bool
forall a. Text -> (CString -> IO a) -> IO a
withCStringText Text
desc ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \cstr :: CString
cstr ->
    Metadata -> CString -> Bool -> IO Bool
c_object_picture_set_description Metadata
block CString
cstr Bool
True

foreign import ccall unsafe "FLAC__metadata_object_picture_set_description"
  c_object_picture_set_description :: Metadata -> CString -> Bool -> IO Bool

-- | Set the picture data of a given picture block.
objectPictureSetData :: Metadata -> ByteString -> IO Bool
objectPictureSetData :: Metadata -> ByteString -> IO Bool
objectPictureSetData block :: Metadata
block data' :: ByteString
data' =
  ByteString -> (CStringLen -> IO Bool) -> IO Bool
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
data' ((CStringLen -> IO Bool) -> IO Bool)
-> (CStringLen -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \(dataPtr :: CString
dataPtr, dataSize :: Int
dataSize) ->
    Metadata -> CString -> Word32 -> Bool -> IO Bool
c_object_picture_set_data Metadata
block CString
dataPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataSize) Bool
True

foreign import ccall unsafe "FLAC__metadata_object_picture_set_data"
  c_object_picture_set_data :: Metadata -> CString -> Word32 -> Bool -> IO Bool