{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      :  Codec.Audio.FLAC.Metadata
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- The module provides a complete high-level Haskell API to manipulate FLAC
-- metadata.
--
-- === How to use this module
--
-- Just like the other modules of this library, the API is file-centered—no
-- streaming support is available at this time (in libFLAC as well).
-- Retrieving and editing metadata information is very easy, you only need
-- three functions: 'runFlacMeta', 'retrieve', and @('=->')@.
--
-- Here is how to get sample rate and artist name and print them:
--
-- > import Codec.Audio.FLAC.Metadata
-- > import Control.Monad.IO.Class (MonadIO (..))
-- > import Data.Default.Class
-- >
-- > main :: IO ()
-- > main = runFlacMeta def "/path/to/my/file.flac" $ do
-- >   retrieve SampleRate             >>= liftIO . print
-- >   retrieve (VorbisComment Artist) >>= liftIO . print
--
-- Normally you would just return them packed in a tuple from the monad, of
-- course. We print the values just for a demonstration.
--
-- The next example shows how to set a couple of tags:
--
-- > import Codec.Audio.FLAC.Metadata
-- > import Data.Default.Class
-- >
-- > main :: IO ()
-- > main = runFlacMeta def "/path/to/my/file.flac" $ do
-- >   VorbisComment Artist =-> Just "Alexander Scriabin"
-- >   VorbisComment Title  =-> Just "Sonata №9 “Black Mass”, Op. 68"
-- >   VorbisComment Date   =-> Nothing
--
-- Here we write two tags using the @('=->')@ operator and delete the
-- @'VorbisComment' 'Date'@ metadata attribute by setting it to 'Nothing'.
-- Note that not all attributes are writable, so we cannot set things like
-- 'SampleRate'. In fact, the type system mechanics used in the library
-- prevent this.
--
-- === Low-level details
--
-- The implementation uses the reference implementation of FLAC—libFLAC (C
-- library) under the hood. This means you'll need at least version 1.3.0 of
-- libFLAC (released 26 May 2013) installed for the binding to work.
--
-- This module in particular uses the level 2 metadata interface and it's
-- not possible to choose other interface (such as level 0 and 1). However,
-- this should not be of any concern to the end-user, as the level 2
-- supports more functionality than the other levels.
module Codec.Audio.FLAC.Metadata
  ( -- * Metadata manipulation API
    FlacMeta,
    MetaSettings (..),
    defaultMetaSettings,
    MetaException (..),
    MetaChainStatus (..),
    runFlacMeta,

    -- * Meta values
    MetaValue (..),
    MinBlockSize (..),
    MaxBlockSize (..),
    MinFrameSize (..),
    MaxFrameSize (..),
    SampleRate (..),
    Channels (..),
    ChannelMask (..),
    BitsPerSample (..),
    TotalSamples (..),
    FileSize (..),
    BitRate (..),
    MD5Sum (..),
    Duration (..),
    Application (..),
    ApplicationId,
    mkApplicationId,
    unApplicationId,
    SeekTable (..),
    SeekPoint (..),
    VorbisVendor (..),
    VorbisComment (..),
    VorbisField (..),
    CueSheet (..),
    Picture (..),
    PictureType (..),
    PictureData (..),

    -- * Extra functionality
    wipeVorbisComment,
    wipeApplications,
    wipeSeekTable,
    wipeCueSheets,
    wipePictures,

    -- * Debugging and testing
    MetadataType (..),
    getMetaChain,
    isMetaChainModified,
  )
where

import Codec.Audio.FLAC.Metadata.Internal.Level2Interface
import Codec.Audio.FLAC.Metadata.Internal.Level2Interface.Helpers
import Codec.Audio.FLAC.Metadata.Internal.Object
import Codec.Audio.FLAC.Metadata.Internal.Types
import Codec.Audio.Wave
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Reader
import Data.Bool (bool)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import Data.Char (toUpper)
import Data.IORef
import Data.Kind (Constraint, Type)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromJust, listToMaybe)
import Data.Set (Set)
import qualified Data.Set as E
import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Foreign hiding (void)
import GHC.TypeLits
import Numeric.Natural
import System.IO

----------------------------------------------------------------------------
-- Metadata manipulation API

-- | An opaque monad for reading and writing of FLAC metadata. The monad is
-- the home for 'retrieve' and @('=->')@ functions and can be run with
-- 'runFlacMeta'.
newtype FlacMeta a = FlacMeta {FlacMeta a -> Inner a
unFlacMeta :: Inner a}
  deriving
    ( a -> FlacMeta b -> FlacMeta a
(a -> b) -> FlacMeta a -> FlacMeta b
(forall a b. (a -> b) -> FlacMeta a -> FlacMeta b)
-> (forall a b. a -> FlacMeta b -> FlacMeta a) -> Functor FlacMeta
forall a b. a -> FlacMeta b -> FlacMeta a
forall a b. (a -> b) -> FlacMeta a -> FlacMeta b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FlacMeta b -> FlacMeta a
$c<$ :: forall a b. a -> FlacMeta b -> FlacMeta a
fmap :: (a -> b) -> FlacMeta a -> FlacMeta b
$cfmap :: forall a b. (a -> b) -> FlacMeta a -> FlacMeta b
Functor,
      Functor FlacMeta
a -> FlacMeta a
Functor FlacMeta =>
(forall a. a -> FlacMeta a)
-> (forall a b. FlacMeta (a -> b) -> FlacMeta a -> FlacMeta b)
-> (forall a b c.
    (a -> b -> c) -> FlacMeta a -> FlacMeta b -> FlacMeta c)
-> (forall a b. FlacMeta a -> FlacMeta b -> FlacMeta b)
-> (forall a b. FlacMeta a -> FlacMeta b -> FlacMeta a)
-> Applicative FlacMeta
FlacMeta a -> FlacMeta b -> FlacMeta b
FlacMeta a -> FlacMeta b -> FlacMeta a
FlacMeta (a -> b) -> FlacMeta a -> FlacMeta b
(a -> b -> c) -> FlacMeta a -> FlacMeta b -> FlacMeta c
forall a. a -> FlacMeta a
forall a b. FlacMeta a -> FlacMeta b -> FlacMeta a
forall a b. FlacMeta a -> FlacMeta b -> FlacMeta b
forall a b. FlacMeta (a -> b) -> FlacMeta a -> FlacMeta b
forall a b c.
(a -> b -> c) -> FlacMeta a -> FlacMeta b -> FlacMeta c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: FlacMeta a -> FlacMeta b -> FlacMeta a
$c<* :: forall a b. FlacMeta a -> FlacMeta b -> FlacMeta a
*> :: FlacMeta a -> FlacMeta b -> FlacMeta b
$c*> :: forall a b. FlacMeta a -> FlacMeta b -> FlacMeta b
liftA2 :: (a -> b -> c) -> FlacMeta a -> FlacMeta b -> FlacMeta c
$cliftA2 :: forall a b c.
(a -> b -> c) -> FlacMeta a -> FlacMeta b -> FlacMeta c
<*> :: FlacMeta (a -> b) -> FlacMeta a -> FlacMeta b
$c<*> :: forall a b. FlacMeta (a -> b) -> FlacMeta a -> FlacMeta b
pure :: a -> FlacMeta a
$cpure :: forall a. a -> FlacMeta a
$cp1Applicative :: Functor FlacMeta
Applicative,
      Applicative FlacMeta
a -> FlacMeta a
Applicative FlacMeta =>
(forall a b. FlacMeta a -> (a -> FlacMeta b) -> FlacMeta b)
-> (forall a b. FlacMeta a -> FlacMeta b -> FlacMeta b)
-> (forall a. a -> FlacMeta a)
-> Monad FlacMeta
FlacMeta a -> (a -> FlacMeta b) -> FlacMeta b
FlacMeta a -> FlacMeta b -> FlacMeta b
forall a. a -> FlacMeta a
forall a b. FlacMeta a -> FlacMeta b -> FlacMeta b
forall a b. FlacMeta a -> (a -> FlacMeta b) -> FlacMeta b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> FlacMeta a
$creturn :: forall a. a -> FlacMeta a
>> :: FlacMeta a -> FlacMeta b -> FlacMeta b
$c>> :: forall a b. FlacMeta a -> FlacMeta b -> FlacMeta b
>>= :: FlacMeta a -> (a -> FlacMeta b) -> FlacMeta b
$c>>= :: forall a b. FlacMeta a -> (a -> FlacMeta b) -> FlacMeta b
$cp1Monad :: Applicative FlacMeta
Monad,
      Monad FlacMeta
Monad FlacMeta =>
(forall a. IO a -> FlacMeta a) -> MonadIO FlacMeta
IO a -> FlacMeta a
forall a. IO a -> FlacMeta a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> FlacMeta a
$cliftIO :: forall a. IO a -> FlacMeta a
$cp1MonadIO :: Monad FlacMeta
MonadIO,
      Monad FlacMeta
e -> FlacMeta a
Monad FlacMeta =>
(forall e a. Exception e => e -> FlacMeta a) -> MonadThrow FlacMeta
forall e a. Exception e => e -> FlacMeta a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> FlacMeta a
$cthrowM :: forall e a. Exception e => e -> FlacMeta a
$cp1MonadThrow :: Monad FlacMeta
MonadThrow,
      MonadThrow FlacMeta
MonadThrow FlacMeta =>
(forall e a.
 Exception e =>
 FlacMeta a -> (e -> FlacMeta a) -> FlacMeta a)
-> MonadCatch FlacMeta
FlacMeta a -> (e -> FlacMeta a) -> FlacMeta a
forall e a.
Exception e =>
FlacMeta a -> (e -> FlacMeta a) -> FlacMeta a
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: FlacMeta a -> (e -> FlacMeta a) -> FlacMeta a
$ccatch :: forall e a.
Exception e =>
FlacMeta a -> (e -> FlacMeta a) -> FlacMeta a
$cp1MonadCatch :: MonadThrow FlacMeta
MonadCatch,
      MonadCatch FlacMeta
MonadCatch FlacMeta =>
(forall b.
 ((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b)
-> (forall b.
    ((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b)
-> (forall a b c.
    FlacMeta a
    -> (a -> ExitCase b -> FlacMeta c)
    -> (a -> FlacMeta b)
    -> FlacMeta (b, c))
-> MonadMask FlacMeta
FlacMeta a
-> (a -> ExitCase b -> FlacMeta c)
-> (a -> FlacMeta b)
-> FlacMeta (b, c)
((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b
((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b
forall b.
((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b
forall a b c.
FlacMeta a
-> (a -> ExitCase b -> FlacMeta c)
-> (a -> FlacMeta b)
-> FlacMeta (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: FlacMeta a
-> (a -> ExitCase b -> FlacMeta c)
-> (a -> FlacMeta b)
-> FlacMeta (b, c)
$cgeneralBracket :: forall a b c.
FlacMeta a
-> (a -> ExitCase b -> FlacMeta c)
-> (a -> FlacMeta b)
-> FlacMeta (b, c)
uninterruptibleMask :: ((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b
$cuninterruptibleMask :: forall b.
((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b
mask :: ((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b
$cmask :: forall b.
((forall a. FlacMeta a -> FlacMeta a) -> FlacMeta b) -> FlacMeta b
$cp1MonadMask :: MonadCatch FlacMeta
MonadMask
    )

-- | A non-public shortcut for the inner monad stack of 'FlacMeta'.
type Inner a = ReaderT Context IO a

-- | The context that 'Inner' passes around.
data Context = Context
  { -- | Metadata chain
    Context -> MetaChain
metaChain :: MetaChain,
    -- | “Modified” flag
    Context -> IORef Bool
metaModified :: IORef Bool,
    -- | Size of target file
    Context -> Natural
metaFileSize :: Natural
  }

-- | Settings that control how metadata is written in FLAC file.
data MetaSettings = MetaSettings
  { -- | Whether to traverse all metadata blocks just before padding sorting
    -- (if enabled, see 'metaSortPadding') and writing data to a file,
    -- deleting all metadata blocks that appear to be empty, e.g. vorbis
    -- comment block without any comments (tags) in it. Default value:
    -- 'True'.
    MetaSettings -> Bool
metaAutoVacuum :: !Bool,
    -- | Whether to attempt to sort and consolidate all padding at the end
    -- of metadata section. The main purpose of this is that the padding can
    -- be truncated if necessary to get more space so we can overwrite
    -- metadata blocks in place instead of overwriting the entire FLAC file.
    -- Default value: 'True'.
    MetaSettings -> Bool
metaSortPadding :: !Bool,
    -- | This setting enables truncation of last padding metadata block if
    -- it allows to overwrite metadata in place instead of overwriting the
    -- entire file. Default value: 'True'.
    MetaSettings -> Bool
metaUsePadding :: !Bool,
    -- | If 'True', the owner and modification time will be preserved even
    -- if a new FLAC file is written (this is for the cases when we need to
    -- write entire FLAC file and thus a copy of the file is written).
    -- Default value: 'True'.
    MetaSettings -> Bool
metaPreserveFileStats :: !Bool
  }
  deriving (Int -> MetaSettings -> ShowS
[MetaSettings] -> ShowS
MetaSettings -> String
(Int -> MetaSettings -> ShowS)
-> (MetaSettings -> String)
-> ([MetaSettings] -> ShowS)
-> Show MetaSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaSettings] -> ShowS
$cshowList :: [MetaSettings] -> ShowS
show :: MetaSettings -> String
$cshow :: MetaSettings -> String
showsPrec :: Int -> MetaSettings -> ShowS
$cshowsPrec :: Int -> MetaSettings -> ShowS
Show, ReadPrec [MetaSettings]
ReadPrec MetaSettings
Int -> ReadS MetaSettings
ReadS [MetaSettings]
(Int -> ReadS MetaSettings)
-> ReadS [MetaSettings]
-> ReadPrec MetaSettings
-> ReadPrec [MetaSettings]
-> Read MetaSettings
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MetaSettings]
$creadListPrec :: ReadPrec [MetaSettings]
readPrec :: ReadPrec MetaSettings
$creadPrec :: ReadPrec MetaSettings
readList :: ReadS [MetaSettings]
$creadList :: ReadS [MetaSettings]
readsPrec :: Int -> ReadS MetaSettings
$creadsPrec :: Int -> ReadS MetaSettings
Read, MetaSettings -> MetaSettings -> Bool
(MetaSettings -> MetaSettings -> Bool)
-> (MetaSettings -> MetaSettings -> Bool) -> Eq MetaSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaSettings -> MetaSettings -> Bool
$c/= :: MetaSettings -> MetaSettings -> Bool
== :: MetaSettings -> MetaSettings -> Bool
$c== :: MetaSettings -> MetaSettings -> Bool
Eq, Eq MetaSettings
Eq MetaSettings =>
(MetaSettings -> MetaSettings -> Ordering)
-> (MetaSettings -> MetaSettings -> Bool)
-> (MetaSettings -> MetaSettings -> Bool)
-> (MetaSettings -> MetaSettings -> Bool)
-> (MetaSettings -> MetaSettings -> Bool)
-> (MetaSettings -> MetaSettings -> MetaSettings)
-> (MetaSettings -> MetaSettings -> MetaSettings)
-> Ord MetaSettings
MetaSettings -> MetaSettings -> Bool
MetaSettings -> MetaSettings -> Ordering
MetaSettings -> MetaSettings -> MetaSettings
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MetaSettings -> MetaSettings -> MetaSettings
$cmin :: MetaSettings -> MetaSettings -> MetaSettings
max :: MetaSettings -> MetaSettings -> MetaSettings
$cmax :: MetaSettings -> MetaSettings -> MetaSettings
>= :: MetaSettings -> MetaSettings -> Bool
$c>= :: MetaSettings -> MetaSettings -> Bool
> :: MetaSettings -> MetaSettings -> Bool
$c> :: MetaSettings -> MetaSettings -> Bool
<= :: MetaSettings -> MetaSettings -> Bool
$c<= :: MetaSettings -> MetaSettings -> Bool
< :: MetaSettings -> MetaSettings -> Bool
$c< :: MetaSettings -> MetaSettings -> Bool
compare :: MetaSettings -> MetaSettings -> Ordering
$ccompare :: MetaSettings -> MetaSettings -> Ordering
$cp1Ord :: Eq MetaSettings
Ord)

-- | Default 'MetaSettings'.
--
-- @since 0.2.0
defaultMetaSettings :: MetaSettings
defaultMetaSettings :: MetaSettings
defaultMetaSettings =
  $WMetaSettings :: Bool -> Bool -> Bool -> Bool -> MetaSettings
MetaSettings
    { metaAutoVacuum :: Bool
metaAutoVacuum = Bool
True,
      metaSortPadding :: Bool
metaSortPadding = Bool
True,
      metaUsePadding :: Bool
metaUsePadding = Bool
True,
      metaPreserveFileStats :: Bool
metaPreserveFileStats = Bool
True
    }

-- | Run an action that manipulates FLAC metadata. 'MetaSettings' control
-- subtle and rather low-level details of metadata editing, just pass 'def'
-- unless you know what you are doing. 'FilePath' specifies location of FLAC
-- file to read\/edit in the file system. 'FlacMeta' is a monadic action
-- that describes what to do with the metadata. Compose it from 'retrieve'
-- and @('=->')@.
--
-- The action will throw 'Data.Text.Encoding.Error.UnicodeException' if the
-- text data like Vorbis Comment entries cannot be read as a UTF-8-encoded
-- value.
--
-- If a problem occurs, 'MetaException' is thrown with attached
-- 'MetaChainStatus' that should help investigating what went wrong.
runFlacMeta ::
  MonadIO m =>
  -- | Settings to use
  MetaSettings ->
  -- | File to operate on
  FilePath ->
  -- | Actions to perform
  FlacMeta a ->
  -- | The result
  m a
runFlacMeta :: MetaSettings -> String -> FlacMeta a -> m a
runFlacMeta MetaSettings {..} path :: String
path m :: FlacMeta a
m = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a)
-> ((MetaChain -> IO a) -> IO a) -> (MetaChain -> IO a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaChain -> IO a) -> IO a
forall a. (MetaChain -> IO a) -> IO a
withChain ((MetaChain -> IO a) -> m a) -> (MetaChain -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \metaChain :: MetaChain
metaChain -> do
  IORef Bool
metaModified <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  Natural
metaFileSize <- Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> IO Integer -> IO Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
ReadMode Handle -> IO Integer
hFileSize
  (ReaderT Context IO a -> Context -> IO a)
-> Context -> ReaderT Context IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Context IO a -> Context -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Context :: MetaChain -> IORef Bool -> Natural -> Context
Context {..} (ReaderT Context IO a -> IO a) -> ReaderT Context IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    IO Bool -> Inner ()
liftBool (MetaChain -> String -> IO Bool
chainRead MetaChain
metaChain String
path)
    a
result <- FlacMeta a -> ReaderT Context IO a
forall a. FlacMeta a -> Inner a
unFlacMeta FlacMeta a
m
    Bool
modified <- IO Bool -> ReaderT Context IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
metaModified)
    Bool -> Inner () -> Inner ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
modified (Inner () -> Inner ()) -> Inner () -> Inner ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> Inner () -> Inner ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
metaAutoVacuum Inner ()
applyVacuum
      Bool -> Inner () -> Inner ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
metaSortPadding (Inner () -> Inner ()) -> Inner () -> Inner ()
forall a b. (a -> b) -> a -> b
$
        IO () -> Inner ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaChain -> IO ()
chainSortPadding MetaChain
metaChain)
      IO Bool -> Inner ()
liftBool
        (MetaChain -> Bool -> Bool -> IO Bool
chainWrite MetaChain
metaChain Bool
metaUsePadding Bool
metaPreserveFileStats)
    a -> ReaderT Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

----------------------------------------------------------------------------
-- Meta values

-- | A class for the types that specify which metadata attributes to
-- read\/write. It's not expected that users of the library will define new
-- metadata attributes other than via combination of the existing ones,
-- which is also useful. For example, 'Duration' and 'BitRate' are not read
-- from FLAC file metadata directly, but defined in terms of other
-- attributes.
class MetaValue a where
  -- | Type of data that corresponds to this metadata value. For example
  -- 'SampleRate' is represented by 'Word32' value in this library, and so
  -- @'MetaType' 'SampleRate' ~ 'Word32'@.
  type MetaType a :: Type

  -- | Associated type of the kind 'Constraint' that controls whether a
  -- particular piece of metadata is writable or not.
  type MetaWritable a :: Constraint

  -- | Given value that determines what to read, read it and return. Some
  -- metadata may be missing, in that case the function typically returns a
  -- value wrapped in 'Maybe'.
  retrieve :: a -> FlacMeta (MetaType a)

  -- | Given a value that determines what to write and a value to write,
  -- add\/replace a piece of metadata information. This is how you edit
  -- metadata. To delete something, set it to 'Nothing' (well, it should be
  -- something that /can be missing/, for example you cannot delete the
  -- 'SampleRate' attribute). If 'MetaWritable' is defined, this method must
  -- be defined as well.
  (=->) :: MetaWritable a => a -> MetaType a -> FlacMeta ()
  _ =-> _ = String -> FlacMeta ()
forall a. HasCallStack => String -> a
error "Codec.Audio.FLAC.Metadata.(=->) is not defined"

infix 1 =->

type NotWritable = 'Text "This attribute is not writable."

-- | Minimal block size in samples used in the stream.
--
-- __Read-only__ attribute represented as a 'Word32'.
data MinBlockSize = MinBlockSize

instance MetaValue MinBlockSize where
  type MetaType MinBlockSize = Word32
  type MetaWritable MinBlockSize = TypeError NotWritable
  retrieve :: MinBlockSize -> FlacMeta (MetaType MinBlockSize)
retrieve MinBlockSize = (Metadata -> IO Word32) -> FlacMeta Word32
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO Word32
getMinBlockSize

-- | Maximal block size in samples used in the stream. Equality of minimum
-- block size and maximum block size implies a fixed-blocksize stream.
--
-- __Read-only__ attribute represented as a 'Word32'.
data MaxBlockSize = MaxBlockSize

instance MetaValue MaxBlockSize where
  type MetaType MaxBlockSize = Word32
  type MetaWritable MaxBlockSize = TypeError NotWritable
  retrieve :: MaxBlockSize -> FlacMeta (MetaType MaxBlockSize)
retrieve MaxBlockSize = (Metadata -> IO Word32) -> FlacMeta Word32
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO Word32
getMaxBlockSize

-- | Minimal frame size in bytes used in the stream. May be 0 to imply the
-- value is not known.
--
-- __Read-only__ attribute represented as a 'Word32'.
data MinFrameSize = MinFrameSize

instance MetaValue MinFrameSize where
  type MetaType MinFrameSize = Word32
  type MetaWritable MinFrameSize = TypeError NotWritable
  retrieve :: MinFrameSize -> FlacMeta (MetaType MinFrameSize)
retrieve MinFrameSize = (Metadata -> IO Word32) -> FlacMeta Word32
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO Word32
getMinFrameSize

-- | Maximal frame size in bytes used in the stream. May be 0 to imply the
-- value is not known.
--
-- __Read-only__ attribute represented as a 'Word32'.
data MaxFrameSize = MaxFrameSize

instance MetaValue MaxFrameSize where
  type MetaType MaxFrameSize = Word32
  type MetaWritable MaxFrameSize = TypeError NotWritable
  retrieve :: MaxFrameSize -> FlacMeta (MetaType MaxFrameSize)
retrieve MaxFrameSize = (Metadata -> IO Word32) -> FlacMeta Word32
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO Word32
getMaxFrameSize

-- | Sample rate in Hz.
--
-- __Read-only__ attribute represented as a 'Word32'.
data SampleRate = SampleRate

instance MetaValue SampleRate where
  type MetaType SampleRate = Word32
  type MetaWritable SampleRate = TypeError NotWritable
  retrieve :: SampleRate -> FlacMeta (MetaType SampleRate)
retrieve SampleRate = (Metadata -> IO Word32) -> FlacMeta Word32
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO Word32
getSampleRate

-- | Number of channels. FLAC supports from 1 to 8 channels.
--
-- __Read-only__ attribute represented as a 'Word32'.
data Channels = Channels

instance MetaValue Channels where
  type MetaType Channels = Word32
  type MetaWritable Channels = TypeError NotWritable
  retrieve :: Channels -> FlacMeta (MetaType Channels)
retrieve Channels = (Metadata -> IO Word32) -> FlacMeta Word32
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO Word32
getChannels

-- | Channel mask specifying which speaker positions are present. This is
-- inferred from number of channels using channel assignment rules described
-- in the FLAC specification.
--
-- __Read-only__ attribute represented as @'Set' 'SpeakerPosition'@.
data ChannelMask = ChannelMask

instance MetaValue ChannelMask where
  type MetaType ChannelMask = Set SpeakerPosition
  type MetaWritable ChannelMask = TypeError NotWritable
  retrieve :: ChannelMask -> FlacMeta (MetaType ChannelMask)
retrieve ChannelMask = Word32 -> Set SpeakerPosition
toChannelMask (Word32 -> Set SpeakerPosition)
-> FlacMeta Word32 -> FlacMeta (Set SpeakerPosition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Channels -> FlacMeta (MetaType Channels)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve Channels
Channels

-- | Bits per sample (sample depth). FLAC supports from 4 to 32 bits per
-- sample. Currently the reference encoder and decoder only support up to 24
-- bits per sample.
--
-- __Read-only__ attribute represented as a 'Word32'.
data BitsPerSample = BitsPerSample

instance MetaValue BitsPerSample where
  type MetaType BitsPerSample = Word32
  type MetaWritable BitsPerSample = TypeError NotWritable
  retrieve :: BitsPerSample -> FlacMeta (MetaType BitsPerSample)
retrieve BitsPerSample = (Metadata -> IO Word32) -> FlacMeta Word32
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO Word32
getBitsPerSample

-- | Total number of samples in audio stream. “Samples” means inter-channel
-- sample, i.e. one second of 44.1 KHz audio will have 44100 samples
-- regardless of the number of channels. A value of zero here means the
-- number of total samples is unknown.
--
-- __Read-only__ attribute represented as a 'Word64'.
data TotalSamples = TotalSamples

instance MetaValue TotalSamples where
  type MetaType TotalSamples = Word64
  type MetaWritable TotalSamples = TypeError NotWritable
  retrieve :: TotalSamples -> FlacMeta (MetaType TotalSamples)
retrieve TotalSamples = (Metadata -> IO Word64) -> FlacMeta Word64
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO Word64
getTotalSamples

-- | File size in bytes.
--
-- __Read-only__ attribute represented as a 'Natural'.
data FileSize = FileSize

instance MetaValue FileSize where
  type MetaType FileSize = Natural
  type MetaWritable FileSize = TypeError NotWritable
  retrieve :: FileSize -> FlacMeta (MetaType FileSize)
retrieve FileSize = Inner Natural -> FlacMeta Natural
forall a. Inner a -> FlacMeta a
FlacMeta ((Context -> Natural) -> Inner Natural
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> Natural
metaFileSize)

-- | Bit rate in kilo-bits per second (kbps).
--
-- __Read-only__ attribute represented as a 'Word32'.
data BitRate = BitRate

instance MetaValue BitRate where
  type MetaType BitRate = Word32
  type MetaWritable BitRate = TypeError NotWritable
  retrieve :: BitRate -> FlacMeta (MetaType BitRate)
retrieve BitRate = do
    Double
fileSize <- Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Double) -> FlacMeta Natural -> FlacMeta Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileSize -> FlacMeta (MetaType FileSize)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve FileSize
FileSize
    Double
duration <- Duration -> FlacMeta (MetaType Duration)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve Duration
Duration
    -- NOTE 8 / 1000 = 125, (* 8) to get bits, (/ 1000) to get kilos
    (Word32 -> FlacMeta Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> FlacMeta Word32)
-> (Double -> Word32) -> Double -> FlacMeta Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
floor) (Double
fileSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
duration Double -> Double -> Double
forall a. Num a => a -> a -> a
* 125))

-- | MD5 signature of the unencoded audio data. This allows the decoder to
-- determine if an error exists in the audio data even when the error does
-- not result in an invalid bitstream.
--
-- __Read-only__ attribute represented as a 'ByteString' of length 16.
data MD5Sum = MD5Sum

instance MetaValue MD5Sum where
  type MetaType MD5Sum = ByteString
  type MetaWritable MD5Sum = TypeError NotWritable
  retrieve :: MD5Sum -> FlacMeta (MetaType MD5Sum)
retrieve MD5Sum = (Metadata -> IO ByteString) -> FlacMeta ByteString
forall a. (Metadata -> IO a) -> FlacMeta a
inStreamInfo Metadata -> IO ByteString
getMd5Sum

-- | Duration in seconds.
--
-- __Read-only__ attribute represented as a 'Double'.
data Duration = Duration

instance MetaValue Duration where
  type MetaType Duration = Double
  type MetaWritable Duration = TypeError NotWritable
  retrieve :: Duration -> FlacMeta (MetaType Duration)
retrieve Duration = do
    Double
totalSamples <- Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Double) -> FlacMeta Word64 -> FlacMeta Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TotalSamples -> FlacMeta (MetaType TotalSamples)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve TotalSamples
TotalSamples
    Double
sampleRate <- Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Double) -> FlacMeta Word32 -> FlacMeta Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SampleRate -> FlacMeta (MetaType SampleRate)
forall a. MetaValue a => a -> FlacMeta (MetaType a)
retrieve SampleRate
SampleRate
    Double -> FlacMeta Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
totalSamples Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sampleRate)

-- | Application metadata. The 'ApplicationId' argument to 'Application'
-- data constructor can be written using usual Haskell syntax for 'String'
-- literals, just make sure to enable the @OverloadedStrings@ extension.
--
-- For the list of defined application IDs, see:
--
-- <https://xiph.org/flac/id.html>.
--
-- __Writable__ optional attribute represented as a @'Maybe' 'ByteString'@.
data Application = Application ApplicationId

instance MetaValue Application where
  type MetaType Application = Maybe ByteString
  type MetaWritable Application = ()
  retrieve :: Application -> FlacMeta (MetaType Application)
retrieve (Application appId :: ApplicationId
appId) =
    Inner (Maybe ByteString) -> FlacMeta (Maybe ByteString)
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ByteString) -> FlacMeta (Maybe ByteString))
-> ((MetaIterator -> Inner ByteString) -> Inner (Maybe ByteString))
-> (MetaIterator -> Inner ByteString)
-> FlacMeta (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplicationId
-> (MetaIterator -> Inner ByteString) -> Inner (Maybe ByteString)
forall a.
ApplicationId -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withApplicationBlock ApplicationId
appId ((MetaIterator -> Inner ByteString)
 -> FlacMeta (MetaType Application))
-> (MetaIterator -> Inner ByteString)
-> FlacMeta (MetaType Application)
forall a b. (a -> b) -> a -> b
$
      IO ByteString -> Inner ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Inner ByteString)
-> (MetaIterator -> IO ByteString)
-> MetaIterator
-> Inner ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaIterator -> IO Metadata
iteratorGetBlock (MetaIterator -> IO Metadata)
-> (Metadata -> IO ByteString) -> MetaIterator -> IO ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> IO ByteString
getApplicationData)
  Application appId :: ApplicationId
appId =-> :: Application -> MetaType Application -> FlacMeta ()
=-> Nothing =
    FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplicationId -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
ApplicationId -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withApplicationBlock ApplicationId
appId ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
      Inner ()
setModified
  Application appId :: ApplicationId
appId =-> Just data' =
    Inner () -> FlacMeta ()
forall a. Inner a -> FlacMeta a
FlacMeta (Inner () -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> Inner ())
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplicationId -> (MetaIterator -> Inner ()) -> Inner ()
forall a. ApplicationId -> (MetaIterator -> Inner a) -> Inner a
withApplicationBlock' ApplicationId
appId ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
      IO Bool -> Inner ()
liftBool (Metadata -> ByteString -> IO Bool
setApplicationData Metadata
block ByteString
data')
      Inner ()
setModified

-- | Seek table as a 'Vector' of 'SeekPoint's. Seek points within a table
-- must be sorted in ascending order by sample number. If you try to write
-- an invalid seek table, 'MetaException' will be raised using the
-- 'MetaInvalidSeekTable' constructor.
--
-- __Writable__ optional attribute represented as a @'Maybe' ('Vector'
-- 'SeekPoint')@.
data SeekTable = SeekTable

instance MetaValue SeekTable where
  type MetaType SeekTable = Maybe (Vector SeekPoint)
  type MetaWritable SeekTable = ()
  retrieve :: SeekTable -> FlacMeta (MetaType SeekTable)
retrieve SeekTable =
    Inner (Maybe (Vector SeekPoint))
-> FlacMeta (Maybe (Vector SeekPoint))
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe (Vector SeekPoint))
 -> FlacMeta (Maybe (Vector SeekPoint)))
-> ((MetaIterator -> Inner (Vector SeekPoint))
    -> Inner (Maybe (Vector SeekPoint)))
-> (MetaIterator -> Inner (Vector SeekPoint))
-> FlacMeta (Maybe (Vector SeekPoint))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType
-> (MetaIterator -> Inner (Vector SeekPoint))
-> Inner (Maybe (Vector SeekPoint))
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
SeekTableBlock ((MetaIterator -> Inner (Vector SeekPoint))
 -> FlacMeta (MetaType SeekTable))
-> (MetaIterator -> Inner (Vector SeekPoint))
-> FlacMeta (MetaType SeekTable)
forall a b. (a -> b) -> a -> b
$
      IO (Vector SeekPoint) -> Inner (Vector SeekPoint)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector SeekPoint) -> Inner (Vector SeekPoint))
-> (MetaIterator -> IO (Vector SeekPoint))
-> MetaIterator
-> Inner (Vector SeekPoint)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaIterator -> IO Metadata
iteratorGetBlock (MetaIterator -> IO Metadata)
-> (Metadata -> IO (Vector SeekPoint))
-> MetaIterator
-> IO (Vector SeekPoint)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> IO (Vector SeekPoint)
getSeekPoints)
  SeekTable =-> :: SeekTable -> MetaType SeekTable -> FlacMeta ()
=-> Nothing =
    FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
SeekTableBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
      Inner ()
setModified
  SeekTable =-> Just seekPoints =
    Inner () -> FlacMeta ()
forall a. Inner a -> FlacMeta a
FlacMeta (Inner () -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> Inner ())
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner ()
forall a. MetadataType -> (MetaIterator -> Inner a) -> Inner a
withMetaBlock' MetadataType
SeekTableBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
      IO Bool -> Inner ()
liftBool (Metadata -> Vector SeekPoint -> IO Bool
setSeekPoints Metadata
block Vector SeekPoint
seekPoints)
      Inner ()
setModified

-- | Vorbis “vendor” comment. When “Vorbis Comment” metadata block is
-- present, the “vendor” entry is always in there, so when you delete it (by
-- @'VorbisVendor' '=->' 'Nothing'@), you really set it to an empty string
-- (which is enough to trigger auto vacuum feature if no other entries are
-- detected, see 'metaAutoVacuum').
--
-- __Writable__ optional attribute represented as a @'Maybe' 'Text'@.
data VorbisVendor = VorbisVendor

instance MetaValue VorbisVendor where
  type MetaType VorbisVendor = Maybe Text
  type MetaWritable VorbisVendor = ()
  retrieve :: VorbisVendor -> FlacMeta (MetaType VorbisVendor)
retrieve VorbisVendor =
    Inner (Maybe Text) -> FlacMeta (Maybe Text)
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe Text) -> FlacMeta (Maybe Text))
-> ((MetaIterator -> Inner Text) -> Inner (Maybe Text))
-> (MetaIterator -> Inner Text)
-> FlacMeta (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner Text) -> Inner (Maybe Text)
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
VorbisCommentBlock ((MetaIterator -> Inner Text) -> FlacMeta (MetaType VorbisVendor))
-> (MetaIterator -> Inner Text) -> FlacMeta (MetaType VorbisVendor)
forall a b. (a -> b) -> a -> b
$
      IO Text -> Inner Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Inner Text)
-> (MetaIterator -> IO Text) -> MetaIterator -> Inner Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaIterator -> IO Metadata
iteratorGetBlock (MetaIterator -> IO Metadata)
-> (Metadata -> IO Text) -> MetaIterator -> IO Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> IO Text
getVorbisVendor)
  VorbisVendor =-> :: VorbisVendor -> MetaType VorbisVendor -> FlacMeta ()
=-> Nothing =
    FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
VorbisCommentBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
      IO Bool -> Inner ()
liftBool (Metadata -> Text -> IO Bool
setVorbisVendor Metadata
block "")
      Inner ()
setModified
  VorbisVendor =-> (Just value) =
    Inner () -> FlacMeta ()
forall a. Inner a -> FlacMeta a
FlacMeta (Inner () -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> Inner ())
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner ()
forall a. MetadataType -> (MetaIterator -> Inner a) -> Inner a
withMetaBlock' MetadataType
VorbisCommentBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
      IO Bool -> Inner ()
liftBool (Metadata -> Text -> IO Bool
setVorbisVendor Metadata
block Text
value)
      Inner ()
setModified

-- | Various Vorbis comments, see 'VorbisField' for available field names.
-- The field names are mostly taken from here:
--
-- <https://www.xiph.org/vorbis/doc/v-comment.html>.
--
-- 'TrackTotal', 'DiscNumber', and 'Rating' are popular de-facto standard
-- fields. The library also supports the standard ReplayGain comments.
--
-- __Writable__ optional attribute represented as a @'Maybe' 'Text'@.
data VorbisComment = VorbisComment VorbisField

-- | Enumeration of all supported filed names to index vorbis comment
-- entries.
data VorbisField
  = -- | Track\/work name.
    Title
  | -- | The version field may be used to differentiate
    -- multiple versions of the same track title in a
    -- single collection (e.g. remix info).
    Version
  | -- | The collection name to which this track belongs.
    Album
  | -- | The track number of this piece if part of a
    -- specific larger collection or album.
    TrackNumber
  | -- | Total number of tracks in the collection this
    -- track belongs to.
    TrackTotal
  | -- | Disc number in a multi-disc release.
    DiscNumber
  | -- | Total number of discs in a multi-disc release.
    DiscTotal
  | -- | The artist generally considered responsible for
    -- the work. In popular music this is usually the
    -- performing band or singer. For classical music it
    -- would be the composer. For an audio book it would
    -- be the author of the original text.
    Artist
  | -- | The artist(s) who performed the work. In
    -- classical music this would be the conductor,
    -- orchestra, soloists. In an audio book it would be
    -- the actor who did the reading. In popular music
    -- this is typically the same as the 'Artist' and is
    -- omitted.
    Performer
  | -- | Copyright attribution, e.g., “2001 Nobody's
    -- Band” or “1999 Jack Moffitt”.
    Copyright
  | -- | License information, e.g., “All Rights
    -- Reserved”, “Any Use Permitted”, a URL to a license
    -- such as a Creative Commons license or the EFF Open
    -- Audio License, etc.
    License
  | -- | Name of the organization producing the track
    -- (i.e. the “record label”).
    Organization
  | -- | A short text description of the contents.
    Description
  | -- | A short text indication of music genre.
    Genre
  | -- | Date the track was recorded, usually year.
    Date
  | -- | Location where track was recorded.
    Location
  | -- | Contact information for the creators or
    -- distributors of the track. This could be a URL, an
    -- email address, the physical address of the
    -- producing label.
    Contact
  | -- | ISRC number for the track, see
    -- <http://isrc.ifpi.org/en>.
    ISRC
  | -- | Rating, usually mapped as 1–5 stars with actual
    -- values “20”, “40”, “60”, “80”, “100” stored.
    Rating
  | -- | Replay gain track peak, e.g. “0.99996948”.
    RGTrackPeak
  | -- | Replay gain track gain, e.g. “-7.89 dB”.
    RGTrackGain
  | -- | Replay gain album peak, e.g. “0.99996948”.
    RGAlbumPeak
  | -- | Replay gain album gain, e.g. “-7.89 dB”.
    RGAlbumGain
  deriving (Int -> VorbisField -> ShowS
[VorbisField] -> ShowS
VorbisField -> String
(Int -> VorbisField -> ShowS)
-> (VorbisField -> String)
-> ([VorbisField] -> ShowS)
-> Show VorbisField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VorbisField] -> ShowS
$cshowList :: [VorbisField] -> ShowS
show :: VorbisField -> String
$cshow :: VorbisField -> String
showsPrec :: Int -> VorbisField -> ShowS
$cshowsPrec :: Int -> VorbisField -> ShowS
Show, ReadPrec [VorbisField]
ReadPrec VorbisField
Int -> ReadS VorbisField
ReadS [VorbisField]
(Int -> ReadS VorbisField)
-> ReadS [VorbisField]
-> ReadPrec VorbisField
-> ReadPrec [VorbisField]
-> Read VorbisField
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VorbisField]
$creadListPrec :: ReadPrec [VorbisField]
readPrec :: ReadPrec VorbisField
$creadPrec :: ReadPrec VorbisField
readList :: ReadS [VorbisField]
$creadList :: ReadS [VorbisField]
readsPrec :: Int -> ReadS VorbisField
$creadsPrec :: Int -> ReadS VorbisField
Read, VorbisField -> VorbisField -> Bool
(VorbisField -> VorbisField -> Bool)
-> (VorbisField -> VorbisField -> Bool) -> Eq VorbisField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VorbisField -> VorbisField -> Bool
$c/= :: VorbisField -> VorbisField -> Bool
== :: VorbisField -> VorbisField -> Bool
$c== :: VorbisField -> VorbisField -> Bool
Eq, Eq VorbisField
Eq VorbisField =>
(VorbisField -> VorbisField -> Ordering)
-> (VorbisField -> VorbisField -> Bool)
-> (VorbisField -> VorbisField -> Bool)
-> (VorbisField -> VorbisField -> Bool)
-> (VorbisField -> VorbisField -> Bool)
-> (VorbisField -> VorbisField -> VorbisField)
-> (VorbisField -> VorbisField -> VorbisField)
-> Ord VorbisField
VorbisField -> VorbisField -> Bool
VorbisField -> VorbisField -> Ordering
VorbisField -> VorbisField -> VorbisField
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VorbisField -> VorbisField -> VorbisField
$cmin :: VorbisField -> VorbisField -> VorbisField
max :: VorbisField -> VorbisField -> VorbisField
$cmax :: VorbisField -> VorbisField -> VorbisField
>= :: VorbisField -> VorbisField -> Bool
$c>= :: VorbisField -> VorbisField -> Bool
> :: VorbisField -> VorbisField -> Bool
$c> :: VorbisField -> VorbisField -> Bool
<= :: VorbisField -> VorbisField -> Bool
$c<= :: VorbisField -> VorbisField -> Bool
< :: VorbisField -> VorbisField -> Bool
$c< :: VorbisField -> VorbisField -> Bool
compare :: VorbisField -> VorbisField -> Ordering
$ccompare :: VorbisField -> VorbisField -> Ordering
$cp1Ord :: Eq VorbisField
Ord, VorbisField
VorbisField -> VorbisField -> Bounded VorbisField
forall a. a -> a -> Bounded a
maxBound :: VorbisField
$cmaxBound :: VorbisField
minBound :: VorbisField
$cminBound :: VorbisField
Bounded, Int -> VorbisField
VorbisField -> Int
VorbisField -> [VorbisField]
VorbisField -> VorbisField
VorbisField -> VorbisField -> [VorbisField]
VorbisField -> VorbisField -> VorbisField -> [VorbisField]
(VorbisField -> VorbisField)
-> (VorbisField -> VorbisField)
-> (Int -> VorbisField)
-> (VorbisField -> Int)
-> (VorbisField -> [VorbisField])
-> (VorbisField -> VorbisField -> [VorbisField])
-> (VorbisField -> VorbisField -> [VorbisField])
-> (VorbisField -> VorbisField -> VorbisField -> [VorbisField])
-> Enum VorbisField
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VorbisField -> VorbisField -> VorbisField -> [VorbisField]
$cenumFromThenTo :: VorbisField -> VorbisField -> VorbisField -> [VorbisField]
enumFromTo :: VorbisField -> VorbisField -> [VorbisField]
$cenumFromTo :: VorbisField -> VorbisField -> [VorbisField]
enumFromThen :: VorbisField -> VorbisField -> [VorbisField]
$cenumFromThen :: VorbisField -> VorbisField -> [VorbisField]
enumFrom :: VorbisField -> [VorbisField]
$cenumFrom :: VorbisField -> [VorbisField]
fromEnum :: VorbisField -> Int
$cfromEnum :: VorbisField -> Int
toEnum :: Int -> VorbisField
$ctoEnum :: Int -> VorbisField
pred :: VorbisField -> VorbisField
$cpred :: VorbisField -> VorbisField
succ :: VorbisField -> VorbisField
$csucc :: VorbisField -> VorbisField
Enum)

instance MetaValue VorbisComment where
  type MetaType VorbisComment = Maybe Text
  type MetaWritable VorbisComment = ()
  retrieve :: VorbisComment -> FlacMeta (MetaType VorbisComment)
retrieve (VorbisComment field :: VorbisField
field) =
    Inner (Maybe Text) -> FlacMeta (Maybe Text)
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe Text) -> FlacMeta (Maybe Text))
-> ((MetaIterator -> Inner (Maybe Text)) -> Inner (Maybe Text))
-> (MetaIterator -> Inner (Maybe Text))
-> FlacMeta (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Maybe Text) -> Maybe Text)
-> ReaderT Context IO (Maybe (Maybe Text)) -> Inner (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe Text) -> Maybe Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ReaderT Context IO (Maybe (Maybe Text)) -> Inner (Maybe Text))
-> ((MetaIterator -> Inner (Maybe Text))
    -> ReaderT Context IO (Maybe (Maybe Text)))
-> (MetaIterator -> Inner (Maybe Text))
-> Inner (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType
-> (MetaIterator -> Inner (Maybe Text))
-> ReaderT Context IO (Maybe (Maybe Text))
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
VorbisCommentBlock ((MetaIterator -> Inner (Maybe Text))
 -> FlacMeta (MetaType VorbisComment))
-> (MetaIterator -> Inner (Maybe Text))
-> FlacMeta (MetaType VorbisComment)
forall a b. (a -> b) -> a -> b
$
      IO (Maybe Text) -> Inner (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> Inner (Maybe Text))
-> (MetaIterator -> IO (Maybe Text))
-> MetaIterator
-> Inner (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaIterator -> IO Metadata
iteratorGetBlock (MetaIterator -> IO Metadata)
-> (Metadata -> IO (Maybe Text)) -> MetaIterator -> IO (Maybe Text)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Metadata -> IO (Maybe Text)
getVorbisComment (VorbisField -> ByteString
vorbisFieldName VorbisField
field))
  VorbisComment field :: VorbisField
field =-> :: VorbisComment -> MetaType VorbisComment -> FlacMeta ()
=-> Nothing =
    FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
VorbisCommentBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
      IO Bool -> Inner ()
liftBool (ByteString -> Metadata -> IO Bool
deleteVorbisComment (VorbisField -> ByteString
vorbisFieldName VorbisField
field) Metadata
block)
      Inner ()
setModified
  VorbisComment field :: VorbisField
field =-> Just value =
    Inner () -> FlacMeta ()
forall a. Inner a -> FlacMeta a
FlacMeta (Inner () -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> Inner ())
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner ()
forall a. MetadataType -> (MetaIterator -> Inner a) -> Inner a
withMetaBlock' MetadataType
VorbisCommentBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
      IO Bool -> Inner ()
liftBool (ByteString -> Text -> Metadata -> IO Bool
setVorbisComment (VorbisField -> ByteString
vorbisFieldName VorbisField
field) Text
value Metadata
block)
      Inner ()
setModified

-- | A CUE sheet stored in FLAC metadata. If you try to write an invalid CUE
-- sheet 'MetaException' will be raised with the 'MetaInvalidCueSheet'
-- constructor which includes a 'Text' value with explanation why the CUE
-- sheet was considered invalid. Import "Codec.Audio.FLAC.Metadata.CueSheet"
-- to manipulate 'CueSheetData' and 'CueTrack's.
--
-- __Writable__ optional attribute represented as a @'Maybe' 'CueSheetData'@.
data CueSheet = CueSheet

instance MetaValue CueSheet where
  type MetaType CueSheet = Maybe CueSheetData
  type MetaWritable CueSheet = ()
  retrieve :: CueSheet -> FlacMeta (MetaType CueSheet)
retrieve CueSheet =
    Inner (Maybe CueSheetData) -> FlacMeta (Maybe CueSheetData)
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe CueSheetData) -> FlacMeta (Maybe CueSheetData))
-> ((MetaIterator -> Inner CueSheetData)
    -> Inner (Maybe CueSheetData))
-> (MetaIterator -> Inner CueSheetData)
-> FlacMeta (Maybe CueSheetData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType
-> (MetaIterator -> Inner CueSheetData)
-> Inner (Maybe CueSheetData)
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
CueSheetBlock ((MetaIterator -> Inner CueSheetData)
 -> FlacMeta (MetaType CueSheet))
-> (MetaIterator -> Inner CueSheetData)
-> FlacMeta (MetaType CueSheet)
forall a b. (a -> b) -> a -> b
$
      IO CueSheetData -> Inner CueSheetData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CueSheetData -> Inner CueSheetData)
-> (MetaIterator -> IO CueSheetData)
-> MetaIterator
-> Inner CueSheetData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaIterator -> IO Metadata
iteratorGetBlock (MetaIterator -> IO Metadata)
-> (Metadata -> IO CueSheetData) -> MetaIterator -> IO CueSheetData
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> IO CueSheetData
getCueSheetData)
  CueSheet =-> :: CueSheet -> MetaType CueSheet -> FlacMeta ()
=-> Nothing =
    FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
CueSheetBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
      Inner ()
setModified
  CueSheet =-> Just cueSheetData =
    Inner () -> FlacMeta ()
forall a. Inner a -> FlacMeta a
FlacMeta (Inner () -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> Inner ())
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner ()
forall a. MetadataType -> (MetaIterator -> Inner a) -> Inner a
withMetaBlock' MetadataType
CueSheetBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
      IO Bool -> Inner ()
liftBool (Metadata -> CueSheetData -> IO Bool
setCueSheetData Metadata
block CueSheetData
cueSheetData)
      Inner ()
setModified

-- | Picture embedded in FLAC file. A FLAC file can have several pictures
-- attached to it, you choose which one you want by specifying
-- 'PictureType'. If you try to write an invalid picture 'MetaException'
-- will be raised with 'MetaInvalidPicture' constructor which includes a
-- 'Text' value with explanation why the picture was considered invalid.
--
-- Note that the @flac-picture@
-- <https://hackage.haskell.org/package/flac-picture> package allows to work
-- with 'PictureData' easier using the @Juicy-Pixels@ library.
--
-- __Writable__ optional attribute represented as a @'Maybe' 'PictureData'@.
data Picture = Picture PictureType

instance MetaValue Picture where
  type MetaType Picture = Maybe PictureData
  type MetaWritable Picture = ()
  retrieve :: Picture -> FlacMeta (MetaType Picture)
retrieve (Picture pictureType :: PictureType
pictureType) =
    Inner (Maybe PictureData) -> FlacMeta (Maybe PictureData)
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe PictureData) -> FlacMeta (Maybe PictureData))
-> ((MetaIterator -> Inner PictureData)
    -> Inner (Maybe PictureData))
-> (MetaIterator -> Inner PictureData)
-> FlacMeta (Maybe PictureData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PictureType
-> (MetaIterator -> Inner PictureData) -> Inner (Maybe PictureData)
forall a.
PictureType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withPictureBlock PictureType
pictureType ((MetaIterator -> Inner PictureData)
 -> FlacMeta (MetaType Picture))
-> (MetaIterator -> Inner PictureData)
-> FlacMeta (MetaType Picture)
forall a b. (a -> b) -> a -> b
$
      IO PictureData -> Inner PictureData
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PictureData -> Inner PictureData)
-> (MetaIterator -> IO PictureData)
-> MetaIterator
-> Inner PictureData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaIterator -> IO Metadata
iteratorGetBlock (MetaIterator -> IO Metadata)
-> (Metadata -> IO PictureData) -> MetaIterator -> IO PictureData
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> IO PictureData
getPictureData)
  Picture pictureType :: PictureType
pictureType =-> :: Picture -> MetaType Picture -> FlacMeta ()
=-> Nothing =
    FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PictureType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
PictureType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withPictureBlock PictureType
pictureType ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
      Inner ()
setModified
  Picture pictureType :: PictureType
pictureType =-> Just pictureData =
    FlacMeta () -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta () -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner () -> FlacMeta ()
forall a. Inner a -> FlacMeta a
FlacMeta (Inner () -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> Inner ())
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PictureType -> (MetaIterator -> Inner ()) -> Inner ()
forall a. PictureType -> (MetaIterator -> Inner a) -> Inner a
withPictureBlock' PictureType
pictureType ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
      IO Bool -> Inner ()
liftBool (Metadata -> PictureData -> IO Bool
setPictureData Metadata
block PictureData
pictureData)
      Inner ()
setModified

----------------------------------------------------------------------------
-- Extra functionality

-- | Delete all “Vorbis comment” metadata blocks.
wipeVorbisComment :: FlacMeta ()
wipeVorbisComment :: FlacMeta ()
wipeVorbisComment =
  FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
VorbisCommentBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
    IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
    Inner ()
setModified

-- | Delete all “Application” metadata blocks.
wipeApplications :: FlacMeta ()
wipeApplications :: FlacMeta ()
wipeApplications =
  FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
ApplicationBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
    IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
    Inner ()
setModified

-- | Delete all “Seek table” metadata blocks.
wipeSeekTable :: FlacMeta ()
wipeSeekTable :: FlacMeta ()
wipeSeekTable =
  FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
SeekTableBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
    IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
    Inner ()
setModified

-- | Delete all “CUE sheet” metadata blocks.
wipeCueSheets :: FlacMeta ()
wipeCueSheets :: FlacMeta ()
wipeCueSheets =
  FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
CueSheetBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
    IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
    Inner ()
setModified

-- | Delete all “Picture” metadata blocks.
wipePictures :: FlacMeta ()
wipePictures :: FlacMeta ()
wipePictures =
  FlacMeta (Maybe ()) -> FlacMeta ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (FlacMeta (Maybe ()) -> FlacMeta ())
-> ((MetaIterator -> Inner ()) -> FlacMeta (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inner (Maybe ()) -> FlacMeta (Maybe ())
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (Maybe ()) -> FlacMeta (Maybe ()))
-> ((MetaIterator -> Inner ()) -> Inner (Maybe ()))
-> (MetaIterator -> Inner ())
-> FlacMeta (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType -> (MetaIterator -> Inner ()) -> Inner (Maybe ())
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
PictureBlock ((MetaIterator -> Inner ()) -> FlacMeta ())
-> (MetaIterator -> Inner ()) -> FlacMeta ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
    IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
    Inner ()
setModified

----------------------------------------------------------------------------
-- Debugging and testing

-- | Return a list of all 'MetadataType's of metadata blocks detected in
-- order.
getMetaChain :: FlacMeta (NonEmpty MetadataType)
getMetaChain :: FlacMeta (NonEmpty MetadataType)
getMetaChain = Inner (NonEmpty MetadataType) -> FlacMeta (NonEmpty MetadataType)
forall a. Inner a -> FlacMeta a
FlacMeta (Inner (NonEmpty MetadataType) -> FlacMeta (NonEmpty MetadataType))
-> Inner (NonEmpty MetadataType)
-> FlacMeta (NonEmpty MetadataType)
forall a b. (a -> b) -> a -> b
$ do
  MetaChain
chain <- (Context -> MetaChain) -> ReaderT Context IO MetaChain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> MetaChain
metaChain
  [MetadataType] -> NonEmpty MetadataType
forall a. [a] -> NonEmpty a
NE.fromList ([MetadataType] -> NonEmpty MetadataType)
-> ReaderT Context IO [MetadataType]
-> Inner (NonEmpty MetadataType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaChain
-> (MetaIterator -> ReaderT Context IO (Maybe MetadataType))
-> ReaderT Context IO [MetadataType]
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
MetaChain -> (MetaIterator -> m (Maybe a)) -> m [a]
withIterator MetaChain
chain ((MetadataType -> Maybe MetadataType)
-> ReaderT Context IO MetadataType
-> ReaderT Context IO (Maybe MetadataType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetadataType -> Maybe MetadataType
forall a. a -> Maybe a
Just (ReaderT Context IO MetadataType
 -> ReaderT Context IO (Maybe MetadataType))
-> (MetaIterator -> ReaderT Context IO MetadataType)
-> MetaIterator
-> ReaderT Context IO (Maybe MetadataType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO MetadataType -> ReaderT Context IO MetadataType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetadataType -> ReaderT Context IO MetadataType)
-> (MetaIterator -> IO MetadataType)
-> MetaIterator
-> ReaderT Context IO MetadataType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaIterator -> IO MetadataType
iteratorGetBlockType)

-- | Return 'True' if actions in current 'FlacMeta' context have modified
-- FLAC metadata. If so, the FLAC file will be updated to reflect these
-- changes on the way out from the 'FlacMeta' monad.
isMetaChainModified :: FlacMeta Bool
isMetaChainModified :: FlacMeta Bool
isMetaChainModified = ReaderT Context IO Bool -> FlacMeta Bool
forall a. Inner a -> FlacMeta a
FlacMeta ((Context -> IORef Bool) -> ReaderT Context IO (IORef Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> IORef Bool
metaModified ReaderT Context IO (IORef Bool)
-> (IORef Bool -> ReaderT Context IO Bool)
-> ReaderT Context IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Bool -> ReaderT Context IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT Context IO Bool)
-> (IORef Bool -> IO Bool) -> IORef Bool -> ReaderT Context IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef)

----------------------------------------------------------------------------
-- Helpers

-- | A helper that takes a function that extracts something from 'Metadata'
-- block. It finds the 'StreamInfoBlock', gets 'Metadata' from it and
-- applies given function to get the final value.
inStreamInfo :: (Metadata -> IO a) -> FlacMeta a
inStreamInfo :: (Metadata -> IO a) -> FlacMeta a
inStreamInfo f :: Metadata -> IO a
f =
  Inner a -> FlacMeta a
forall a. Inner a -> FlacMeta a
FlacMeta (Inner a -> FlacMeta a)
-> ((MetaIterator -> Inner a) -> Inner a)
-> (MetaIterator -> Inner a)
-> FlacMeta a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> a) -> ReaderT Context IO (Maybe a) -> Inner a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (ReaderT Context IO (Maybe a) -> Inner a)
-> ((MetaIterator -> Inner a) -> ReaderT Context IO (Maybe a))
-> (MetaIterator -> Inner a)
-> Inner a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataType
-> (MetaIterator -> Inner a) -> ReaderT Context IO (Maybe a)
forall a.
MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock MetadataType
StreamInfoBlock ((MetaIterator -> Inner a) -> FlacMeta a)
-> (MetaIterator -> Inner a) -> FlacMeta a
forall a b. (a -> b) -> a -> b
$
    IO a -> Inner a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Inner a)
-> (MetaIterator -> IO a) -> MetaIterator -> Inner a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetaIterator -> IO Metadata
iteratorGetBlock (MetaIterator -> IO Metadata)
-> (Metadata -> IO a) -> MetaIterator -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> IO a
f)

-- | Given 'MetadataType' (type of metadata block) and an action that uses
-- an iterator which points to a block of the specified type, perform that
-- action and return its result wrapped in 'Just' if block of requested type
-- was found, 'Nothing' otherwise. If there are several blocks of the given
-- type, action will be performed for each of them, but only the first
-- result will be returned.
withMetaBlock ::
  -- | Type of block to find
  MetadataType ->
  -- | What to do if such block found
  (MetaIterator -> Inner a) ->
  -- | Result in 'Just' if block was found
  Inner (Maybe a)
withMetaBlock :: MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlock = (Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
forall a.
(Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlockGen Metadata -> ReaderT Context IO Bool
forall (m :: * -> *) p. Monad m => p -> m Bool
noCheck
  where
    noCheck :: p -> m Bool
noCheck _ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Just like 'withMetaBlock', but creates a new block of requested type if
-- no block of such type can be found.
withMetaBlock' ::
  -- | Type of block to find
  MetadataType ->
  -- | What to do if such block found
  (MetaIterator -> Inner a) ->
  -- | Result
  Inner a
withMetaBlock' :: MetadataType -> (MetaIterator -> Inner a) -> Inner a
withMetaBlock' = (Metadata -> ReaderT Context IO Bool)
-> (Metadata -> Inner ())
-> MetadataType
-> (MetaIterator -> Inner a)
-> Inner a
forall a.
(Metadata -> ReaderT Context IO Bool)
-> (Metadata -> Inner ())
-> MetadataType
-> (MetaIterator -> Inner a)
-> Inner a
withMetaBlockGen' Metadata -> ReaderT Context IO Bool
forall (m :: * -> *) p. Monad m => p -> m Bool
noCheck Metadata -> Inner ()
forall (m :: * -> *) p. Monad m => p -> m ()
noSet
  where
    noCheck :: p -> m Bool
noCheck _ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    noSet :: p -> m ()
noSet _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | The same as 'withMetaBlock' but it searches for a block of type
-- 'ApplicationBlock' that has specified application id.
withApplicationBlock ::
  -- | Application id to find
  ApplicationId ->
  -- | What to do if such block found
  (MetaIterator -> Inner a) ->
  -- | Result in 'Just' if block was found
  Inner (Maybe a)
withApplicationBlock :: ApplicationId -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withApplicationBlock givenId :: ApplicationId
givenId =
  (Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
forall a.
(Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlockGen Metadata -> ReaderT Context IO Bool
idCheck MetadataType
ApplicationBlock
  where
    idCheck :: Metadata -> ReaderT Context IO Bool
idCheck = (ApplicationId -> Bool)
-> ReaderT Context IO ApplicationId -> ReaderT Context IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ApplicationId -> ApplicationId -> Bool
forall a. Eq a => a -> a -> Bool
== ApplicationId
givenId) (ReaderT Context IO ApplicationId -> ReaderT Context IO Bool)
-> (Metadata -> ReaderT Context IO ApplicationId)
-> Metadata
-> ReaderT Context IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ApplicationId -> ReaderT Context IO ApplicationId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApplicationId -> ReaderT Context IO ApplicationId)
-> (Metadata -> IO ApplicationId)
-> Metadata
-> ReaderT Context IO ApplicationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO ApplicationId
getApplicationId

-- | Just like 'withApplicationBlock', but creates a new 'ApplicationBlock'
-- with given id if no such block can be found.
withApplicationBlock' ::
  -- | Application id to find
  ApplicationId ->
  -- | What to do if such block found
  (MetaIterator -> Inner a) ->
  -- | Result
  Inner a
withApplicationBlock' :: ApplicationId -> (MetaIterator -> Inner a) -> Inner a
withApplicationBlock' givenId :: ApplicationId
givenId =
  (Metadata -> ReaderT Context IO Bool)
-> (Metadata -> Inner ())
-> MetadataType
-> (MetaIterator -> Inner a)
-> Inner a
forall a.
(Metadata -> ReaderT Context IO Bool)
-> (Metadata -> Inner ())
-> MetadataType
-> (MetaIterator -> Inner a)
-> Inner a
withMetaBlockGen' Metadata -> ReaderT Context IO Bool
idCheck Metadata -> Inner ()
setId MetadataType
ApplicationBlock
  where
    idCheck :: Metadata -> ReaderT Context IO Bool
idCheck = (ApplicationId -> Bool)
-> ReaderT Context IO ApplicationId -> ReaderT Context IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ApplicationId -> ApplicationId -> Bool
forall a. Eq a => a -> a -> Bool
== ApplicationId
givenId) (ReaderT Context IO ApplicationId -> ReaderT Context IO Bool)
-> (Metadata -> ReaderT Context IO ApplicationId)
-> Metadata
-> ReaderT Context IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ApplicationId -> ReaderT Context IO ApplicationId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApplicationId -> ReaderT Context IO ApplicationId)
-> (Metadata -> IO ApplicationId)
-> Metadata
-> ReaderT Context IO ApplicationId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO ApplicationId
getApplicationId
    setId :: Metadata -> Inner ()
setId block :: Metadata
block = IO () -> Inner ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Metadata -> ApplicationId -> IO ()
setApplicationId Metadata
block ApplicationId
givenId)

-- | The same as 'withMetaBlock', but it searches for a block of type
-- 'PictureBlock' that has specific 'PictureType'.
withPictureBlock ::
  -- | Picture type to find
  PictureType ->
  -- | What to do if such block found
  (MetaIterator -> Inner a) ->
  -- | Result in 'Just' if block was found
  Inner (Maybe a)
withPictureBlock :: PictureType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withPictureBlock givenType :: PictureType
givenType = (Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
forall a.
(Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlockGen Metadata -> ReaderT Context IO Bool
typeCheck MetadataType
PictureBlock
  where
    typeCheck :: Metadata -> ReaderT Context IO Bool
typeCheck = (PictureType -> Bool)
-> ReaderT Context IO PictureType -> ReaderT Context IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PictureType -> PictureType -> Bool
forall a. Eq a => a -> a -> Bool
== PictureType
givenType) (ReaderT Context IO PictureType -> ReaderT Context IO Bool)
-> (Metadata -> ReaderT Context IO PictureType)
-> Metadata
-> ReaderT Context IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO PictureType -> ReaderT Context IO PictureType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PictureType -> ReaderT Context IO PictureType)
-> (Metadata -> IO PictureType)
-> Metadata
-> ReaderT Context IO PictureType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO PictureType
getPictureType

-- | Just like 'withPictureBlock', but creates a new 'PictureBlock' with
-- given 'PictureType' if no such block can be found.
withPictureBlock' ::
  -- | Picture type to find
  PictureType ->
  -- | What to do if such block found
  (MetaIterator -> Inner a) ->
  -- | Result in 'Just'
  Inner a
withPictureBlock' :: PictureType -> (MetaIterator -> Inner a) -> Inner a
withPictureBlock' givenType :: PictureType
givenType =
  (Metadata -> ReaderT Context IO Bool)
-> (Metadata -> Inner ())
-> MetadataType
-> (MetaIterator -> Inner a)
-> Inner a
forall a.
(Metadata -> ReaderT Context IO Bool)
-> (Metadata -> Inner ())
-> MetadataType
-> (MetaIterator -> Inner a)
-> Inner a
withMetaBlockGen' Metadata -> ReaderT Context IO Bool
typeCheck Metadata -> Inner ()
setType MetadataType
PictureBlock
  where
    typeCheck :: Metadata -> ReaderT Context IO Bool
typeCheck = (PictureType -> Bool)
-> ReaderT Context IO PictureType -> ReaderT Context IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PictureType -> PictureType -> Bool
forall a. Eq a => a -> a -> Bool
== PictureType
givenType) (ReaderT Context IO PictureType -> ReaderT Context IO Bool)
-> (Metadata -> ReaderT Context IO PictureType)
-> Metadata
-> ReaderT Context IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO PictureType -> ReaderT Context IO PictureType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PictureType -> ReaderT Context IO PictureType)
-> (Metadata -> IO PictureType)
-> Metadata
-> ReaderT Context IO PictureType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO PictureType
getPictureType
    setType :: Metadata -> Inner ()
setType block :: Metadata
block = IO () -> Inner ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Metadata -> PictureType -> IO ()
setPictureType Metadata
block PictureType
givenType)

-- | A generic building block for 'withMetaBlock'-like helpers.
withMetaBlockGen ::
  -- | Additional check on 'Metadata' block
  (Metadata -> Inner Bool) ->
  -- | Type of block to find
  MetadataType ->
  -- | What to do if such block found
  (MetaIterator -> Inner a) ->
  -- | Result in 'Just' if block was found
  Inner (Maybe a)
withMetaBlockGen :: (Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlockGen check :: Metadata -> ReaderT Context IO Bool
check givenType :: MetadataType
givenType f :: MetaIterator -> Inner a
f = do
  MetaChain
chain <- (Context -> MetaChain) -> ReaderT Context IO MetaChain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> MetaChain
metaChain
  ([a] -> Maybe a) -> ReaderT Context IO [a] -> Inner (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe (ReaderT Context IO [a] -> Inner (Maybe a))
-> ((MetaIterator -> Inner (Maybe a)) -> ReaderT Context IO [a])
-> (MetaIterator -> Inner (Maybe a))
-> Inner (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaChain
-> (MetaIterator -> Inner (Maybe a)) -> ReaderT Context IO [a]
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
MetaChain -> (MetaIterator -> m (Maybe a)) -> m [a]
withIterator MetaChain
chain ((MetaIterator -> Inner (Maybe a)) -> Inner (Maybe a))
-> (MetaIterator -> Inner (Maybe a)) -> Inner (Maybe a)
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
    MetadataType
actualType <- IO MetadataType -> ReaderT Context IO MetadataType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO MetadataType
iteratorGetBlockType MetaIterator
i)
    if MetadataType
actualType MetadataType -> MetadataType -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataType
givenType
      then do
        Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
        Bool
match <- Metadata -> ReaderT Context IO Bool
check Metadata
block
        if Bool
match
          then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Inner a -> Inner (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaIterator -> Inner a
f MetaIterator
i
          else Maybe a -> Inner (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
      else Maybe a -> Inner (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | A generic building block for 'withMetaBlock''-like helpers.
withMetaBlockGen' ::
  -- | Additional check on 'Metadata' block
  (Metadata -> Inner Bool) ->
  -- | Set parameters of newly created block before calling the main callback
  (Metadata -> Inner ()) ->
  -- | Type of block to find
  MetadataType ->
  -- | What to do if such block found (main callback)
  (MetaIterator -> Inner a) ->
  Inner a
withMetaBlockGen' :: (Metadata -> ReaderT Context IO Bool)
-> (Metadata -> Inner ())
-> MetadataType
-> (MetaIterator -> Inner a)
-> Inner a
withMetaBlockGen' check :: Metadata -> ReaderT Context IO Bool
check setParam :: Metadata -> Inner ()
setParam givenType :: MetadataType
givenType f :: MetaIterator -> Inner a
f = do
  MetaChain
chain <- (Context -> MetaChain) -> ReaderT Context IO MetaChain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> MetaChain
metaChain
  Maybe a
res <- (Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
forall a.
(Metadata -> ReaderT Context IO Bool)
-> MetadataType -> (MetaIterator -> Inner a) -> Inner (Maybe a)
withMetaBlockGen Metadata -> ReaderT Context IO Bool
check MetadataType
givenType MetaIterator -> Inner a
f
  case Maybe a
res of
    Nothing -> ([a] -> a) -> ReaderT Context IO [a] -> Inner a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. [a] -> a
head (ReaderT Context IO [a] -> Inner a)
-> ((MetaIterator -> Inner (Maybe a)) -> ReaderT Context IO [a])
-> (MetaIterator -> Inner (Maybe a))
-> Inner a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaChain
-> (MetaIterator -> Inner (Maybe a)) -> ReaderT Context IO [a]
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
MetaChain -> (MetaIterator -> m (Maybe a)) -> m [a]
withIterator MetaChain
chain ((MetaIterator -> Inner (Maybe a)) -> Inner a)
-> (MetaIterator -> Inner (Maybe a)) -> Inner a
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
      MetadataType
actual <- IO MetadataType -> ReaderT Context IO MetadataType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO MetadataType
iteratorGetBlockType MetaIterator
i)
      if MetadataType
actual MetadataType -> MetadataType -> Bool
forall a. Eq a => a -> a -> Bool
== MetadataType
StreamInfoBlock
        then
          let acquire :: ReaderT Context IO Metadata
acquire = IO (Maybe Metadata) -> ReaderT Context IO Metadata
forall a. IO (Maybe a) -> Inner a
liftMaybe (MetadataType -> IO (Maybe Metadata)
objectNew MetadataType
givenType)
              release :: Metadata -> Inner ()
release = IO () -> Inner ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Inner ()) -> (Metadata -> IO ()) -> Metadata -> Inner ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> IO ()
objectDelete
           in do
                ReaderT Context IO Metadata
-> (Metadata -> Inner ()) -> (Metadata -> Inner ()) -> Inner ()
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError ReaderT Context IO Metadata
acquire Metadata -> Inner ()
release ((Metadata -> Inner ()) -> Inner ())
-> (Metadata -> Inner ()) -> Inner ()
forall a b. (a -> b) -> a -> b
$ \block :: Metadata
block -> do
                  Metadata -> Inner ()
setParam Metadata
block
                  IO Bool -> Inner ()
liftBool (MetaIterator -> Metadata -> IO Bool
iteratorInsertBlockAfter MetaIterator
i Metadata
block)
                a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Inner a -> Inner (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetaIterator -> Inner a
f MetaIterator
i
        else Maybe a -> Inner (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just x :: a
x -> a -> Inner a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Go through all metadata blocks and delete empty ones.
applyVacuum :: Inner ()
applyVacuum :: Inner ()
applyVacuum = do
  MetaChain
chain <- (Context -> MetaChain) -> ReaderT Context IO MetaChain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> MetaChain
metaChain
  ReaderT Context IO [Any] -> Inner ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT Context IO [Any] -> Inner ())
-> ((MetaIterator -> ReaderT Context IO (Maybe Any))
    -> ReaderT Context IO [Any])
-> (MetaIterator -> ReaderT Context IO (Maybe Any))
-> Inner ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaChain
-> (MetaIterator -> ReaderT Context IO (Maybe Any))
-> ReaderT Context IO [Any]
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
MetaChain -> (MetaIterator -> m (Maybe a)) -> m [a]
withIterator MetaChain
chain ((MetaIterator -> ReaderT Context IO (Maybe Any)) -> Inner ())
-> (MetaIterator -> ReaderT Context IO (Maybe Any)) -> Inner ()
forall a b. (a -> b) -> a -> b
$ \i :: MetaIterator
i -> do
    MetadataType
blockType <- IO MetadataType -> ReaderT Context IO MetadataType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO MetadataType
iteratorGetBlockType MetaIterator
i)
    Metadata
block <- IO Metadata -> ReaderT Context IO Metadata
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaIterator -> IO Metadata
iteratorGetBlock MetaIterator
i)
    Bool
empty <- IO Bool -> ReaderT Context IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetadataType -> Metadata -> IO Bool
forall (m :: * -> *).
MonadIO m =>
MetadataType -> Metadata -> m Bool
isMetaBlockEmpty MetadataType
blockType Metadata
block)
    Bool -> Inner () -> Inner ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
empty (Inner () -> Inner ()) -> Inner () -> Inner ()
forall a b. (a -> b) -> a -> b
$
      IO Bool -> Inner ()
liftBool (MetaIterator -> IO Bool
iteratorDeleteBlock MetaIterator
i)
    Maybe Any -> ReaderT Context IO (Maybe Any)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Any
forall a. Maybe a
Nothing

-- | Determine if a given 'Metadata' block is empty.
isMetaBlockEmpty :: MonadIO m => MetadataType -> Metadata -> m Bool
isMetaBlockEmpty :: MetadataType -> Metadata -> m Bool
isMetaBlockEmpty SeekTableBlock block :: Metadata
block =
  Vector SeekPoint -> Bool
forall a. Vector a -> Bool
V.null (Vector SeekPoint -> Bool) -> m (Vector SeekPoint) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Vector SeekPoint) -> m (Vector SeekPoint)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Metadata -> IO (Vector SeekPoint)
getSeekPoints Metadata
block)
isMetaBlockEmpty VorbisCommentBlock block :: Metadata
block =
  IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Metadata -> IO Bool
isVorbisCommentEmpty Metadata
block)
isMetaBlockEmpty _ _ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Lift an action that may return 'Nothing' on failure into 'Inner' monad
-- taking care of error reporting.
liftMaybe :: IO (Maybe a) -> Inner a
liftMaybe :: IO (Maybe a) -> Inner a
liftMaybe m :: IO (Maybe a)
m = IO (Maybe a) -> ReaderT Context IO (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe a)
m ReaderT Context IO (Maybe a) -> (Maybe a -> Inner a) -> Inner a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inner a -> (a -> Inner a) -> Maybe a -> Inner a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Inner a
forall a. Inner a
throwStatus a -> Inner a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Lift an action that returns 'False' on failure into 'Inner' monad
-- taking care of error reporting.
liftBool :: IO Bool -> Inner ()
liftBool :: IO Bool -> Inner ()
liftBool m :: IO Bool
m = IO Bool -> ReaderT Context IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
m ReaderT Context IO Bool -> (Bool -> Inner ()) -> Inner ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Inner () -> Inner () -> Bool -> Inner ()
forall a. a -> a -> Bool -> a
bool Inner ()
forall a. Inner a
throwStatus (() -> Inner ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Get 'MetaChainStatus' and throw it immediately.
throwStatus :: Inner a
throwStatus :: Inner a
throwStatus = do
  MetaChain
chain <- (Context -> MetaChain) -> ReaderT Context IO MetaChain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> MetaChain
metaChain
  MetaChainStatus
status <- IO MetaChainStatus -> ReaderT Context IO MetaChainStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MetaChain -> IO MetaChainStatus
chainStatus MetaChain
chain)
  MetaException -> Inner a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MetaChainStatus -> MetaException
MetaGeneralProblem MetaChainStatus
status)

-- | Specify that the metadata chain has been modified.
setModified :: Inner ()
setModified :: Inner ()
setModified = do
  IORef Bool
modified <- (Context -> IORef Bool) -> ReaderT Context IO (IORef Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context -> IORef Bool
metaModified
  IO () -> Inner ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
modified Bool
True)

-- | Map 'VorbisField' to its ASCII name in the form of a 'ByteString'.
vorbisFieldName :: VorbisField -> ByteString
vorbisFieldName :: VorbisField -> ByteString
vorbisFieldName RGTrackPeak = "REPLAYGAIN_TRACK_PEAK"
vorbisFieldName RGTrackGain = "REPLAYGAIN_TRACK_GAIN"
vorbisFieldName RGAlbumPeak = "REPLAYGAIN_ALBUM_PEAK"
vorbisFieldName RGAlbumGain = "REPLAYGAIN_ALBUM_GAIN"
vorbisFieldName field :: VorbisField
field = (String -> ByteString
B8.pack (String -> ByteString)
-> (VorbisField -> String) -> VorbisField -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper ShowS -> (VorbisField -> String) -> VorbisField -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VorbisField -> String
forall a. Show a => a -> String
show) VorbisField
field

-- | Map the number of channels to a 'Set' of 'SpeakerPosition's as per FLAC
-- specification.
toChannelMask :: Word32 -> Set SpeakerPosition
toChannelMask :: Word32 -> Set SpeakerPosition
toChannelMask n :: Word32
n = case Word32
n of
  0 -> Set SpeakerPosition
forall a. Set a
E.empty
  1 -> Set SpeakerPosition
speakerMono
  2 -> Set SpeakerPosition
speakerStereo
  3 -> [SpeakerPosition] -> Set SpeakerPosition
forall a. Ord a => [a] -> Set a
E.fromList [SpeakerPosition
SpeakerFrontLeft, SpeakerPosition
SpeakerFrontRight, SpeakerPosition
SpeakerFrontCenter]
  4 -> Set SpeakerPosition
speakerQuad
  5 -> SpeakerPosition -> Set SpeakerPosition -> Set SpeakerPosition
forall a. Ord a => a -> Set a -> Set a
E.insert SpeakerPosition
SpeakerFrontCenter Set SpeakerPosition
speakerQuad
  6 -> Set SpeakerPosition
speaker5_1
  7 -> SpeakerPosition -> Set SpeakerPosition -> Set SpeakerPosition
forall a. Ord a => a -> Set a -> Set a
E.insert SpeakerPosition
SpeakerBackCenter Set SpeakerPosition
speaker5_1Surround
  8 -> Set SpeakerPosition
speaker7_1Surround
  x :: Word32
x -> [SpeakerPosition] -> Set SpeakerPosition
forall a. Ord a => [a] -> Set a
E.fromList ([SpeakerPosition] -> Set SpeakerPosition)
-> [SpeakerPosition] -> Set SpeakerPosition
forall a b. (a -> b) -> a -> b
$ Int -> [SpeakerPosition] -> [SpeakerPosition]
forall a. Int -> [a] -> [a]
take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x) [SpeakerPosition
forall a. Bounded a => a
minBound .. SpeakerPosition
forall a. Bounded a => a
maxBound]