-- | -- Module : Codec.Audio.FLAC.Metadata.Internal.Level2Interface -- Copyright : © 2016–2019 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- -- Low-level Haskell wrapper around C functions to work with the level 2 -- FLAC metadata interface, see: -- -- . {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE LambdaCase #-} module Codec.Audio.FLAC.Metadata.Internal.Level2Interface ( -- * Chain withChain , chainStatus , chainRead , chainWrite , chainSortPadding -- * Iterator , withIterator , iteratorGetBlockType , iteratorGetBlock , iteratorSetBlock , iteratorDeleteBlock , iteratorInsertBlockAfter ) where import Codec.Audio.FLAC.Metadata.Internal.Types import Codec.Audio.FLAC.Util import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO (..)) import Foreign.C.String import Foreign.C.Types ---------------------------------------------------------------------------- -- Chain -- | Create and use a 'MetaChain' (metadata chain). The chain is guaranteed -- to be freed even in the case of exception thrown. -- -- If memory for the chain cannot be allocated, corresponding -- 'MetaException' is raised. withChain :: (MetaChain -> IO a) -> IO a withChain f = bracket chainNew (mapM_ chainDelete) $ \case Nothing -> throwM (MetaGeneralProblem MetaChainStatusMemoryAllocationError) Just x -> f x -- | Create a new 'MetaChain'. In the case of memory allocation problem -- 'Nothing' is returned. chainNew :: IO (Maybe MetaChain) chainNew = maybePtr <$> c_chain_new foreign import ccall unsafe "FLAC__metadata_chain_new" c_chain_new :: IO MetaChain -- | Free a 'MetaChain' instance. Delete the object pointed to by -- 'MetaChain'. chainDelete :: MetaChain -> IO () chainDelete = c_chain_delete foreign import ccall unsafe "FLAC__metadata_chain_delete" c_chain_delete :: MetaChain -> IO () -- | Check status of a given 'MetaChain'. This can be used to find out what -- went wrong. It also resets status to 'MetaChainStatusOK'. chainStatus :: MetaChain -> IO MetaChainStatus chainStatus = fmap toEnum' . c_chain_status foreign import ccall unsafe "FLAC__metadata_chain_status" c_chain_status :: MetaChain -> IO CUInt -- | Read all metadata from a FLAC file into the chain. Return 'False' if -- something went wrong. chainRead :: MetaChain -> FilePath -> IO Bool chainRead chain path = withCString path (c_chain_read chain) foreign import ccall unsafe "FLAC__metadata_chain_read" c_chain_read :: MetaChain -> CString -> IO Bool -- | Write all metadata out to the FLAC file. chainWrite :: MetaChain -- ^ The chain to write -> Bool -- ^ Whether to use padding -> Bool -- ^ Whether to preserve file stats -> IO Bool -- ^ 'False' if something went wrong chainWrite chain usePadding preserveStats = c_chain_write chain (fromEnum' usePadding) (fromEnum' preserveStats) foreign import ccall unsafe "FLAC__metadata_chain_write" c_chain_write :: MetaChain -> CInt -> CInt -> IO Bool -- | Move all padding blocks to the end on the metadata, then merge them -- into a single block. Useful to get maximum padding to have better changes -- for re-writing only metadata blocks, not entire FLAC file. Any iterator -- on the current chain will become invalid after this call. You should -- delete the iterator and get a new one. -- -- NOTE: this function does not write to the FLAC file, it only modifies the -- chain. chainSortPadding :: MetaChain -> IO () chainSortPadding = c_chain_sort_padding foreign import ccall unsafe "FLAC__metadata_chain_sort_padding" c_chain_sort_padding :: MetaChain -> IO () ---------------------------------------------------------------------------- -- Iterator -- | Traverse all metadata blocks from beginning to end collecting 'Just' -- values and possibly performing some actions. This is the only way to -- traverse metadata chain and get access to 'MetaIterator' and by exporting -- only this, we eliminate a certain class of possible errors making finding -- and traversing metadata blocks always correct and safe. -- -- If memory for the iterator cannot be allocated, corresponding -- 'MetaException' is raised. withIterator :: (MonadMask m, MonadIO m) => MetaChain -- ^ Metadata chain to traverse -> (MetaIterator -> m (Maybe a)) -- ^ Action to perform on each block -> m [a] -- ^ Accumulated results withIterator chain f = bracket acquire release action where acquire = liftIO iteratorNew release = mapM_ (liftIO . iteratorDelete) action mi = case mi of Nothing -> throwM (MetaGeneralProblem MetaChainStatusMemoryAllocationError) Just i -> do liftIO (iteratorInit i chain) let go thisNext = if thisNext then do res <- f i let next = liftIO (iteratorNext i) >>= go case res of Nothing -> next Just x -> (x :) <$> next else return [] go True -- | Create a new iterator. Return 'Nothing' if there was a problem with -- memory allocation. iteratorNew :: IO (Maybe MetaIterator) iteratorNew = maybePtr <$> c_iterator_new foreign import ccall unsafe "FLAC__metadata_iterator_new" c_iterator_new :: IO MetaIterator -- | Free an iterator instance. Delete the object pointed to by -- 'MetaIterator'. iteratorDelete :: MetaIterator -> IO () iteratorDelete = c_iterator_delete foreign import ccall unsafe "FLAC__metadata_iterator_delete" c_iterator_delete :: MetaIterator -> IO () -- | Initialize the iterator to point to the first metadata block in the -- given chain. iteratorInit :: MetaIterator -- ^ Existing iterator -> MetaChain -- ^ Existing initialized chain -> IO () iteratorInit = c_iterator_init foreign import ccall unsafe "FLAC__metadata_iterator_init" c_iterator_init :: MetaIterator -> MetaChain -> IO () -- | Move the iterator forward one metadata block, returning 'False' if -- already at the end. iteratorNext :: MetaIterator -> IO Bool iteratorNext = c_iterator_next foreign import ccall unsafe "FLAC__metadata_iterator_next" c_iterator_next :: MetaIterator -> IO Bool -- | Get the type of the metadata block at the current position. Useful for -- fast searching. iteratorGetBlockType :: MetaIterator -> IO MetadataType iteratorGetBlockType = fmap toEnum' . c_iterator_get_block_type foreign import ccall unsafe "FLAC__metadata_iterator_get_block_type" c_iterator_get_block_type :: MetaIterator -> IO CUInt -- | Get metadata block at the current position. iteratorGetBlock :: MetaIterator -> IO Metadata iteratorGetBlock = c_iterator_get_block foreign import ccall unsafe "FLAC__metadata_iterator_get_block" c_iterator_get_block :: MetaIterator -> IO Metadata -- | Write given 'Metadata' block at the position pointed to by -- 'MetaIterator' replacing an existing block. iteratorSetBlock :: MetaIterator -> Metadata -> IO Bool iteratorSetBlock = c_iterator_set_block foreign import ccall unsafe "FLAC__metadata_iterator_set_block" c_iterator_set_block :: MetaIterator -> Metadata -> IO Bool -- | Remove the current block from the chain. iteratorDeleteBlock :: MetaIterator -- ^ Iterator that determines the position -> IO Bool -- ^ 'False' if something went wrong iteratorDeleteBlock block = c_iterator_delete_block block False foreign import ccall unsafe "FLAC__metadata_iterator_delete_block" c_iterator_delete_block :: MetaIterator -> Bool -> IO Bool -- | Insert a new block after the current block. You cannot insert a -- 'StreamInfo' block as there can be only one, the one that already exists -- at the head when you read in a chain. The chain takes ownership of the -- new block and it will be deleted when the chain is deleted. The iterator -- will be left pointing to the new block. -- -- The function returns 'False' if something went wrong. iteratorInsertBlockAfter :: MetaIterator -> Metadata -> IO Bool iteratorInsertBlockAfter = c_iterator_insert_block_after foreign import ccall unsafe "FLAC__metadata_iterator_insert_block_after" c_iterator_insert_block_after :: MetaIterator -> Metadata -> IO Bool