packages feed

flac 0.2.0 → 0.2.1

raw patch · 23 files changed

+1401/−1449 lines, 23 filesdep −semigroupsdep −transformersdep ~basedep ~bytestringdep ~containerssetup-changed

Dependencies removed: semigroups, transformers

Dependency ranges changed: base, bytestring, containers, filepath, hspec, mtl, text

Files

CHANGELOG.md view
@@ -1,3 +1,7 @@+## FLAC 0.2.1++* Maintenance release with more modern and minimal dependencies.+ ## FLAC 0.2.0  * Got rid of `data-default-class` dependency. Now default values for various
Codec/Audio/FLAC/Metadata.hs view
@@ -1,6 +1,14 @@+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+ -- | -- Module      :  Codec.Audio.FLAC.Metadata--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -21,10 +29,9 @@ -- -- > 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+-- > main = runFlacMeta defaultMetaSettings "/path/to/my/file.flac" $ do -- >   retrieve SampleRate             >>= liftIO . print -- >   retrieve (VorbisComment Artist) >>= liftIO . print --@@ -34,10 +41,9 @@ -- 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+-- > main = runFlacMeta defaultMetaSettings "/path/to/my/file.flac" $ do -- >   VorbisComment Artist =-> Just "Alexander Scriabin" -- >   VorbisComment Title  =-> Just "Sonata №9 “Black Mass”, Op. 68" -- >   VorbisComment Date   =-> Nothing@@ -58,67 +64,56 @@ -- 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.--{-# LANGUAGE CPP                        #-}-{-# LANGUAGE ConstrainedClassMethods    #-}-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE TypeFamilies               #-}--#if MIN_VERSION_base(4,9,0)-{-# LANGUAGE UndecidableInstances       #-}-#else-{-# OPTIONS_GHC -fno-warn-missing-methods #-}-#endif- module Codec.Audio.FLAC.Metadata   ( -- * Metadata manipulation API-    FlacMeta-  , MetaSettings (..)-  , defaultMetaSettings-  , MetaException (..)-  , MetaChainStatus (..)-  , runFlacMeta+    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 (..)+    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+    wipeVorbisComment,+    wipeApplications,+    wipeSeekTable,+    wipeCueSheets,+    wipePictures,+     -- * Debugging and testing-  , MetadataType (..)-  , getMetaChain-  , isMetaChainModified )+    MetadataType (..),+    getMetaChain,+    isMetaChainModified,+  ) where  import Codec.Audio.FLAC.Metadata.Internal.Level2Interface@@ -128,31 +123,24 @@ 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 Data.ByteString.Char8 qualified as B8 import Data.Char (toUpper) import Data.IORef+import Data.Kind (Constraint, Type) import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE import Data.Maybe (fromJust, listToMaybe) import Data.Set (Set)+import Data.Set qualified as E import Data.Text (Text) import Data.Vector (Vector)+import Data.Vector qualified as V import Foreign hiding (void)-import Numeric.Natural-import System.IO-import qualified Data.ByteString.Char8 as B8-import qualified Data.List.NonEmpty    as NE-import qualified Data.Set              as E-import qualified Data.Vector           as V--#if MIN_VERSION_base(4,9,0)-import Data.Kind (Constraint) import GHC.TypeLits-#else-import GHC.Exts (Constraint)-#endif+import System.IO  ---------------------------------------------------------------------------- -- Metadata manipulation API@@ -160,65 +148,67 @@ -- | 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 { unFlacMeta :: Inner a }-  deriving ( Functor-           , Applicative-           , Monad-           , MonadIO-           , MonadThrow-           , MonadCatch-           , MonadMask )+newtype FlacMeta a = FlacMeta {unFlacMeta :: Inner a}+  deriving+    ( Functor,+      Applicative,+      Monad,+      MonadIO,+      MonadThrow,+      MonadCatch,+      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-  { metaChain    :: MetaChain     -- ^ Metadata chain-  , metaModified :: IORef Bool    -- ^ “Modified” flag-  , metaFileSize :: Natural       -- ^ Size of target file+  { -- | Metadata chain+    metaChain :: MetaChain,+    -- | “Modified” flag+    metaModified :: IORef Bool,+    -- | Size of target file+    metaFileSize :: Natural   }  -- | Settings that control how metadata is written in FLAC file.- data MetaSettings = MetaSettings-  { metaAutoVacuum :: !Bool-    -- ^ Whether to traverse all metadata blocks just before padding sorting+  { -- | 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'.-  , metaSortPadding :: !Bool-    -- ^ Whether to attempt to sort and consolidate all padding at the end+    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'.-  , metaUsePadding :: !Bool-    -- ^ This setting enables truncation of last padding metadata block if+    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'.-  , metaPreserveFileStats :: !Bool-    -- ^ If 'True', the owner and modification time will be preserved even+    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'.-  } deriving (Show, Read, Eq, Ord)+    metaPreserveFileStats :: !Bool+  }+  deriving (Show, Read, Eq, Ord)  -- | Default 'MetaSettings'. -- -- @since 0.2.0- defaultMetaSettings :: MetaSettings-defaultMetaSettings = MetaSettings-  { metaAutoVacuum        = True-  , metaSortPadding       = True-  , metaUsePadding        = True-  , metaPreserveFileStats = True-  }+defaultMetaSettings =+  MetaSettings+    { metaAutoVacuum = True,+      metaSortPadding = True,+      metaUsePadding = True,+      metaPreserveFileStats = True+    }  -- | Run an action that manipulates FLAC metadata. 'MetaSettings' control -- subtle and rather low-level details of metadata editing, just pass 'def'@@ -233,18 +223,22 @@ -- -- If a problem occurs, 'MetaException' is thrown with attached -- 'MetaChainStatus' that should help investigating what went wrong.--runFlacMeta :: MonadIO m-  => MetaSettings      -- ^ Settings to use-  -> FilePath          -- ^ File to operate on-  -> FlacMeta a        -- ^ Actions to perform-  -> m a               -- ^ The result+runFlacMeta ::+  (MonadIO m) =>+  -- | Settings to use+  MetaSettings ->+  -- | File to operate on+  FilePath ->+  -- | Actions to perform+  FlacMeta a ->+  -- | The result+  m a runFlacMeta MetaSettings {..} path m = liftIO . withChain $ \metaChain -> do   metaModified <- newIORef False   metaFileSize <- fromIntegral <$> withFile path ReadMode hFileSize   flip runReaderT Context {..} $ do     liftBool (chainRead metaChain path)-    result   <- unFlacMeta m+    result <- unFlacMeta m     modified <- liftIO (readIORef metaModified)     when modified $ do       when metaAutoVacuum applyVacuum@@ -263,121 +257,95 @@ -- 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 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+  -- metadata. To delete something, set it to 'Nothing' (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 ()+  (=->) :: (MetaWritable a) => a -> MetaType a -> FlacMeta ()   _ =-> _ = error "Codec.Audio.FLAC.Metadata.(=->) is not defined"  infix 1 =-> -#if MIN_VERSION_base(4,9,0) type NotWritable = 'Text "This attribute is not writable."-#endif  -- | 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-#if MIN_VERSION_base(4,9,0)   type MetaWritable MinBlockSize = TypeError NotWritable-#endif   retrieve MinBlockSize = inStreamInfo 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-#if MIN_VERSION_base(4,9,0)   type MetaWritable MaxBlockSize = TypeError NotWritable-#endif   retrieve MaxBlockSize = inStreamInfo 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-#if MIN_VERSION_base(4,9,0)   type MetaWritable MinFrameSize = TypeError NotWritable-#endif   retrieve MinFrameSize = inStreamInfo 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-#if MIN_VERSION_base(4,9,0)   type MetaWritable MaxFrameSize = TypeError NotWritable-#endif   retrieve MaxFrameSize = inStreamInfo getMaxFrameSize  -- | Sample rate in Hz. -- -- __Read-only__ attribute represented as a 'Word32'.- data SampleRate = SampleRate  instance MetaValue SampleRate where   type MetaType SampleRate = Word32-#if MIN_VERSION_base(4,9,0)   type MetaWritable SampleRate = TypeError NotWritable-#endif   retrieve SampleRate = inStreamInfo 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-#if MIN_VERSION_base(4,9,0)   type MetaWritable Channels = TypeError NotWritable-#endif   retrieve Channels = inStreamInfo getChannels  -- | Channel mask specifying which speaker positions are present. This is@@ -385,14 +353,11 @@ -- in the FLAC specification. -- -- __Read-only__ attribute represented as @'Set' 'SpeakerPosition'@.- data ChannelMask = ChannelMask  instance MetaValue ChannelMask where   type MetaType ChannelMask = Set SpeakerPosition-#if MIN_VERSION_base(4,9,0)   type MetaWritable ChannelMask = TypeError NotWritable-#endif   retrieve ChannelMask = toChannelMask <$> retrieve Channels  -- | Bits per sample (sample depth). FLAC supports from 4 to 32 bits per@@ -400,14 +365,11 @@ -- bits per sample. -- -- __Read-only__ attribute represented as a 'Word32'.- data BitsPerSample = BitsPerSample  instance MetaValue BitsPerSample where   type MetaType BitsPerSample = Word32-#if MIN_VERSION_base(4,9,0)   type MetaWritable BitsPerSample = TypeError NotWritable-#endif   retrieve BitsPerSample = inStreamInfo getBitsPerSample  -- | Total number of samples in audio stream. “Samples” means inter-channel@@ -416,40 +378,31 @@ -- number of total samples is unknown. -- -- __Read-only__ attribute represented as a 'Word64'.- data TotalSamples = TotalSamples  instance MetaValue TotalSamples where   type MetaType TotalSamples = Word64-#if MIN_VERSION_base(4,9,0)   type MetaWritable TotalSamples = TypeError NotWritable-#endif   retrieve TotalSamples = inStreamInfo getTotalSamples  -- | File size in bytes. -- -- __Read-only__ attribute represented as a 'Natural'.- data FileSize = FileSize  instance MetaValue FileSize where   type MetaType FileSize = Natural-#if MIN_VERSION_base(4,9,0)   type MetaWritable FileSize = TypeError NotWritable-#endif   retrieve FileSize = FlacMeta (asks 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-#if MIN_VERSION_base(4,9,0)   type MetaWritable BitRate = TypeError NotWritable-#endif   retrieve BitRate = do     fileSize <- fromIntegral <$> retrieve FileSize     duration <- retrieve Duration@@ -461,30 +414,24 @@ -- 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-#if MIN_VERSION_base(4,9,0)   type MetaWritable MD5Sum = TypeError NotWritable-#endif   retrieve MD5Sum = inStreamInfo getMd5Sum  -- | Duration in seconds. -- -- __Read-only__ attribute represented as a 'Double'.- data Duration = Duration  instance MetaValue Duration where   type MetaType Duration = Double-#if MIN_VERSION_base(4,9,0)   type MetaWritable Duration = TypeError NotWritable-#endif   retrieve Duration = do     totalSamples <- fromIntegral <$> retrieve TotalSamples-    sampleRate   <- fromIntegral <$> retrieve SampleRate+    sampleRate <- fromIntegral <$> retrieve SampleRate     return (totalSamples / sampleRate)  -- | Application metadata. The 'ApplicationId' argument to 'Application'@@ -496,7 +443,6 @@ -- <https://xiph.org/flac/id.html>. -- -- __Writable__ optional attribute represented as a @'Maybe' 'ByteString'@.- data Application = Application ApplicationId  instance MetaValue Application where@@ -522,7 +468,6 @@ -- -- __Writable__ optional attribute represented as a @'Maybe' ('Vector' -- 'SeekPoint')@.- data SeekTable = SeekTable  instance MetaValue SeekTable where@@ -543,12 +488,11 @@  -- | 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+-- @'VorbisVendor' '=->' 'Nothing'@), you really set it to the 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@@ -577,59 +521,80 @@ -- 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-  = Title              -- ^ Track\/work name.-  | Version            -- ^ The version field may be used to differentiate-                       -- multiple versions of the same track title in a-                       -- single collection (e.g. remix info).-  | Album              -- ^ The collection name to which this track belongs.-  | TrackNumber        -- ^ The track number of this piece if part of a-                       -- specific larger collection or album.-  | TrackTotal         -- ^ Total number of tracks in the collection this-                       -- track belongs to.-  | DiscNumber         -- ^ Disc number in a multi-disc release.-  | DiscTotal          -- ^ Total number of discs in a multi-disc release.-  | Artist             -- ^ 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.-  | Performer          -- ^ 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.-  | Copyright          -- ^ Copyright attribution, e.g., “2001 Nobody's-                       -- Band” or “1999 Jack Moffitt”.-  | License            -- ^ 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.-  | Organization       -- ^ Name of the organization producing the track-                       -- (i.e. the “record label”).-  | Description        -- ^ A short text description of the contents.-  | Genre              -- ^ A short text indication of music genre.-  | Date               -- ^ Date the track was recorded, usually year.-  | Location           -- ^ Location where track was recorded.-  | Contact            -- ^ 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.-  | ISRC               -- ^ ISRC number for the track, see-                       -- <http://isrc.ifpi.org/en>.-  | Rating             -- ^ Rating, usually mapped as 1–5 stars with actual-                       -- values “20”, “40”, “60”, “80”, “100” stored.-  | RGTrackPeak        -- ^ Replay gain track peak, e.g. “0.99996948”.-  | RGTrackGain        -- ^ Replay gain track gain, e.g. “-7.89 dB”.-  | RGAlbumPeak        -- ^ Replay gain album peak, e.g. “0.99996948”.-  | RGAlbumGain        -- ^ Replay gain album gain, e.g. “-7.89 dB”.+  = -- | 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 (Show, Read, Eq, Ord, Bounded, Enum)  instance MetaValue VorbisComment where@@ -656,7 +621,6 @@ -- to manipulate 'CueSheetData' and 'CueTrack's. -- -- __Writable__ optional attribute represented as a @'Maybe' 'CueSheetData'@.- data CueSheet = CueSheet  instance MetaValue CueSheet where@@ -686,7 +650,6 @@ -- with 'PictureData' easier using the @Juicy-Pixels@ library. -- -- __Writable__ optional attribute represented as a @'Maybe' 'PictureData'@.- data Picture = Picture PictureType  instance MetaValue Picture where@@ -709,7 +672,6 @@ -- Extra functionality  -- | Delete all “Vorbis comment” metadata blocks.- wipeVorbisComment :: FlacMeta () wipeVorbisComment =   void . FlacMeta . withMetaBlock VorbisCommentBlock $ \i -> do@@ -717,7 +679,6 @@     setModified  -- | Delete all “Application” metadata blocks.- wipeApplications :: FlacMeta () wipeApplications =   void . FlacMeta . withMetaBlock ApplicationBlock $ \i -> do@@ -725,7 +686,6 @@     setModified  -- | Delete all “Seek table” metadata blocks.- wipeSeekTable :: FlacMeta () wipeSeekTable =   void . FlacMeta . withMetaBlock SeekTableBlock $ \i -> do@@ -733,7 +693,6 @@     setModified  -- | Delete all “CUE sheet” metadata blocks.- wipeCueSheets :: FlacMeta () wipeCueSheets =   void . FlacMeta . withMetaBlock CueSheetBlock $ \i -> do@@ -741,7 +700,6 @@     setModified  -- | Delete all “Picture” metadata blocks.- wipePictures :: FlacMeta () wipePictures =   void . FlacMeta . withMetaBlock PictureBlock $ \i -> do@@ -753,7 +711,6 @@  -- | Return a list of all 'MetadataType's of metadata blocks detected in -- order.- getMetaChain :: FlacMeta (NonEmpty MetadataType) getMetaChain = FlacMeta $ do   chain <- asks metaChain@@ -762,7 +719,6 @@ -- | 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 (asks metaModified >>= liftIO . readIORef) @@ -772,7 +728,6 @@ -- | 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 f =   FlacMeta . fmap fromJust . withMetaBlock StreamInfoBlock $@@ -784,34 +739,40 @@ -- 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-  :: MetadataType      -- ^ Type of block to find-  -> (MetaIterator -> Inner a) -- ^ What to do if such block found-  -> Inner (Maybe a)   -- ^ Result in 'Just' if block was found+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 = withMetaBlockGen noCheck   where     noCheck _ = return True  -- | Just like 'withMetaBlock', but creates a new block of requested type if -- no block of such type can be found.--withMetaBlock'-  :: MetadataType      -- ^ Type of block to find-  -> (MetaIterator -> Inner a) -- ^ What to do if such block found-  -> Inner a           -- ^ Result+withMetaBlock' ::+  -- | Type of block to find+  MetadataType ->+  -- | What to do if such block found+  (MetaIterator -> Inner a) ->+  -- | Result+  Inner a withMetaBlock' = withMetaBlockGen' noCheck noSet   where     noCheck _ = return True-    noSet   _ = return ()+    noSet _ = return ()  -- | The same as 'withMetaBlock' but it searches for a block of type -- 'ApplicationBlock' that has specified application id.--withApplicationBlock-  :: ApplicationId     -- ^ Application id to find-  -> (MetaIterator -> Inner a) -- ^ What to do if such block found-  -> Inner (Maybe a)   -- ^ Result in 'Just' if block was found+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 givenId =   withMetaBlockGen idCheck ApplicationBlock   where@@ -819,35 +780,41 @@  -- | Just like 'withApplicationBlock', but creates a new 'ApplicationBlock' -- with given id if no such block can be found.--withApplicationBlock'-  :: ApplicationId     -- ^ Application id to find-  -> (MetaIterator -> Inner a) -- ^ What to do if such block found-  -> Inner a           -- ^ Result+withApplicationBlock' ::+  -- | Application id to find+  ApplicationId ->+  -- | What to do if such block found+  (MetaIterator -> Inner a) ->+  -- | Result+  Inner a withApplicationBlock' givenId =   withMetaBlockGen' idCheck setId ApplicationBlock   where-    idCheck     = fmap (== givenId) . liftIO . getApplicationId+    idCheck = fmap (== givenId) . liftIO . getApplicationId     setId block = liftIO (setApplicationId block givenId)  -- | The same as 'withMetaBlock', but it searches for a block of type -- 'PictureBlock' that has specific 'PictureType'.--withPictureBlock-  :: PictureType       -- ^ Picture type to find-  -> (MetaIterator -> Inner a) -- ^ What to do if such block found-  -> Inner (Maybe a)   -- ^ Result in 'Just' if block was found+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 givenType = withMetaBlockGen typeCheck PictureBlock   where     typeCheck = fmap (== givenType) . liftIO . getPictureType  -- | Just like 'withPictureBlock', but creates a new 'PictureBlock' with -- given 'PictureType' if no such block can be found.--withPictureBlock'-  :: PictureType       -- ^ Picture type to find-  -> (MetaIterator -> Inner a) -- ^ What to do if such block found-  -> Inner a           -- ^ Result in 'Just'+withPictureBlock' ::+  -- | Picture type to find+  PictureType ->+  -- | What to do if such block found+  (MetaIterator -> Inner a) ->+  -- | Result in 'Just'+  Inner a withPictureBlock' givenType =   withMetaBlockGen' typeCheck setType PictureBlock   where@@ -855,12 +822,15 @@     setType block = liftIO (setPictureType block givenType)  -- | A generic building block for 'withMetaBlock'-like helpers.--withMetaBlockGen-  :: (Metadata -> Inner Bool) -- ^ Additional check on 'Metadata' block-  -> MetadataType      -- ^ Type of block to find-  -> (MetaIterator -> Inner a) -- ^ What to do if such block found-  -> Inner (Maybe a)   -- ^ Result in 'Just' if block was found+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 check givenType f = do   chain <- asks metaChain   fmap listToMaybe . withIterator chain $ \i -> do@@ -875,20 +845,19 @@       else return Nothing  -- | A generic building block for 'withMetaBlock''-like helpers.--withMetaBlockGen'-  :: (Metadata -> Inner Bool)-     -- ^ Additional check on 'Metadata' block-  -> (Metadata -> Inner ())-     -- ^ Set parameters of newly created block before calling the main callback-  -> MetadataType-     -- ^ Type of block to find-  -> (MetaIterator -> Inner a)-     -- ^ What to do if such block found (main callback)-  -> Inner a+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' check setParam givenType f = do   chain <- asks metaChain-  res   <- withMetaBlockGen check givenType f+  res <- withMetaBlockGen check givenType f   case res of     Nothing -> fmap head . withIterator chain $ \i -> do       actual <- liftIO (iteratorGetBlockType i)@@ -896,30 +865,28 @@         then           let acquire = liftMaybe (objectNew givenType)               release = liftIO . objectDelete-          in do-            bracketOnError acquire release $ \block -> do-              setParam block-              liftBool (iteratorInsertBlockAfter i block)-            Just <$> f i+           in do+                bracketOnError acquire release $ \block -> do+                  setParam block+                  liftBool (iteratorInsertBlockAfter i block)+                Just <$> f i         else return Nothing     Just x -> return x  -- | Go through all metadata blocks and delete empty ones.- applyVacuum :: Inner () applyVacuum = do   chain <- asks metaChain   void . withIterator chain $ \i -> do     blockType <- liftIO (iteratorGetBlockType i)-    block     <- liftIO (iteratorGetBlock     i)-    empty     <- liftIO (isMetaBlockEmpty blockType block)+    block <- liftIO (iteratorGetBlock i)+    empty <- liftIO (isMetaBlockEmpty blockType block)     when empty $       liftBool (iteratorDeleteBlock i)     return Nothing  -- | Determine if a given 'Metadata' block is empty.--isMetaBlockEmpty :: MonadIO m => MetadataType -> Metadata -> m Bool+isMetaBlockEmpty :: (MonadIO m) => MetadataType -> Metadata -> m Bool isMetaBlockEmpty SeekTableBlock block =   V.null <$> liftIO (getSeekPoints block) isMetaBlockEmpty VorbisCommentBlock block =@@ -928,33 +895,28 @@  -- | Lift an action that may return 'Nothing' on failure into 'Inner' monad -- taking care of error reporting.- liftMaybe :: IO (Maybe a) -> Inner a liftMaybe m = liftIO m >>= maybe throwStatus return  -- | Lift an action that returns 'False' on failure into 'Inner' monad -- taking care of error reporting.- liftBool :: IO Bool -> Inner () liftBool m = liftIO m >>= bool throwStatus (return ())  -- | Get 'MetaChainStatus' and throw it immediately.- throwStatus :: Inner a throwStatus = do-  chain  <- asks metaChain+  chain <- asks metaChain   status <- liftIO (chainStatus chain)   throwM (MetaGeneralProblem status)  -- | Specify that the metadata chain has been modified.- setModified :: Inner () setModified = do   modified <- asks metaModified   liftIO (writeIORef modified True)  -- | Map 'VorbisField' to its ASCII name in the form of a 'ByteString'.- vorbisFieldName :: VorbisField -> ByteString vorbisFieldName RGTrackPeak = "REPLAYGAIN_TRACK_PEAK" vorbisFieldName RGTrackGain = "REPLAYGAIN_TRACK_GAIN"@@ -964,16 +926,15 @@  -- | Map the number of channels to a 'Set' of 'SpeakerPosition's as per FLAC -- specification.- toChannelMask :: Word32 -> Set SpeakerPosition toChannelMask n = case n of   0 -> E.empty   1 -> speakerMono   2 -> speakerStereo-  3 -> E.fromList [SpeakerFrontLeft,SpeakerFrontRight,SpeakerFrontCenter]+  3 -> E.fromList [SpeakerFrontLeft, SpeakerFrontRight, SpeakerFrontCenter]   4 -> speakerQuad   5 -> E.insert SpeakerFrontCenter speakerQuad   6 -> speaker5_1   7 -> E.insert SpeakerBackCenter speaker5_1Surround   8 -> speaker7_1Surround-  x -> E.fromList $ take (fromIntegral x) [minBound..maxBound]+  x -> E.fromList $ take (fromIntegral x) [minBound .. maxBound]
Codec/Audio/FLAC/Metadata/CueSheet.hs view
@@ -1,6 +1,6 @@ -- | -- Module      :  Codec.Audio.FLAC.Metadata.CueSheet--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -8,12 +8,12 @@ -- Portability :  portable -- -- This module exports the 'CueSheetData' and 'CueTrack' data types, which--- are rarely needed, and thus should not “contaminate” the--- "Codec.Audio.Metadata" module with potentially conflicting names.-+-- are rarely needed, and thus should not congest the "Codec.Audio.Metadata"+-- module with potentially conflicting names. module Codec.Audio.FLAC.Metadata.CueSheet-  ( CueSheetData (..)-  , CueTrack (..) )+  ( CueSheetData (..),+    CueTrack (..),+  ) where  import Codec.Audio.FLAC.Metadata.Internal.Types
Codec/Audio/FLAC/Metadata/Internal/Level2Interface.hs view
@@ -1,6 +1,10 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE LambdaCase #-}+ -- | -- Module      :  Codec.Audio.FLAC.Metadata.Internal.Level2Interface--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -11,25 +15,22 @@ -- FLAC metadata interface, see: -- -- <https://xiph.org/flac/api/group__flac__metadata__level2.html>.--{-# LANGUAGE FlexibleContexts         #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE LambdaCase               #-}- module Codec.Audio.FLAC.Metadata.Internal.Level2Interface   ( -- * Chain-    withChain-  , chainStatus-  , chainRead-  , chainWrite-  , chainSortPadding+    withChain,+    chainStatus,+    chainRead,+    chainWrite,+    chainSortPadding,+     -- * Iterator-  , withIterator-  , iteratorGetBlockType-  , iteratorGetBlock-  , iteratorSetBlock-  , iteratorDeleteBlock-  , iteratorInsertBlockAfter )+    withIterator,+    iteratorGetBlockType,+    iteratorGetBlock,+    iteratorSetBlock,+    iteratorDeleteBlock,+    iteratorInsertBlockAfter,+  ) where  import Codec.Audio.FLAC.Metadata.Internal.Types@@ -47,16 +48,15 @@ -- -- If memory for the chain cannot be allocated, corresponding -- 'MetaException' is raised.- withChain :: (MetaChain -> IO a) -> IO a withChain f = bracket chainNew (mapM_ chainDelete) $ \case-  Nothing -> throwM-    (MetaGeneralProblem MetaChainStatusMemoryAllocationError)+  Nothing ->+    throwM+      (MetaGeneralProblem MetaChainStatusMemoryAllocationError)   Just x -> f x  -- | Create a new 'MetaChain'. In the case of memory allocation problem -- 'Nothing' is returned.- chainNew :: IO (Maybe MetaChain) chainNew = maybePtr <$> c_chain_new @@ -65,7 +65,6 @@  -- | Free a 'MetaChain' instance. Delete the object pointed to by -- 'MetaChain'.- chainDelete :: MetaChain -> IO () chainDelete = c_chain_delete @@ -74,7 +73,6 @@  -- | Check status of a given 'MetaChain'. This can be used to find out what -- went wrong. It also resets status to 'MetaChainStatusOK'.- chainStatus :: MetaChain -> IO MetaChainStatus chainStatus = fmap toEnum' . c_chain_status @@ -83,7 +81,6 @@  -- | Read all metadata from a FLAC file into the chain. Return 'False' if -- something went wrong.- chainRead :: MetaChain -> FilePath -> IO Bool chainRead chain path = withCString path (c_chain_read chain) @@ -91,12 +88,15 @@   c_chain_read :: MetaChain -> CString -> IO Bool  -- | Write all metadata out to the FLAC file.--chainWrite-  :: MetaChain         -- ^ The chain to write-  -> Bool              -- ^ Whether to use padding-  -> Bool              -- ^ Whether to preserve file stats-  -> IO Bool           -- ^ 'False' if something went wrong+chainWrite ::+  -- | The chain to write+  MetaChain ->+  -- | Whether to use padding+  Bool ->+  -- | Whether to preserve file stats+  Bool ->+  -- | 'False' if something went wrong+  IO Bool chainWrite chain usePadding preserveStats =   c_chain_write chain (fromEnum' usePadding) (fromEnum' preserveStats) @@ -111,7 +111,6 @@ -- -- NOTE: this function does not write to the FLAC file, it only modifies the -- chain.- chainSortPadding :: MetaChain -> IO () chainSortPadding = c_chain_sort_padding @@ -129,19 +128,23 @@ -- -- If memory for the iterator cannot be allocated, corresponding -- 'MetaException' is raised.--withIterator :: (MonadMask m, MonadIO m)-  => MetaChain         -- ^ Metadata chain to traverse-  -> (MetaIterator -> m (Maybe a)) -- ^ Action to perform on each block-  -> m [a]             -- ^ Accumulated results+withIterator ::+  (MonadMask m, MonadIO m) =>+  -- | Metadata chain to traverse+  MetaChain ->+  -- | Action to perform on each block+  (MetaIterator -> m (Maybe a)) ->+  -- | Accumulated results+  m [a] withIterator chain f = bracket acquire release action   where     acquire = liftIO iteratorNew     release = mapM_ (liftIO . iteratorDelete)     action mi =       case mi of-        Nothing -> throwM-          (MetaGeneralProblem MetaChainStatusMemoryAllocationError)+        Nothing ->+          throwM+            (MetaGeneralProblem MetaChainStatusMemoryAllocationError)         Just i -> do           liftIO (iteratorInit i chain)           let go thisNext =@@ -151,13 +154,12 @@                     let next = liftIO (iteratorNext i) >>= go                     case res of                       Nothing -> next-                      Just  x -> (x :) <$> next+                      Just x -> (x :) <$> next                   else return []           go True  -- | Create a new iterator. Return 'Nothing' if there was a problem with -- memory allocation.- iteratorNew :: IO (Maybe MetaIterator) iteratorNew = maybePtr <$> c_iterator_new @@ -166,7 +168,6 @@  -- | Free an iterator instance. Delete the object pointed to by -- 'MetaIterator'.- iteratorDelete :: MetaIterator -> IO () iteratorDelete = c_iterator_delete @@ -175,11 +176,12 @@  -- | Initialize the iterator to point to the first metadata block in the -- given chain.--iteratorInit-  :: MetaIterator      -- ^ Existing iterator-  -> MetaChain         -- ^ Existing initialized chain-  -> IO ()+iteratorInit ::+  -- | Existing iterator+  MetaIterator ->+  -- | Existing initialized chain+  MetaChain ->+  IO () iteratorInit = c_iterator_init  foreign import ccall unsafe "FLAC__metadata_iterator_init"@@ -187,7 +189,6 @@  -- | Move the iterator forward one metadata block, returning 'False' if -- already at the end.- iteratorNext :: MetaIterator -> IO Bool iteratorNext = c_iterator_next @@ -196,7 +197,6 @@  -- | Get the type of the metadata block at the current position. Useful for -- fast searching.- iteratorGetBlockType :: MetaIterator -> IO MetadataType iteratorGetBlockType = fmap toEnum' . c_iterator_get_block_type @@ -204,7 +204,6 @@   c_iterator_get_block_type :: MetaIterator -> IO CUInt  -- | Get metadata block at the current position.- iteratorGetBlock :: MetaIterator -> IO Metadata iteratorGetBlock = c_iterator_get_block @@ -213,7 +212,6 @@  -- | Write given 'Metadata' block at the position pointed to by -- 'MetaIterator' replacing an existing block.- iteratorSetBlock :: MetaIterator -> Metadata -> IO Bool iteratorSetBlock = c_iterator_set_block @@ -221,10 +219,11 @@   c_iterator_set_block :: MetaIterator -> Metadata -> IO Bool  -- | Remove the current block from the chain.--iteratorDeleteBlock-  :: MetaIterator      -- ^ Iterator that determines the position-  -> IO Bool           -- ^ 'False' if something went wrong+iteratorDeleteBlock ::+  -- | Iterator that determines the position+  MetaIterator ->+  -- | 'False' if something went wrong+  IO Bool iteratorDeleteBlock block = c_iterator_delete_block block False  foreign import ccall unsafe "FLAC__metadata_iterator_delete_block"@@ -237,7 +236,6 @@ -- will be left pointing to the new block. -- -- The function returns 'False' if something went wrong.- iteratorInsertBlockAfter :: MetaIterator -> Metadata -> IO Bool iteratorInsertBlockAfter = c_iterator_insert_block_after
Codec/Audio/FLAC/Metadata/Internal/Level2Interface/Helpers.hs view
@@ -1,6 +1,11 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+ -- | -- Module      :  Codec.Audio.FLAC.Metadata.Internal.Level2Interface.Helpers--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -10,47 +15,47 @@ -- Wrappers around helpers for working with level 2 FLAC metadata interface. -- -- The functions from this module are not safe, one only should attempt--- calling them when 'Metadata' contains metadata of correct type.--{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE OverloadedStrings        #-}-{-# LANGUAGE RecordWildCards          #-}-{-# LANGUAGE TupleSections            #-}-+-- calling them when 'Metadata' contains metadata of the correct type. module Codec.Audio.FLAC.Metadata.Internal.Level2Interface.Helpers   ( -- * Stream info-    getMinBlockSize-  , getMaxBlockSize-  , getMinFrameSize-  , getMaxFrameSize-  , getSampleRate-  , getChannels-  , getBitsPerSample-  , getTotalSamples-  , getMd5Sum+    getMinBlockSize,+    getMaxBlockSize,+    getMinFrameSize,+    getMaxFrameSize,+    getSampleRate,+    getChannels,+    getBitsPerSample,+    getTotalSamples,+    getMd5Sum,+     -- * Application-  , getApplicationId-  , getApplicationData-  , setApplicationId-  , setApplicationData+    getApplicationId,+    getApplicationData,+    setApplicationId,+    setApplicationData,+     -- * Seek table-  , getSeekPoints-  , setSeekPoints+    getSeekPoints,+    setSeekPoints,+     -- * Vorbis comment-  , getVorbisVendor-  , setVorbisVendor-  , getVorbisComment-  , setVorbisComment-  , deleteVorbisComment-  , isVorbisCommentEmpty+    getVorbisVendor,+    setVorbisVendor,+    getVorbisComment,+    setVorbisComment,+    deleteVorbisComment,+    isVorbisCommentEmpty,+     -- * CUE sheet-  , getCueSheetData-  , setCueSheetData+    getCueSheetData,+    setCueSheetData,+     -- * Picture-  , getPictureType-  , getPictureData-  , setPictureType-  , setPictureData )+    getPictureType,+    getPictureData,+    setPictureType,+    setPictureData,+  ) where  import Codec.Audio.FLAC.Metadata.Internal.Object@@ -60,28 +65,26 @@ import Control.Monad.Catch import Data.Bool (bool) import Data.ByteString (ByteString)+import Data.ByteString qualified as B import Data.List (uncons)+import Data.List.NonEmpty qualified as NE import Data.Maybe (isJust)-import Data.Monoid ((<>)) import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Text.Foreign qualified as T import Data.Vector (Vector, (!))+import Data.Vector qualified as V+import Data.Vector.Mutable qualified as VM import Data.Word import Foreign import Foreign.C.String import Foreign.C.Types-import qualified Data.ByteString     as B-import qualified Data.List.NonEmpty  as NE-import qualified Data.Text           as T-import qualified Data.Text.Encoding  as T-import qualified Data.Text.Foreign   as T-import qualified Data.Vector         as V-import qualified Data.Vector.Mutable as VM  ---------------------------------------------------------------------------- -- Stream info  -- | Get min block size.- getMinBlockSize :: Metadata -> IO Word32 getMinBlockSize = fmap fromIntegral . c_get_min_blocksize @@ -89,7 +92,6 @@   c_get_min_blocksize :: Metadata -> IO CUInt  -- | Get max block size.- getMaxBlockSize :: Metadata -> IO Word32 getMaxBlockSize = fmap fromIntegral . c_get_max_blocksize @@ -97,7 +99,6 @@   c_get_max_blocksize :: Metadata -> IO CUInt  -- | Get min frame size.- getMinFrameSize :: Metadata -> IO Word32 getMinFrameSize = fmap fromIntegral . c_get_min_framesize @@ -105,7 +106,6 @@   c_get_min_framesize :: Metadata -> IO Word32  -- | Get max frame size.- getMaxFrameSize :: Metadata -> IO Word32 getMaxFrameSize = fmap fromIntegral . c_get_max_framesize @@ -113,7 +113,6 @@   c_get_max_framesize :: Metadata -> IO Word32  -- | Get sample rate.- getSampleRate :: Metadata -> IO Word32 getSampleRate = fmap fromIntegral . c_get_sample_rate @@ -121,7 +120,6 @@   c_get_sample_rate :: Metadata -> IO CUInt  -- | Get number of channels.- getChannels :: Metadata -> IO Word32 getChannels = fmap fromIntegral . c_get_channels @@ -129,7 +127,6 @@   c_get_channels :: Metadata -> IO CUInt  -- | Get number of bits per sample.- getBitsPerSample :: Metadata -> IO Word32 getBitsPerSample = fmap fromIntegral . c_get_bits_per_sample @@ -137,7 +134,6 @@   c_get_bits_per_sample :: Metadata -> IO CUInt  -- | Get total number of samples.- getTotalSamples :: Metadata -> IO Word64 getTotalSamples = c_get_total_samples @@ -145,7 +141,6 @@   c_get_total_samples :: Metadata -> IO Word64  -- | Get MD5 sum of original audio data.- getMd5Sum :: Metadata -> IO ByteString getMd5Sum block = do   md5SumPtr <- c_get_md5sum block@@ -158,7 +153,6 @@ -- Application  -- | Get application id from given 'Metadata' block.- getApplicationId :: Metadata -> IO ApplicationId getApplicationId block = do   idPtr <- c_get_application_id block@@ -168,18 +162,16 @@   c_get_application_id :: Metadata -> IO CString  -- | Get data from given application metadata block.- getApplicationData :: Metadata -> IO ByteString getApplicationData block = alloca $ \sizePtr -> do   dataPtr <- c_get_application_data block sizePtr-  size    <- fromIntegral <$> peek sizePtr+  size <- fromIntegral <$> peek sizePtr   B.packCStringLen (dataPtr, size)  foreign import ccall unsafe "FLAC__metadata_get_application_data"   c_get_application_data :: Metadata -> Ptr CUInt -> IO CString  -- | Set application id for given metadata block.- setApplicationId :: Metadata -> ApplicationId -> IO () setApplicationId block appId =   B.useAsCString (unApplicationId appId) (c_set_application_id block)@@ -188,7 +180,6 @@   c_set_application_id :: Metadata -> CString -> IO ()  -- | Set application data for given metadata block.- setApplicationData :: Metadata -> ByteString -> IO Bool setApplicationData block data' =   B.useAsCString data' $ \dataPtr -> do@@ -202,11 +193,10 @@ -- Seek table  -- | Get seek table as a 'Vector' of 'SeekPoint's.- getSeekPoints :: Metadata -> IO (Vector SeekPoint) getSeekPoints block = do   size <- fromIntegral <$> c_get_seek_points_num block-  v    <- VM.new size+  v <- VM.new size   let go n =         when (n < size) $ do           ptr <- c_get_seek_point block (fromIntegral n)@@ -226,7 +216,6 @@  -- | Set seek table represented by a given 'Vector' of 'SeekPoint's. Return -- 'False' in case of trouble.- setSeekPoints :: Metadata -> Vector SeekPoint -> IO Bool setSeekPoints block seekPoints = do   let size = fromIntegral (V.length seekPoints)@@ -237,7 +226,9 @@             if n < size               then do                 let SeekPoint {..} = seekPoints ! fromIntegral n-                c_set_seek_point block (fromIntegral n)+                c_set_seek_point+                  block+                  (fromIntegral n)                   seekPointSampleNumber                   seekPointStreamOffset                   seekPointFrameSamples@@ -246,7 +237,7 @@                 legal <- objectSeektableIsLegal block                 unless legal $                   throwM MetaInvalidSeekTable-      in go 0 >> return True+       in go 0 >> return True     else return False  foreign import ccall unsafe "FLAC__metadata_set_seek_point"@@ -256,18 +247,16 @@ -- Vorbis comment  -- | Get Vorbis vendor.- getVorbisVendor :: Metadata -> IO Text getVorbisVendor block = alloca $ \sizePtr -> do   vendorPtr <- c_get_vorbis_vendor block sizePtr-  size      <- fromIntegral <$> peek sizePtr+  size <- fromIntegral <$> peek sizePtr   T.peekCStringLen (vendorPtr, size)  foreign import ccall unsafe "FLAC__metadata_get_vorbis_vendor"   c_get_vorbis_vendor :: Metadata -> Ptr Word32 -> IO CString  -- | Set Vorbis vendor.- setVorbisVendor :: Metadata -> Text -> IO Bool setVorbisVendor block vendor =   T.withCStringLen vendor $ \(vendorPtr, size) ->@@ -277,22 +266,21 @@   c_set_vorbis_vendor :: Metadata -> CString -> Word32 -> IO Bool  -- | Get vorbis comment by name.- getVorbisComment :: ByteString -> Metadata -> IO (Maybe Text) getVorbisComment name block = alloca $ \sizePtr ->   B.useAsCString name $ \namePtr -> do-    commentPtr  <- c_get_vorbis_comment block namePtr sizePtr+    commentPtr <- c_get_vorbis_comment block namePtr sizePtr     commentSize <- fromIntegral <$> peek sizePtr     if commentPtr == nullPtr       then return Nothing-      else Just . T.drop 1 . T.dropWhile (/= '=') . T.decodeUtf8-        <$> B.packCStringLen (commentPtr, commentSize)+      else+        Just . T.drop 1 . T.dropWhile (/= '=') . T.decodeUtf8+          <$> B.packCStringLen (commentPtr, commentSize)  foreign import ccall unsafe "FLAC__metadata_get_vorbis_comment"   c_get_vorbis_comment :: Metadata -> CString -> Ptr Word32 -> IO CString  -- | Set (replace or insert if necessary) a vorbis comment.- setVorbisComment :: ByteString -> Text -> Metadata -> IO Bool setVorbisComment name value block =   T.withCStringLen (T.decodeUtf8 name <> "=" <> value) $@@ -304,7 +292,6 @@  -- | Delete a vorbis comment by name. If it doesn't exist, nothing will -- happen.- deleteVorbisComment :: ByteString -> Metadata -> IO Bool deleteVorbisComment name block =   B.useAsCString name (c_delete_vorbis_comment block)@@ -313,7 +300,6 @@   c_delete_vorbis_comment :: Metadata -> CString -> IO Bool  -- | Determine a vorbis comment metadata block can be considered empty.- isVorbisCommentEmpty :: Metadata -> IO Bool isVorbisCommentEmpty = c_is_vorbis_comment_empty @@ -325,13 +311,12 @@  -- | Get CUE sheet from 'Metadata' block assuming that it's a -- 'CueSheetBlock'.- getCueSheetData :: Metadata -> IO CueSheetData getCueSheetData block = do-  cueCatalog <- c_get_cue_sheet_mcn     block >>= B.packCString-  cueLeadIn  <- c_get_cue_sheet_lead_in block-  cueIsCd    <- c_get_cue_sheet_is_cd   block-  numTracks  <- c_get_cue_sheet_num_tracks block+  cueCatalog <- c_get_cue_sheet_mcn block >>= B.packCString+  cueLeadIn <- c_get_cue_sheet_lead_in block+  cueIsCd <- c_get_cue_sheet_is_cd block+  numTracks <- c_get_cue_sheet_num_tracks block   (cueTracks, cueLeadOutTrack) <-     case numTracks of       0 ->@@ -340,9 +325,9 @@         throwM (MetaInvalidCueSheet "Cannot read CUE sheet without tracks")       1 -> ([],) <$> getCueSheetTrack block 0       _ -> do-        ts <- mapM (getCueSheetTrack block) [0..numTracks - 2]+        ts <- mapM (getCueSheetTrack block) [0 .. numTracks - 2]         t' <- getCueSheetTrack block (numTracks - 1)-        return (ts,t')+        return (ts, t')   return CueSheetData {..}  foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_mcn"@@ -358,31 +343,33 @@   c_get_cue_sheet_num_tracks :: Metadata -> IO Word8  -- | Peek a single 'CueSheetTrack' at given index.- getCueSheetTrack :: Metadata -> Word8 -> IO CueTrack getCueSheetTrack block n = do   cueTrackOffset <- c_get_cue_sheet_track_offset block n-  cueTrackIsrc   <- c_get_cue_sheet_track_isrc   block n >>= B.packCString-  cueTrackAudio  <- c_get_cue_sheet_track_audio  block n+  cueTrackIsrc <- c_get_cue_sheet_track_isrc block n >>= B.packCString+  cueTrackAudio <- c_get_cue_sheet_track_audio block n   cueTrackPreEmphasis <- c_get_cue_sheet_track_preemphasis block n-  numIndices     <- c_get_cue_sheet_track_num_indices block n-  (cueTrackPregapIndex, cueTrackIndices) <- if numIndices == 0-    then throwM (MetaInvalidCueSheet "Cannot read CUE track without indices")-    else do-      hasPregap <- c_get_cue_sheet_track_has_pregap_index block n-      let pregapOne :: Num a => a-          pregapOne = if hasPregap then 1 else 0-          range     =-            if numIndices > pregapOne-              then [pregapOne..numIndices - 1]-              else []-      pregapIndex <- if hasPregap-        then Just <$> c_get_cue_sheet_track_index block n 0-        else return Nothing-      trackIndices <- mapM-        (c_get_cue_sheet_track_index block n)-        (NE.fromList range)-      return (pregapIndex, trackIndices)+  numIndices <- c_get_cue_sheet_track_num_indices block n+  (cueTrackPregapIndex, cueTrackIndices) <-+    if numIndices == 0+      then throwM (MetaInvalidCueSheet "Cannot read CUE track without indices")+      else do+        hasPregap <- c_get_cue_sheet_track_has_pregap_index block n+        let pregapOne :: (Num a) => a+            pregapOne = if hasPregap then 1 else 0+            range =+              if numIndices > pregapOne+                then [pregapOne .. numIndices - 1]+                else []+        pregapIndex <-+          if hasPregap+            then Just <$> c_get_cue_sheet_track_index block n 0+            else return Nothing+        trackIndices <-+          mapM+            (c_get_cue_sheet_track_index block n)+            (NE.fromList range)+        return (pregapIndex, trackIndices)   return CueTrack {..}  foreign import ccall unsafe "FLAC__metadata_get_cue_sheet_track_offset"@@ -407,28 +394,28 @@   c_get_cue_sheet_track_index :: Metadata -> Word8 -> Word8 -> IO Word64  -- | Set 'CueSheetData' in given 'Metadata' block of type 'CueSheetBlock'.- setCueSheetData :: Metadata -> CueSheetData -> IO Bool setCueSheetData block CueSheetData {..} = do   B.useAsCStringLen cueCatalog $ \(mcnPtr, mcnSize) ->     c_set_cue_sheet_mcn block mcnPtr (fromIntegral mcnSize)   c_set_cue_sheet_lead_in block cueLeadIn-  c_set_cue_sheet_is_cd   block cueIsCd+  c_set_cue_sheet_is_cd block cueIsCd   let numTracks = fromIntegral (length cueTracks + 1)   res <- objectCueSheetResizeTracks block numTracks-  goodOutcome <- if res-    then-      let go ts =-            case uncons ts of-              Nothing ->-                setCueSheetTrack block cueLeadOutTrack (numTracks - 1) 170-              Just ((t,n),ts') -> do-                res' <- setCueSheetTrack block t n (n + 1)-                if res'-                  then go ts'-                  else return False-      in go (zip cueTracks [0..])-    else return False+  goodOutcome <-+    if res+      then+        let go ts =+              case uncons ts of+                Nothing ->+                  setCueSheetTrack block cueLeadOutTrack (numTracks - 1) 170+                Just ((t, n), ts') -> do+                  res' <- setCueSheetTrack block t n (n + 1)+                  if res'+                    then go ts'+                    else return False+         in go (zip cueTracks [0 ..])+      else return False   when goodOutcome $ do     res' <- objectCueSheetIsLegal block cueIsCd     case res' of@@ -446,7 +433,6 @@   c_set_cue_sheet_is_cd :: Metadata -> Bool -> IO ()  -- | Poke a 'CueTrack' at a specified index.- setCueSheetTrack :: Metadata -> CueTrack -> Word8 -> Word8 -> IO Bool setCueSheetTrack block CueTrack {..} n n' = do   c_set_cue_sheet_track_offset block n cueTrackOffset@@ -455,15 +441,15 @@     c_set_cue_sheet_track_isrc block n isrcPtr (fromIntegral isrcSize)   c_set_cue_sheet_track_audio block n cueTrackAudio   c_set_cue_sheet_track_pre_emphasis block n cueTrackPreEmphasis-  let pregapOne :: Num a => a+  let pregapOne :: (Num a) => a       pregapOne = if isJust cueTrackPregapIndex then 1 else 0       numIndices = fromIntegral (NE.length cueTrackIndices + pregapOne)   goodOutcome <- objectCueSheetTrackResizeIndices block n numIndices   when goodOutcome $ do     forM_ cueTrackPregapIndex $ \offset ->       c_set_cue_sheet_track_index block n 0 0 offset-    let range = zip [pregapOne..] [1..]-    forM_ (NE.zip cueTrackIndices (NE.fromList range)) $ \(offset, (i,i')) ->+    let range = zip [pregapOne ..] [1 ..]+    forM_ (NE.zip cueTrackIndices (NE.fromList range)) $ \(offset, (i, i')) ->       c_set_cue_sheet_track_index block n i i' offset   return goodOutcome @@ -490,7 +476,6 @@  -- | Get type of picture assuming that given 'Metadata' block is a -- 'PictureBlock'.- getPictureType :: Metadata -> IO PictureType getPictureType = fmap toEnum' . c_get_picture_type @@ -498,17 +483,16 @@   c_get_picture_type :: Metadata -> IO CUInt  -- | Get picture data from a given 'Metadata' block.- getPictureData :: Metadata -> IO PictureData getPictureData block = do-  pictureMimeType    <- c_get_picture_mime_type   block >>= peekCStringText+  pictureMimeType <- c_get_picture_mime_type block >>= peekCStringText   pictureDescription <- c_get_picture_description block >>= peekCStringText-  pictureWidth       <- c_get_picture_width       block-  pictureHeight      <- c_get_picture_height      block-  pictureDepth       <- c_get_picture_depth       block-  pictureColors      <- c_get_picture_colors      block-  pictureData        <- alloca $ \dataSizePtr -> do-    dataPtr  <- c_get_picture_data block dataSizePtr+  pictureWidth <- c_get_picture_width block+  pictureHeight <- c_get_picture_height block+  pictureDepth <- c_get_picture_depth block+  pictureColors <- c_get_picture_colors block+  pictureData <- alloca $ \dataSizePtr -> do+    dataPtr <- c_get_picture_data block dataSizePtr     dataSize <- fromIntegral <$> peek dataSizePtr     B.packCStringLen (dataPtr, dataSize)   return PictureData {..}@@ -536,7 +520,6 @@  -- | Set 'PictureType' to a given 'Metadata' block that should be a -- 'PictureBlock'.- setPictureType :: Metadata -> PictureType -> IO () setPictureType block pictureType =   c_set_picture_type block (fromEnum' pictureType)@@ -545,22 +528,23 @@   c_set_picture_type :: Metadata -> CUInt -> IO ()  -- | Set 'PictureData' in given 'Metadata' block of type 'PictureBlock'.- setPictureData :: Metadata -> PictureData -> IO Bool setPictureData block PictureData {..} = do-  c_set_picture_width  block pictureWidth+  c_set_picture_width block pictureWidth   c_set_picture_height block pictureHeight-  c_set_picture_depth  block pictureDepth+  c_set_picture_depth block pictureDepth   c_set_picture_colors block pictureColors-  goodOutcome <- shortcutFalse-    [ objectPictureSetMimeType    block pictureMimeType-    , objectPictureSetDescription block pictureDescription-    , objectPictureSetData        block pictureData ]+  goodOutcome <-+    shortcutFalse+      [ objectPictureSetMimeType block pictureMimeType,+        objectPictureSetDescription block pictureDescription,+        objectPictureSetData block pictureData+      ]   when goodOutcome $ do-     res <- objectPictureIsLegal block-     case res of-       Nothing  -> return ()-       Just msg -> throwM (MetaInvalidPicture msg)+    res <- objectPictureIsLegal block+    case res of+      Nothing -> return ()+      Just msg -> throwM (MetaInvalidPicture msg)   return goodOutcome  foreign import ccall unsafe "FLAC__metadata_set_picture_width"@@ -578,7 +562,6 @@ -- | Execute a collection of actions that return 'False' on failure. As soon -- as failure is reported, stop the execution and return 'False'. Return -- 'True' in the case of success.- shortcutFalse :: [IO Bool] -> IO Bool-shortcutFalse []     = return True-shortcutFalse (m:ms) = m >>= bool (return False) (shortcutFalse ms)+shortcutFalse [] = return True+shortcutFalse (m : ms) = m >>= bool (return False) (shortcutFalse ms)
Codec/Audio/FLAC/Metadata/Internal/Object.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ -- | -- Module      :  Codec.Audio.FLAC.Metadata.Internal.Object--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -10,34 +12,31 @@ -- Wrappers for the functions to work with metadata objects, see: -- -- <https://xiph.org/flac/api/group__flac__metadata__object.html>.--{-# LANGUAGE ForeignFunctionInterface #-}- module Codec.Audio.FLAC.Metadata.Internal.Object-  ( objectNew-  , objectDelete-  , objectSeektableResizePoints-  , objectSeektableIsLegal-  , objectCueSheetResizeTracks-  , objectCueSheetTrackResizeIndices-  , objectCueSheetIsLegal-  , objectPictureSetMimeType-  , objectPictureSetDescription-  , objectPictureSetData-  , objectPictureIsLegal )+  ( objectNew,+    objectDelete,+    objectSeektableResizePoints,+    objectSeektableIsLegal,+    objectCueSheetResizeTracks,+    objectCueSheetTrackResizeIndices,+    objectCueSheetIsLegal,+    objectPictureSetMimeType,+    objectPictureSetDescription,+    objectPictureSetData,+    objectPictureIsLegal,+  ) where  import Codec.Audio.FLAC.Metadata.Internal.Types import Codec.Audio.FLAC.Util import Data.ByteString (ByteString)+import Data.ByteString.Unsafe qualified as B import Data.Text (Text) import Foreign import Foreign.C.String import Foreign.C.Types-import qualified Data.ByteString.Unsafe as B  -- | Create a new metadata object given its type.- objectNew :: MetadataType -> IO (Maybe Metadata) objectNew = fmap maybePtr . c_object_new . fromEnum' @@ -45,7 +44,6 @@   c_object_new :: CUInt -> IO Metadata  -- | Free a metadata object.- objectDelete :: Metadata -> IO () objectDelete = c_object_delete @@ -53,7 +51,6 @@   c_object_delete :: Metadata -> IO ()  -- | Resize the seekpoint array. In case of trouble return 'False'.- objectSeektableResizePoints :: Metadata -> Word32 -> IO Bool objectSeektableResizePoints block newSize =   c_object_seektable_resize_points block (fromIntegral newSize)@@ -63,7 +60,6 @@  -- | Check a seek table to see if it conforms to the FLAC specification. -- Return 'False' if the seek table is illegal.- objectSeektableIsLegal :: Metadata -> IO Bool objectSeektableIsLegal = c_object_seektable_is_legal @@ -71,7 +67,6 @@   c_object_seektable_is_legal :: Metadata -> IO Bool  -- | Resize the track array.- objectCueSheetResizeTracks :: Metadata -> Word8 -> IO Bool objectCueSheetResizeTracks block n =   c_object_cuesheet_resize_tracks block (fromIntegral n)@@ -80,7 +75,6 @@   c_object_cuesheet_resize_tracks :: Metadata -> CUInt -> IO Bool  -- | Resize a track's index point array.- objectCueSheetTrackResizeIndices :: Metadata -> Word8 -> Word8 -> IO Bool objectCueSheetTrackResizeIndices block n i =   c_object_cuesheet_track_resize_indices block (fromIntegral n) (fromIntegral i)@@ -91,7 +85,6 @@ -- | Check a CUE sheet to see if it conforms to the FLAC specification. If -- something is wrong, the explanation is returned in 'Just', otherwise -- 'Nothing' is returned.- objectCueSheetIsLegal :: Metadata -> Bool -> IO (Maybe Text) objectCueSheetIsLegal block checkCdda = alloca $ \cstrPtr -> do   res <- c_object_cuesheet_is_legal block checkCdda cstrPtr@@ -104,7 +97,6 @@  -- | Check a picture and return description of what is wrong, otherwise -- 'Nothing'.- objectPictureIsLegal :: Metadata -> IO (Maybe Text) objectPictureIsLegal block = alloca $ \cstrPtr -> do   res <- c_object_picture_is_legal block cstrPtr@@ -116,7 +108,6 @@   c_object_picture_is_legal :: Metadata -> Ptr CString -> IO Bool  -- | Set the MIME type of a given picture block.- objectPictureSetMimeType :: Metadata -> Text -> IO Bool objectPictureSetMimeType block mimeType =   withCStringText mimeType $ \cstr ->@@ -126,7 +117,6 @@   c_object_picture_set_mime_type :: Metadata -> CString -> Bool -> IO Bool  -- | Set the description of a given picture block.- objectPictureSetDescription :: Metadata -> Text -> IO Bool objectPictureSetDescription block desc =   withCStringText desc $ \cstr ->@@ -136,7 +126,6 @@   c_object_picture_set_description :: Metadata -> CString -> Bool -> IO Bool  -- | Set the picture data of a given picture block.- objectPictureSetData :: Metadata -> ByteString -> IO Bool objectPictureSetData block data' =   B.unsafeUseAsCStringLen data' $ \(dataPtr, dataSize) ->
Codec/Audio/FLAC/Metadata/Internal/Types.hs view
@@ -1,6 +1,6 @@ -- | -- Module      :  Codec.Audio.FLAC.Metadata.Internal.Types--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -8,118 +8,119 @@ -- Portability :  portable -- -- Mostly non-public metadata-specific helper types.- module Codec.Audio.FLAC.Metadata.Internal.Types-  ( MetaChain (..)-  , MetaIterator (..)-  , Metadata (..)-  , MetadataType (..)-  , MetaChainStatus (..)-  , MetaException (..)-  , ApplicationId-  , mkApplicationId-  , unApplicationId-  , SeekPoint (..)-  , CueSheetData (..)-  , CueTrack (..)-  , PictureType (..)-  , PictureData (..) )+  ( MetaChain (..),+    MetaIterator (..),+    Metadata (..),+    MetadataType (..),+    MetaChainStatus (..),+    MetaException (..),+    ApplicationId,+    mkApplicationId,+    unApplicationId,+    SeekPoint (..),+    CueSheetData (..),+    CueTrack (..),+    PictureType (..),+    PictureData (..),+  ) where  import Control.Exception (Exception) import Data.ByteString (ByteString)+import Data.ByteString qualified as B+import Data.ByteString.Char8 qualified as B8 import Data.List.NonEmpty (NonEmpty (..))-import Data.Monoid ((<>)) import Data.String (IsString (..)) import Data.Text (Text) import Data.Void import Foreign-import qualified Data.ByteString       as B-import qualified Data.ByteString.Char8 as B8  -- | An opaque newtype wrapper around @'Ptr' 'Void'@, serves to represent a -- pointer to a metadata chain.- newtype MetaChain = MetaChain (Ptr Void)  -- | The same as 'MetaChain', this one is for pointers to metadata iterator.- newtype MetaIterator = MetaIterator (Ptr Void)  -- | The same as 'MetaChain', this one for pointers to metadata structure -- itself.- newtype Metadata = Metadata (Ptr Void)  -- | Enumeration of all known metadata blocks.- data MetadataType-  = StreamInfoBlock    -- ^ Stream info block (general data like sample rate)-  | PaddingBlock       -- ^ Padding block-  | ApplicationBlock   -- ^ Application block-  | SeekTableBlock     -- ^ Seek table block-  | VorbisCommentBlock -- ^ Vorbis comment block, a.k.a. FLAC tags-  | CueSheetBlock      -- ^ Cue sheet block-  | PictureBlock       -- ^ Picture block-  | UndefinedBlock     -- ^ Undefined block+  = -- | Stream info block (general data like sample rate)+    StreamInfoBlock+  | -- | Padding block+    PaddingBlock+  | -- | Application block+    ApplicationBlock+  | -- | Seek table block+    SeekTableBlock+  | -- | Vorbis comment block, a.k.a. FLAC tags+    VorbisCommentBlock+  | -- | Cue sheet block+    CueSheetBlock+  | -- | Picture block+    PictureBlock+  | -- | Undefined block+    UndefinedBlock   deriving (Show, Read, Eq, Ord, Bounded, Enum)  -- | Enumeration of meta chain statuses.- data MetaChainStatus-  = MetaChainStatusOK-    -- ^ The chain is in the normal OK state.-  | MetaChainStatusIllegalInput-    -- ^ The data passed into a function violated the function's usage+  = -- | The chain is in the normal OK state.+    MetaChainStatusOK+  | -- | The data passed into a function violated the function's usage     -- criteria.-  | MetaChainStatusErrorOpeningFile-    -- ^ The chain could not open the target file.-  | MetaChainStatusNotFlacFile-    -- ^ The chain could not find the FLAC signature at the start of the+    MetaChainStatusIllegalInput+  | -- | The chain could not open the target file.+    MetaChainStatusErrorOpeningFile+  | -- | The chain could not find the FLAC signature at the start of the     -- file.-  | MetaChainStatusNotWritable-    -- ^ The chain tried to write to a file that was not writable.-  | MetaChainStatusBadMetadata-    -- ^ The chain encountered input that does not conform to the FLAC+    MetaChainStatusNotFlacFile+  | -- | The chain tried to write to a file that was not writable.+    MetaChainStatusNotWritable+  | -- | The chain encountered input that does not conform to the FLAC     -- metadata specification.-  | MetaChainStatusReadError-    -- ^ The chain encountered an error while reading the FLAC file.-  | MetaChainStatusSeekError-    -- ^ The chain encountered an error while seeking in the FLAC file.-  | MetaChainStatusWriteError-    -- ^ The chain encountered an error while writing the FLAC file.-  | MetaChainStatusRenameError-    -- ^ The chain encountered an error renaming the FLAC file.-  | MetaChainStatusUnlinkError-    -- ^ The chain encountered an error removing the temporary file.-  | MetaChainStatusMemoryAllocationError-    -- ^ Memory allocation failed.-  | MetaChainStatusInternalError-    -- ^ The caller violated an assertion or an unexpected error occurred.-  | MetaChainStatusInvalidCallbacks-    -- ^ One or more of the required callbacks was NULL.-  | MetaChainStatusReadWriteMismatch-    -- ^ This error occurs when read and write methods do not match (i.e.+    MetaChainStatusBadMetadata+  | -- | The chain encountered an error while reading the FLAC file.+    MetaChainStatusReadError+  | -- | The chain encountered an error while seeking in the FLAC file.+    MetaChainStatusSeekError+  | -- | The chain encountered an error while writing the FLAC file.+    MetaChainStatusWriteError+  | -- | The chain encountered an error renaming the FLAC file.+    MetaChainStatusRenameError+  | -- | The chain encountered an error removing the temporary file.+    MetaChainStatusUnlinkError+  | -- | Memory allocation failed.+    MetaChainStatusMemoryAllocationError+  | -- | The caller violated an assertion or an unexpected error occurred.+    MetaChainStatusInternalError+  | -- | One or more of the required callbacks was NULL.+    MetaChainStatusInvalidCallbacks+  | -- | This error occurs when read and write methods do not match (i.e.     -- when if you read with callbacks, you should also use function that     -- writes with callbacks).-  | MetaChainStatusWrongWriteCall-    -- ^ Should not ever happen when you use this binding.+    MetaChainStatusReadWriteMismatch+  | -- | Should not ever happen when you use this binding.+    MetaChainStatusWrongWriteCall   deriving (Show, Read, Eq, Ord, Bounded, Enum)  -- | The exception that is thrown when manipulation of FLAC metadata fails -- for some reason.- data MetaException-  = MetaGeneralProblem MetaChainStatus-    -- ^ General failure, see the attached 'MetaChainStatus'.-  | MetaInvalidSeekTable-    -- ^ Invalid seek table was passed to be written.-  | MetaInvalidCueSheet Text-    -- ^ Invalid CUE sheet was passed to be written. The reason why the data+  = -- | General failure, see the attached 'MetaChainStatus'.+    MetaGeneralProblem MetaChainStatus+  | -- | Invalid seek table was passed to be written.+    MetaInvalidSeekTable+  | -- | Invalid CUE sheet was passed to be written. The reason why the data     -- was invalid is attached.-  | MetaInvalidPicture Text-    -- ^ Invalid picture data was passed to be written. The reason why the+    MetaInvalidCueSheet Text+  | -- | Invalid picture data was passed to be written. The reason why the     -- data was invalid is attached.+    MetaInvalidPicture Text   deriving (Eq, Show, Read)  instance Exception MetaException@@ -129,7 +130,6 @@ -- values of this type using Haskell string literals with -- @OverloadedStrings@ or with the 'mkApplicationId' smart constructor. -- Extract the inner 'ByteString' with 'unApplicationId'.- newtype ApplicationId = ApplicationId ByteString   deriving (Eq, Ord) @@ -142,40 +142,37 @@ -- | Application id must be four bytes long. If it's too short, null bytes -- will be appended to it to make it four bytes long. If it's too long, it -- will be truncated.- mkApplicationId :: ByteString -> ApplicationId-mkApplicationId appId = ApplicationId $-  B.take 4 (appId <> B.replicate 4 0x00)+mkApplicationId appId =+  ApplicationId $+    B.take 4 (appId <> B.replicate 4 0x00)  -- | Get 'ByteString' from 'ApplicationId'.- unApplicationId :: ApplicationId -> ByteString unApplicationId (ApplicationId appId) = appId  -- | Single point in a seek table metadata block.- data SeekPoint = SeekPoint-  { seekPointSampleNumber :: !Word64-    -- ^ The sample number of the target frame-  , seekPointStreamOffset :: !Word64-    -- ^ The offset in bytes of the target frame with respect to beginning+  { -- | The sample number of the target frame+    seekPointSampleNumber :: !Word64,+    -- | The offset in bytes of the target frame with respect to beginning     -- of the first frame-  , seekPointFrameSamples :: !Word32-    -- ^ The number of samples in the target frame-  } deriving (Eq, Ord, Show, Read)+    seekPointStreamOffset :: !Word64,+    -- | The number of samples in the target frame+    seekPointFrameSamples :: !Word32+  }+  deriving (Eq, Ord, Show, Read)  -- | CUE sheet as stored in FLAC metadata. This differs from traditional CUE -- sheets stored in “.cue” files (see -- <https://hackage.haskell.org/package/cue-sheet> to work with those).- data CueSheetData = CueSheetData-  { cueCatalog :: !ByteString-    -- ^ Media catalog number, in ASCII printable characters 0x20-0x7e. In+  { -- | Media catalog number, in ASCII printable characters 0x20-0x7e. In     -- general, the media catalog number may be 0 to 128 bytes long; any     -- unused characters will be right-padded with NUL characters. For     -- CD-DA, this is a thirteen digit number.-  , cueLeadIn :: !Word64-    -- ^ The number of lead-in samples. This field has meaning only for+    cueCatalog :: !ByteString,+    -- | The number of lead-in samples. This field has meaning only for     -- CD-DA CUE sheets; for other uses it should be 0. For CD-DA, the     -- lead-in is the TRACK 00 area where the table of contents is stored;     -- more precisely, it is the number of samples from the first sample of@@ -188,83 +185,110 @@     -- stored here is the number of samples up to the first index point of     -- the first track, not necessarily to INDEX 01 of the first track; even     -- the first track may have INDEX 00 data.-  , cueIsCd :: !Bool-    -- ^ 'True' if CUE sheet corresponds to a Compact Disc, else 'False'.-  , cueTracks :: ![CueTrack]-    -- ^ Collection of actual tracks in the CUE sheet, see 'CueTrack'.-  , cueLeadOutTrack :: !CueTrack-    -- ^ The obligatory lead-out track, will be written with the index 170.-  } deriving (Eq, Ord, Show, Read)+    cueLeadIn :: !Word64,+    -- | 'True' if CUE sheet corresponds to a Compact Disc, else 'False'.+    cueIsCd :: !Bool,+    -- | Collection of actual tracks in the CUE sheet, see 'CueTrack'.+    cueTracks :: ![CueTrack],+    -- | The obligatory lead-out track, will be written with the index 170.+    cueLeadOutTrack :: !CueTrack+  }+  deriving (Eq, Ord, Show, Read)  -- | Single track in a CUE sheet.- data CueTrack = CueTrack-  { cueTrackOffset :: !Word64-    -- ^ Track offset in samples, relative to the beginning of the FLAC+  { -- | Track offset in samples, relative to the beginning of the FLAC     -- audio stream. It is the offset to the first index point of the track.     -- (Note how this differs from CD-DA, where the track's offset in the     -- TOC is that of the track's INDEX 01 even if there is an INDEX 00.)     -- For CD-DA, the offset must be evenly divisible by 588 samples (588     -- samples = 44100 samples\/sec * 1\/75th of a sec).-  , cueTrackIsrc :: !ByteString-    -- ^ Track ISRC, empty if not present. This is a 12-digit alphanumeric+    cueTrackOffset :: !Word64,+    -- | Track ISRC, empty if not present. This is a 12-digit alphanumeric     -- code, the @cue-sheet@ package has corresponding type with smart     -- constructor and validation, but for now we don't want to depend on     -- that package.-  , cueTrackAudio :: !Bool-    -- ^ 'True' for audio tracks, 'False' for non-audio tracks.-  , cueTrackPreEmphasis :: !Bool-    -- ^ 'False' for no pre-emphasis, 'True' for pre-emphasis.-  , cueTrackPregapIndex :: !(Maybe Word64)-    -- ^ INDEX 00 (pregap) offset, see 'cueTrackIndices' for more info about+    cueTrackIsrc :: !ByteString,+    -- | 'True' for audio tracks, 'False' for non-audio tracks.+    cueTrackAudio :: !Bool,+    -- | 'False' for no pre-emphasis, 'True' for pre-emphasis.+    cueTrackPreEmphasis :: !Bool,+    -- | INDEX 00 (pregap) offset, see 'cueTrackIndices' for more info about     -- indices.-  , cueTrackIndices :: !(NonEmpty Word64)-    -- ^ Track's index points. Offset in samples, relative to the track+    cueTrackPregapIndex :: !(Maybe Word64),+    -- | Track's index points. Offset in samples, relative to the track     -- offset, of the index point. For CD-DA, the offset must be evenly     -- divisible by 588 samples (588 samples = 44100 samples\/sec * 1\/75th     -- of a sec). Note that the offset is from the beginning of the track,     -- not the beginning of the audio data.-  } deriving (Eq, Ord, Show, Read)+    cueTrackIndices :: !(NonEmpty Word64)+  }+  deriving (Eq, Ord, Show, Read)  -- | Type of picture FLAC metadata can contain. There may be several -- metadata blocks containing pictures of different types.- data PictureType-  = PictureOther             -- ^ Other-  | PictureFileIconStandard  -- ^ 32×32 pixels file icon (PNG only)-  | PictureFileIcon          -- ^ Other file icon-  | PictureFrontCover        -- ^ Cover (front)-  | PictureBackCover         -- ^ Cover (back)-  | PictureLeafletPage       -- ^ Leaflet page-  | PictureMedia             -- ^ Media (e.g. label side of CD)-  | PictureLeadArtist        -- ^ Lead artist\/lead performer\/soloist-  | PictureArtist            -- ^ Artist\/performer-  | PictureConductor         -- ^ Conductor-  | PictureBand              -- ^ Band\/orchestra-  | PictureComposer          -- ^ Composer-  | PictureLyricist          -- ^ Lyricist\/text writer-  | PictureRecordingLocation -- ^ Recording location-  | PictureDuringRecording   -- ^ During recording-  | PictureDuringPerformance -- ^ During performance-  | PictureVideoScreenCapture -- ^ Movie\/video screen capture-  | PictureFish              -- ^ A bright coloured fish-  | PictureIllustration      -- ^ Illustration-  | PictureBandLogotype      -- ^ Band\/artist logotype-  | PicturePublisherLogotype -- ^ Publisher\/studio logotype+  = -- | Other+    PictureOther+  | -- | 32×32 pixels file icon (PNG only)+    PictureFileIconStandard+  | -- | Other file icon+    PictureFileIcon+  | -- | Cover (front)+    PictureFrontCover+  | -- | Cover (back)+    PictureBackCover+  | -- | Leaflet page+    PictureLeafletPage+  | -- | Media (e.g. label side of CD)+    PictureMedia+  | -- | Lead artist\/lead performer\/soloist+    PictureLeadArtist+  | -- | Artist\/performer+    PictureArtist+  | -- | Conductor+    PictureConductor+  | -- | Band\/orchestra+    PictureBand+  | -- | Composer+    PictureComposer+  | -- | Lyricist\/text writer+    PictureLyricist+  | -- | Recording location+    PictureRecordingLocation+  | -- | During recording+    PictureDuringRecording+  | -- | During performance+    PictureDuringPerformance+  | -- | Movie\/video screen capture+    PictureVideoScreenCapture+  | -- | A bright coloured fish+    PictureFish+  | -- | Illustration+    PictureIllustration+  | -- | Band\/artist logotype+    PictureBandLogotype+  | -- | Publisher\/studio logotype+    PicturePublisherLogotype   deriving (Show, Read, Eq, Ord, Bounded, Enum)  -- | Representation of picture contained in a FLAC metadata block.- data PictureData = PictureData-  { pictureMimeType    :: !Text-    -- ^ The picture's MIME data. For best compatibility with players, use+  { -- | The picture's MIME data. For best compatibility with players, use     -- picture data of MIME type @image\/jpeg@ or @image\/png@.-  , pictureDescription :: !Text   -- ^ Picture's description.-  , pictureWidth       :: !Word32 -- ^ Picture's width in pixels.-  , pictureHeight      :: !Word32 -- ^ Picture's height in pixels.-  , pictureDepth       :: !Word32 -- ^ Picture's color depth in bits-per-pixel.-  , pictureColors      :: !Word32-    -- ^ For indexed palettes (like GIF), picture's number of colors (the+    pictureMimeType :: !Text,+    -- | Picture's description.+    pictureDescription :: !Text,+    -- | Picture's width in pixels.+    pictureWidth :: !Word32,+    -- | Picture's height in pixels.+    pictureHeight :: !Word32,+    -- | Picture's color depth in bits-per-pixel.+    pictureDepth :: !Word32,+    -- | For indexed palettes (like GIF), picture's number of colors (the     -- number of palette entries), or 0 for non-indexed (i.e. 2 ^ depth).-  , pictureData        :: !ByteString -- ^ Binary picture data.-  } deriving (Eq, Ord, Show, Read)+    pictureColors :: !Word32,+    -- | Binary picture data.+    pictureData :: !ByteString+  }+  deriving (Eq, Ord, Show, Read)
Codec/Audio/FLAC/StreamDecoder.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE RecordWildCards #-}+ -- | -- Module      :  Codec.Audio.FLAC.StreamDecoder--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -12,8 +14,7 @@ -- === How to use this module -- -- Just call the 'decodeFlac' function with 'DecoderSettings', input and--- output file names. The 'decodeFlac' function can produce vanilla WAVE and--- RF64.+-- output file names. The 'decodeFlac' function can produce WAVE and RF64. -- -- === Low-level details --@@ -25,16 +26,14 @@ -- Decoding speed is equal to that of @flac@ command line tool. Memory -- consumption is minimal and remains constant regardless of the size of -- file to decode.--{-# LANGUAGE RecordWildCards #-}- module Codec.Audio.FLAC.StreamDecoder-  ( DecoderSettings (..)-  , defaultDecoderSettings-  , DecoderException (..)-  , DecoderInitStatus (..)-  , DecoderState (..)-  , decodeFlac )+  ( DecoderSettings (..),+    defaultDecoderSettings,+    DecoderException (..),+    DecoderInitStatus (..),+    DecoderState (..),+    decodeFlac,+  ) where  import Codec.Audio.FLAC.Metadata@@ -54,51 +53,55 @@ import System.IO  -- | Parameters of the stream decoder.- data DecoderSettings = DecoderSettings-  { decoderMd5Checking :: !Bool-    -- ^ If 'True', the decoder will compute the MD5 signature of the+  { -- | If 'True', the decoder will compute the MD5 signature of the     -- unencoded audio data while decoding and compare it to the signature     -- from the STREAMINFO block. Default value: 'False'.-  , decoderWaveFormat :: !WaveFormat-    -- ^ This specifies WAVE format in which to save the decoded file. You+    decoderMd5Checking :: !Bool,+    -- | This specifies WAVE format in which to save the decoded file. You     -- can choose between 'WaveVanilla' and 'WaveRF64'; choose the latter if     -- uncompressed file is expected to be longer than 4 Gb. Default value:     -- 'WaveVanilla'.-  } deriving (Show, Read, Eq, Ord)+    decoderWaveFormat :: !WaveFormat+  }+  deriving (Show, Read, Eq, Ord)  -- | Default 'DecoderSettings'. -- -- @since 0.2.0- defaultDecoderSettings :: DecoderSettings-defaultDecoderSettings = DecoderSettings-  { decoderMd5Checking = False-  , decoderWaveFormat  = WaveVanilla-  }+defaultDecoderSettings =+  DecoderSettings+    { decoderMd5Checking = False,+      decoderWaveFormat = WaveVanilla+    }  -- | Decode a FLAC file to WAVE. -- -- 'DecoderException' is thrown when underlying FLAC decoder reports a -- problem.--decodeFlac :: MonadIO m-  => DecoderSettings   -- ^ Decoder settings-  -> FilePath          -- ^ File to decode-  -> FilePath          -- ^ Where to save the resulting WAVE file-  -> m ()+decodeFlac ::+  (MonadIO m) =>+  -- | Decoder settings+  DecoderSettings ->+  -- | File to decode+  FilePath ->+  -- | Where to save the resulting WAVE file+  FilePath ->+  m () decodeFlac DecoderSettings {..} ipath' opath' = liftIO . withDecoder $ \d -> do   ipath <- makeAbsolute ipath'   opath <- makeAbsolute opath'   liftInit (decoderSetMd5Checking d decoderMd5Checking)   (maxBlockSize, wave) <- runFlacMeta defaultMetaSettings ipath $ do-    let waveFileFormat   = decoderWaveFormat-        waveDataOffset   = 0-        waveDataSize     = 0-        waveOtherChunks  = []+    let waveFileFormat = decoderWaveFormat+        waveDataOffset = 0+        waveDataSize = 0+        waveOtherChunks = []     waveSampleRate <- retrieve SampleRate-    waveSampleFormat <- SampleFormatPcmInt . fromIntegral-      <$> retrieve BitsPerSample+    waveSampleFormat <-+      SampleFormatPcmInt . fromIntegral+        <$> retrieve BitsPerSample     waveChannelMask <- retrieve ChannelMask     waveSamplesTotal <- retrieve TotalSamples     maxBlockSize <- fromIntegral <$> retrieve MaxBlockSize@@ -132,22 +135,21 @@ -- Helpers  -- | Execute an initializing action that returns 'False' on failure and take--- care of error reporting. In the case of trouble, @'DecoderInitFailed'--- 'DecoderInitStatusAlreadyInitialized'@ is thrown.-+-- care of error reporting.+--+-- Throws @'DecoderInitFailed' 'DecoderInitStatusAlreadyInitialized'@. liftInit :: IO Bool -> IO () liftInit m = liftIO m >>= bool t (return ())   where     t = throwIO (DecoderInitFailed DecoderInitStatusAlreadyInitialized)  -- | Execute an action that returns 'False' on failure into taking care of--- error reporting. In the case of trouble @'EncoderFailed'@ with encoder--- status attached is thrown.-+-- error reporting.+--+-- Throws @'EncoderFailed'@. liftBool :: Decoder -> IO Bool -> IO () liftBool encoder m = liftIO m >>= bool (throwState encoder) (return ())  -- | Get 'DecoderState' from a given 'Decoder' and throw it immediately.- throwState :: Decoder -> IO a throwState = decoderGetState >=> throwIO . DecoderFailed
Codec/Audio/FLAC/StreamDecoder/Internal.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE LambdaCase #-}+ -- | -- Module      :  Codec.Audio.FLAC.StreamDecoder.Internal--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -8,18 +11,15 @@ -- Portability :  portable -- -- Low-level Haskell wrapper around FLAC stream decoder API.--{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE LambdaCase               #-}- module Codec.Audio.FLAC.StreamDecoder.Internal-  ( withDecoder-  , decoderSetMd5Checking-  , decoderGetState-  , decoderGetBlockSize-  , decoderProcessSingle-  , decoderProcessUntilEndOfMetadata-  , decoderFinish )+  ( withDecoder,+    decoderSetMd5Checking,+    decoderGetState,+    decoderGetBlockSize,+    decoderProcessSingle,+    decoderProcessUntilEndOfMetadata,+    decoderFinish,+  ) where  import Codec.Audio.FLAC.StreamDecoder.Internal.Types@@ -33,16 +33,15 @@ -- -- If memory for the encoder cannot be allocated, corresponding -- 'DecoderException' is raised.- withDecoder :: (Decoder -> IO a) -> IO a withDecoder f = bracket decoderNew (mapM_ decoderDelete) $ \case-  Nothing -> throwM-    (DecoderFailed DecoderStateMemoryAllocationError)+  Nothing ->+    throwM+      (DecoderFailed DecoderStateMemoryAllocationError)   Just x -> f x  -- | Create a new stream decoder instance with the default settings. In the -- case of memory allocation problem 'Nothing' is returned.- decoderNew :: IO (Maybe Decoder) decoderNew = maybePtr <$> c_decoder_new @@ -50,7 +49,6 @@   c_decoder_new :: IO Decoder  -- | Free a decoder instance.- decoderDelete :: Decoder -> IO () decoderDelete = c_decoder_delete @@ -60,7 +58,6 @@ -- | Set MD5 signature checking. If 'True' the decoder will compute the MD5 -- signature of the unencoded audio data while decoding and compare it to -- the signature from the stream info block.- decoderSetMd5Checking :: Decoder -> Bool -> IO Bool decoderSetMd5Checking = c_decoder_set_md5_checking @@ -68,7 +65,6 @@   c_decoder_set_md5_checking :: Decoder -> Bool -> IO Bool  -- | Get the current decoder state.- decoderGetState :: Decoder -> IO DecoderState decoderGetState = fmap toEnum' . c_decoder_get_state @@ -77,7 +73,6 @@  -- | Get frame size as a number of inter-channel samples of last decoded -- frame.- decoderGetBlockSize :: Decoder -> IO Word32 decoderGetBlockSize = fmap fromIntegral . c_decoder_get_blocksize @@ -85,7 +80,6 @@   c_decoder_get_blocksize :: Decoder -> IO CUInt  -- | Process one audio frame. Return 'False' on failure.- decoderProcessSingle :: Decoder -> IO Bool decoderProcessSingle = c_decoder_process_single @@ -94,7 +88,6 @@  -- | Decode until the end of the metadata. We use this to skip to the audio -- stream.- decoderProcessUntilEndOfMetadata :: Decoder -> IO Bool decoderProcessUntilEndOfMetadata = c_decoder_process_until_end_of_metadata @@ -103,7 +96,6 @@  -- | Finish the decoding process and release resources (also resets decoder -- and its settings). Return 'False' in the case of trouble.- decoderFinish :: Decoder -> IO Bool decoderFinish = c_decoder_finish
Codec/Audio/FLAC/StreamDecoder/Internal/Helpers.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE ForeignFunctionInterface #-}+ -- | -- Module      :  Codec.Audio.FLAC.StreamDecoder.Internal.Helpers--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -8,11 +10,9 @@ -- Portability :  portable -- -- Wrappers around helpers written to help work with the stream decoder.--{-# LANGUAGE ForeignFunctionInterface #-}- module Codec.Audio.FLAC.StreamDecoder.Internal.Helpers-  ( decoderInitHelper )+  ( decoderInitHelper,+  ) where  import Codec.Audio.FLAC.StreamDecoder.Internal.Types@@ -25,23 +25,26 @@ -- | Initialize decoder to decode FLAC file and register buffer where -- decoded audio data will go (which must be big enough). Return -- 'DecoderInitStatus'.--decoderInitHelper-  :: Decoder           -- ^ 'Decoder' to use-  -> FilePath          -- ^ FLAC file to decode-  -> Ptr Void          -- ^ Buffer where to write decoded audio data-  -> IO DecoderInitStatus-     -- ^ Sample rate, bits per sample, channels+decoderInitHelper ::+  -- | 'Decoder' to use+  Decoder ->+  -- | FLAC file to decode+  FilePath ->+  -- | Buffer where to write decoded audio data+  Ptr Void ->+  -- | Sample rate, bits per sample, channels+  IO DecoderInitStatus decoderInitHelper decoder ipath buffer =   withCString ipath $ \ipathPtr ->-    toEnum' <$> c_decoder_init_helper-      decoder          -- stream decoder-      ipathPtr         -- name of FLAC file to decode-      buffer           -- output buffer+    toEnum'+      <$> c_decoder_init_helper+        decoder -- stream decoder+        ipathPtr -- name of FLAC file to decode+        buffer -- output buffer  foreign import ccall unsafe "FLAC__stream_decoder_init_helper"-  c_decoder_init_helper-    :: Decoder-    -> CString-    -> Ptr Void-    -> IO CUInt+  c_decoder_init_helper ::+    Decoder ->+    CString ->+    Ptr Void ->+    IO CUInt
Codec/Audio/FLAC/StreamDecoder/Internal/Types.hs view
@@ -1,6 +1,6 @@ -- | -- Module      :  Codec.Audio.FLAC.StreamDecoder.Internal.Types--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -8,13 +8,13 @@ -- Portability :  portable -- -- Mostly non-public stream decoder-specific helper types.- module Codec.Audio.FLAC.StreamDecoder.Internal.Types-  ( Decoder (..)-  , DecoderInitStatus (..)-  , DecoderState (..)-  , DecoderException (..)-  , ChannelAssignment (..) )+  ( Decoder (..),+    DecoderInitStatus (..),+    DecoderState (..),+    DecoderException (..),+    ChannelAssignment (..),+  ) where  import Control.Exception@@ -23,71 +23,70 @@  -- | An opaque newtype wrapper around @'Ptr' 'Void'@, serves to represent -- point to decoder instance.- newtype Decoder = Decoder (Ptr Void)  -- | Status of decoder initialization process.- data DecoderInitStatus-  = DecoderInitStatusOK-    -- ^ Initialization was successful.-  | DecoderInitStatusUnsupportedContainer-    -- ^ The library was not compiled with support for the given container+  = -- | Initialization was successful.+    DecoderInitStatusOK+  | -- | The library was not compiled with support for the given container     -- format.-  | DecoderInitStatusInvalidCallbacks-    -- ^ A required callback was not supplied.-  | DecoderInitStatusMemoryAllocationError-    -- ^ An error occurred allocating memory.-  | DecoderInitStatusErrorOpeningFile-    -- ^ fopen() failed.-  | DecoderInitStatusAlreadyInitialized-    -- ^ Initialization was attempted on already initialized decoder.+    DecoderInitStatusUnsupportedContainer+  | -- | A required callback was not supplied.+    DecoderInitStatusInvalidCallbacks+  | -- | An error occurred allocating memory.+    DecoderInitStatusMemoryAllocationError+  | -- | fopen() failed.+    DecoderInitStatusErrorOpeningFile+  | -- | Initialization was attempted on already initialized decoder.+    DecoderInitStatusAlreadyInitialized   deriving (Show, Read, Eq, Ord, Bounded, Enum)  -- | Enumeration of decoder states.- data DecoderState-  = DecoderStateSearchForMetadata-    -- ^ The decoder is ready to search for metadata.-  | DecoderStateReadMetadata-    -- ^ The decoder is ready to or is in the process of reading metadata.-  | DecoderStateSearchForFrameSync-    -- ^ The decoder is ready to or is in the process of searching for the+  = -- | The decoder is ready to search for metadata.+    DecoderStateSearchForMetadata+  | -- | The decoder is ready to or is in the process of reading metadata.+    DecoderStateReadMetadata+  | -- | The decoder is ready to or is in the process of searching for the     -- frame sync code.-  | DecoderStateReadFrame-    -- ^ The decoder is ready to or is in the process of reading a frame.-  | DecoderStateEndOfStream-    -- ^ The decoder has reached the end of the stream.-  | DecoderStateOggError-    -- ^ An error occurred in the underlying Ogg layer.-  | DecoderStateSeekError-    -- ^ An error occurred while seeking. The decoder must be flushed or+    DecoderStateSearchForFrameSync+  | -- | The decoder is ready to or is in the process of reading a frame.+    DecoderStateReadFrame+  | -- | The decoder has reached the end of the stream.+    DecoderStateEndOfStream+  | -- | An error occurred in the underlying Ogg layer.+    DecoderStateOggError+  | -- | An error occurred while seeking. The decoder must be flushed or     -- reset before decoding can continue.-  | DecoderStateAborted-    -- ^ The decoder was aborted by the read callback.-  | DecoderStateMemoryAllocationError-    -- ^ An error occurred allocating memory. The decoder is in an invalid+    DecoderStateSeekError+  | -- | The decoder was aborted by the read callback.+    DecoderStateAborted+  | -- | An error occurred allocating memory. The decoder is in an invalid     -- state and can no longer be used.-  | DecoderStateUnititialized-    -- ^ The decoder is in the uninitialized state.+    DecoderStateMemoryAllocationError+  | -- | The decoder is in the uninitialized state.+    DecoderStateUnititialized   deriving (Show, Read, Eq, Ord, Bounded, Enum)  -- | Exception that is thrown when decoding fails for some reason.- data DecoderException-  = DecoderInitFailed DecoderInitStatus-    -- ^ Decoder initialization failed.-  | DecoderFailed DecoderState-    -- ^ Decoder failed.+  = -- | Decoder initialization failed.+    DecoderInitFailed DecoderInitStatus+  | -- | Decoder failed.+    DecoderFailed DecoderState   deriving (Eq, Show, Read)  instance Exception DecoderException  -- | An enumeration of the available channel assignments.- data ChannelAssignment-  = ChannelAssignmentIndependent -- ^ Independent channels-  | ChannelAssignmentLeftSide    -- ^ Left+side stereo-  | ChannelAssignmentRightSide   -- ^ Right+side stereo-  | ChannelAssignmentMidSide     -- ^ Mid+side stereo+  = -- | Independent channels+    ChannelAssignmentIndependent+  | -- | Left+side stereo+    ChannelAssignmentLeftSide+  | -- | Right+side stereo+    ChannelAssignmentRightSide+  | -- | Mid+side stereo+    ChannelAssignmentMidSide   deriving (Show, Read, Eq, Ord, Bounded, Enum)
Codec/Audio/FLAC/StreamEncoder.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE RecordWildCards #-}+ -- | -- Module      :  Codec.Audio.FLAC.StreamEncoder--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -12,8 +14,7 @@ -- === How to use this module -- -- Just call the 'encodeFlac' function with 'EncoderSettings', input and--- output file names. The 'encodeFlac' function only encodes vanilla WAVE--- and RF64.+-- output file names. The 'encodeFlac' function only encodes WAVE and RF64. -- -- === Low-level details --@@ -25,16 +26,14 @@ -- Encoding speed is equal to that of @flac@ command line tool. Memory -- consumption is minimal and remains constant regardless of size of file to -- decode.--{-# LANGUAGE RecordWildCards #-}- module Codec.Audio.FLAC.StreamEncoder-  ( EncoderSettings (..)-  , defaultEncoderSettings-  , EncoderException (..)-  , EncoderInitStatus (..)-  , EncoderState (..)-  , encodeFlac )+  ( EncoderSettings (..),+    defaultEncoderSettings,+    EncoderException (..),+    EncoderInitStatus (..),+    EncoderState (..),+    encodeFlac,+  ) where  import Codec.Audio.FLAC.StreamEncoder.Internal@@ -59,47 +58,45 @@ -- specifying 'Nothing' (default), or use something specific by passing a -- value inside 'Just'. Thorough understanding of the FLAC format is -- necessary to achieve good results, though.- data EncoderSettings = EncoderSettings-  { encoderCompression :: !Word32-    -- ^ Compression level [0..8], default is 5.-  , encoderBlockSize :: !Word32-    -- ^ Block size, default is 0.-  , encoderVerify :: !Bool-    -- ^ Verify result (slower), default is 'False'.-  , encoderDoMidSideStereo :: !(Maybe Bool)-    -- ^ Enable mid-side encoding on stereo input. The number of channels+  { -- | Compression level [0..8], default is 5.+    encoderCompression :: !Word32,+    -- | Block size, default is 0.+    encoderBlockSize :: !Word32,+    -- | Verify result (slower), default is 'False'.+    encoderVerify :: !Bool,+    -- | Enable mid-side encoding on stereo input. The number of channels     -- must be 2 for this to have any effect. Default value: 'Nothing'.-  , encoderLooseMidSideStereo :: !(Maybe Bool)-    -- ^ Set to 'True' to enable adaptive switching between mid-side and+    encoderDoMidSideStereo :: !(Maybe Bool),+    -- | Set to 'True' to enable adaptive switching between mid-side and     -- left-right encoding on stereo input. Set to 'False' to use exhaustive     -- searching. Setting this to 'True' requires 'encoderDoMidSideStereo'     -- to also be set to 'True' in order to have any effect. Default value:     -- 'Nothing'.-  , encoderApodization :: !(Maybe (NonEmpty ApodizationFunction))-    -- ^ Sets the apodization function(s) the encoder will use when+    encoderLooseMidSideStereo :: !(Maybe Bool),+    -- | Sets the apodization function(s) the encoder will use when     -- windowing audio data for LPC analysis. Up to 32 functions are kept,     -- the rest are dropped. Import     -- "Codec.Audio.FLAC.StreamEncoder.Apodization" to bring apodization     -- functions in scope. Default value: 'Nothing'.-  , encoderMaxLpcOrder :: !(Maybe Word32)-    -- ^ Set maximum LPC order, or 0 to use the fixed predictors. Default+    encoderApodization :: !(Maybe (NonEmpty ApodizationFunction)),+    -- | Set maximum LPC order, or 0 to use the fixed predictors. Default     -- value: 'Nothing'.-  , encoderQlpCoeffPrecision :: !(Maybe Word32)-    -- ^ Set the precision in bits of the quantized linear predictor+    encoderMaxLpcOrder :: !(Maybe Word32),+    -- | Set the precision in bits of the quantized linear predictor     -- coefficients, or 0 to let the encoder select it based on the     -- blocksize. Default value: 'Nothing'.-  , encoderDoQlpCoeffPrecisionSearch :: !(Maybe Bool)-    -- ^ Set to 'False' to use only the specified quantized linear predictor+    encoderQlpCoeffPrecision :: !(Maybe Word32),+    -- | Set to 'False' to use only the specified quantized linear predictor     -- coefficient precision, or 'True' to search neighboring precision     -- values and use the best one. Default value: 'Nothing'.-  , encoderDoExhaustiveModelSearch :: !(Maybe Bool)-    -- ^ Set to 'False' to let the encoder estimate the best model order+    encoderDoQlpCoeffPrecisionSearch :: !(Maybe Bool),+    -- | Set to 'False' to let the encoder estimate the best model order     -- based on the residual signal energy, or 'True' to force the encoder     -- to evaluate all order models and select the best. Default value:     -- 'Nothing'.-  , encoderResidualPartitionOrders :: !(Maybe (Word32, Word32))-    -- ^ Set the minimum and maximum partition order to search when coding+    encoderDoExhaustiveModelSearch :: !(Maybe Bool),+    -- | Set the minimum and maximum partition order to search when coding     -- the residual. The partition order determines the context size in the     -- residual. The context size will be approximately @blocksize / (2 ^     -- order)@. Set both min and max values to 0 to force a single context,@@ -107,26 +104,28 @@     -- Otherwise, set a min and max order, and the encoder will search all     -- orders, using the mean of each context for its Rice parameter, and     -- use the best. Default: 'Nothing'.-  } deriving (Show, Read, Eq, Ord)+    encoderResidualPartitionOrders :: !(Maybe (Word32, Word32))+  }+  deriving (Show, Read, Eq, Ord)  -- | Default 'EncoderSettings'. -- -- @since 0.2.0- defaultEncoderSettings :: EncoderSettings-defaultEncoderSettings = EncoderSettings-  { encoderCompression = 5-  , encoderBlockSize = 0-  , encoderVerify = False-  , encoderDoMidSideStereo = Nothing-  , encoderLooseMidSideStereo = Nothing-  , encoderApodization = Nothing-  , encoderMaxLpcOrder = Nothing-  , encoderQlpCoeffPrecision = Nothing-  , encoderDoQlpCoeffPrecisionSearch = Nothing-  , encoderDoExhaustiveModelSearch = Nothing-  , encoderResidualPartitionOrders = Nothing-  }+defaultEncoderSettings =+  EncoderSettings+    { encoderCompression = 5,+      encoderBlockSize = 0,+      encoderVerify = False,+      encoderDoMidSideStereo = Nothing,+      encoderLooseMidSideStereo = Nothing,+      encoderApodization = Nothing,+      encoderMaxLpcOrder = Nothing,+      encoderQlpCoeffPrecision = Nothing,+      encoderDoQlpCoeffPrecisionSearch = Nothing,+      encoderDoExhaustiveModelSearch = Nothing,+      encoderResidualPartitionOrders = Nothing+    }  -- | Encode a WAVE file or RF64 file to native FLAC. --@@ -140,46 +139,58 @@ --     * Number of channels may be only 1–8 inclusive. --     * Supported values for bits per sample are 4–24 inclusive. --     * Acceptable sample rate lies in the range 1–655350 inclusive.--encodeFlac :: MonadIO m-  => EncoderSettings   -- ^ Encoder settings-  -> FilePath          -- ^ File to encode-  -> FilePath          -- ^ Where to save the resulting FLAC file-  -> m ()+encodeFlac ::+  (MonadIO m) =>+  -- | Encoder settings+  EncoderSettings ->+  -- | File to encode+  FilePath ->+  -- | Where to save the resulting FLAC file+  FilePath ->+  m () encodeFlac EncoderSettings {..} ipath' opath' = liftIO . withEncoder $ \e -> do   ipath <- makeAbsolute ipath'   opath <- makeAbsolute opath'-  wave  <- readWaveFile ipath+  wave <- readWaveFile ipath   case waveSampleFormat wave of     SampleFormatPcmInt _ -> return ()     fmt -> throwIO (EncoderInvalidSampleFormat fmt)-  let channels      = fromIntegral (waveChannels wave)+  let channels = fromIntegral (waveChannels wave)       bitsPerSample = fromIntegral (waveBitsPerSample wave)-      sampleRate    = waveSampleRate wave-      totalSamples  = waveSamplesTotal wave-  liftInit (encoderSetChannels      e channels)+      sampleRate = waveSampleRate wave+      totalSamples = waveSamplesTotal wave+  liftInit (encoderSetChannels e channels)   liftInit (encoderSetBitsPerSample e bitsPerSample)-  liftInit (encoderSetSampleRate    e sampleRate)-  liftInit (encoderSetCompression   e encoderCompression)-  liftInit (encoderSetBlockSize     e encoderBlockSize)-  liftInit (encoderSetVerify        e encoderVerify)-  forM_ encoderDoMidSideStereo+  liftInit (encoderSetSampleRate e sampleRate)+  liftInit (encoderSetCompression e encoderCompression)+  liftInit (encoderSetBlockSize e encoderBlockSize)+  liftInit (encoderSetVerify e encoderVerify)+  forM_+    encoderDoMidSideStereo     (liftInit . encoderSetDoMidSideStereo e)-  forM_ encoderLooseMidSideStereo+  forM_+    encoderLooseMidSideStereo     (liftInit . encoderSetLooseMidSideStereo e)-  forM_ encoderApodization+  forM_+    encoderApodization     (liftInit . encoderSetApodization e . renderApodizationSpec)-  forM_ encoderMaxLpcOrder+  forM_+    encoderMaxLpcOrder     (liftInit . encoderSetMaxLpcOrder e)-  forM_ encoderQlpCoeffPrecision+  forM_+    encoderQlpCoeffPrecision     (liftInit . encoderSetQlpCoeffPrecision e)-  forM_ encoderDoQlpCoeffPrecisionSearch+  forM_+    encoderDoQlpCoeffPrecisionSearch     (liftInit . encoderSetDoQlpCoeffPrecisionSearch e)-  forM_ encoderDoExhaustiveModelSearch+  forM_+    encoderDoExhaustiveModelSearch     (liftInit . encoderSetDoExhaustiveModelSearch e)-  forM_ encoderResidualPartitionOrders+  forM_+    encoderResidualPartitionOrders     (liftInit . encoderSetMinResidualPartitionOrder e . fst)-  forM_ encoderResidualPartitionOrders+  forM_+    encoderResidualPartitionOrders     (liftInit . encoderSetMaxResidualPartitionOrder e . snd)   -- Set the estimate (which is likely correct), to avoid rewrite of   -- STREAMINFO metadata block after encoding.@@ -189,10 +200,12 @@     case initStatus of       EncoderInitStatusOK -> return ()       status -> throwIO (EncoderInitFailed status)-    liftBool e $ encoderProcessHelper e-      (fromIntegral $ waveDataOffset wave)-      (waveDataSize wave)-      ipath+    liftBool e $+      encoderProcessHelper+        e+        (fromIntegral $ waveDataOffset wave)+        (waveDataSize wave)+        ipath     liftBool e (encoderFinish e)     renameFile otemp opath @@ -200,22 +213,21 @@ -- Helpers  -- | Execute an initializing action that returns 'False' on failure and take--- care of error reporting. In case of trouble, @'EncoderInitFailed'--- 'EncoderInitStatusAlreadyInitialized'@ is thrown.-+-- care of error reporting.+--+-- Throws @'EncoderInitFailed' 'EncoderInitStatusAlreadyInitialized'@. liftInit :: IO Bool -> IO () liftInit m = liftIO m >>= bool t (return ())   where     t = throwIO (EncoderInitFailed EncoderInitStatusAlreadyInitialized)  -- | Execute an action that returns 'False' on failure into taking care of--- error reporting. In case of trouble @'EncoderFailed'@ with encoder status--- attached is thrown.-+-- error reporting.+--+-- Throws @'EncoderFailed'@. liftBool :: Encoder -> IO Bool -> IO () liftBool encoder m = liftIO m >>= bool (throwState encoder) (return ())  -- | Get 'EncoderState' from given 'Encoder' and throw it immediately.- throwState :: Encoder -> IO a throwState = encoderGetState >=> throwIO . EncoderFailed
Codec/Audio/FLAC/StreamEncoder/Apodization.hs view
@@ -1,6 +1,6 @@ -- | -- Module      :  Codec.Audio.FLAC.StreamEncoder.Apodization--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -11,9 +11,9 @@ -- needed, and thus should not “contaminate” the -- "Codec.Audio.FLAC.StreamEncoder" module with potentially confilcting -- names.- module Codec.Audio.FLAC.StreamEncoder.Apodization-  ( ApodizationFunction (..) )+  ( ApodizationFunction (..),+  ) where  import Codec.Audio.FLAC.StreamEncoder.Internal.Types
Codec/Audio/FLAC/StreamEncoder/Internal.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE LambdaCase #-}+ -- | -- Module      :  Codec.Audio.FLAC.StreamEncoder.Internal--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -10,58 +13,54 @@ -- Low-level Haskell wrapper around FLAC stream encoder API, see: -- -- <https://xiph.org/flac/api/group__flac__stream__encoder.html>--{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE LambdaCase               #-}- module Codec.Audio.FLAC.StreamEncoder.Internal-  ( withEncoder-  , encoderSetChannels-  , encoderSetBitsPerSample-  , encoderSetSampleRate-  , encoderSetCompression-  , encoderSetBlockSize-  , encoderSetDoMidSideStereo-  , encoderSetLooseMidSideStereo-  , encoderSetApodization-  , encoderSetMaxLpcOrder-  , encoderSetQlpCoeffPrecision-  , encoderSetDoQlpCoeffPrecisionSearch-  , encoderSetDoExhaustiveModelSearch-  , encoderSetMinResidualPartitionOrder-  , encoderSetMaxResidualPartitionOrder-  , encoderSetTotalSamplesEstimate-  , encoderSetVerify-  , encoderGetState-  , encoderInitFile-  , encoderFinish )+  ( withEncoder,+    encoderSetChannels,+    encoderSetBitsPerSample,+    encoderSetSampleRate,+    encoderSetCompression,+    encoderSetBlockSize,+    encoderSetDoMidSideStereo,+    encoderSetLooseMidSideStereo,+    encoderSetApodization,+    encoderSetMaxLpcOrder,+    encoderSetQlpCoeffPrecision,+    encoderSetDoQlpCoeffPrecisionSearch,+    encoderSetDoExhaustiveModelSearch,+    encoderSetMinResidualPartitionOrder,+    encoderSetMaxResidualPartitionOrder,+    encoderSetTotalSamplesEstimate,+    encoderSetVerify,+    encoderGetState,+    encoderInitFile,+    encoderFinish,+  ) where  import Codec.Audio.FLAC.StreamEncoder.Internal.Types import Codec.Audio.FLAC.Util import Control.Monad.Catch import Data.ByteString (ByteString)+import Data.ByteString qualified as B import Data.Void import Foreign import Foreign.C.String import Foreign.C.Types-import qualified Data.ByteString as B  -- | Create and use an 'Encoder'. The encoder is guaranteed to be freed even -- in the case of exception. -- -- If memory for the encoder cannot be allocated, corresponding -- 'EncoderException' is raised.- withEncoder :: (Encoder -> IO a) -> IO a withEncoder f = bracket encoderNew (mapM_ encoderDelete) $ \case-  Nothing -> throwM-    (EncoderFailed EncoderStateMemoryAllocationError)+  Nothing ->+    throwM+      (EncoderFailed EncoderStateMemoryAllocationError)   Just x -> f x  -- | Create a new stream encoder instance with the default settings. In the -- case of memory allocation problem 'Nothing' is returned.- encoderNew :: IO (Maybe Encoder) encoderNew = maybePtr <$> c_encoder_new @@ -69,7 +68,6 @@   c_encoder_new :: IO Encoder  -- | Free an encoder instance.- encoderDelete :: Encoder -> IO () encoderDelete = c_encoder_delete @@ -78,7 +76,6 @@  -- | Set the number of channels to be encoded. Return 'False' if encoder is -- already initialized.- encoderSetChannels :: Encoder -> Word32 -> IO Bool encoderSetChannels encoder channels =   c_encoder_set_channels encoder (fromIntegral channels)@@ -88,7 +85,6 @@  -- | Set the sample resolution of the input to be encoded. Return 'False' if -- encoder is already initialized.- encoderSetBitsPerSample :: Encoder -> Word32 -> IO Bool encoderSetBitsPerSample encoder bps =   c_encoder_set_bits_per_sample encoder (fromIntegral bps)@@ -98,7 +94,6 @@  -- | Set the sample rate in Hz of the input to be encoded. Return 'False' if -- encoder is already initialized.- encoderSetSampleRate :: Encoder -> Word32 -> IO Bool encoderSetSampleRate encoder sampleRate =   c_encoder_set_sample_rate encoder (fromIntegral sampleRate)@@ -109,7 +104,6 @@ -- | Set the compression level. The argument can range from 0 (fastest, -- least compression) to 8 (slowest, most compression). A value higher than -- 8 will be treated as 8. Return 'False' if encoder is already initialized.- encoderSetCompression :: Encoder -> Word32 -> IO Bool encoderSetCompression encoder level =   c_encoder_set_compression_level encoder (fromIntegral level)@@ -118,7 +112,6 @@   c_encoder_set_compression_level :: Encoder -> CUInt -> IO Bool  -- | Set the blocksize to use while encoding.- encoderSetBlockSize :: Encoder -> Word32 -> IO Bool encoderSetBlockSize encoder blockSize =   c_encoder_set_blocksize encoder (fromIntegral blockSize)@@ -127,7 +120,6 @@   c_encoder_set_blocksize :: Encoder -> CUInt -> IO Bool  -- | Set to 'True' to enable mid-side encoding on stereo input.- encoderSetDoMidSideStereo :: Encoder -> Bool -> IO Bool encoderSetDoMidSideStereo = c_encoder_set_do_mid_side_stereo @@ -137,7 +129,6 @@ -- | Set to 'True' to enable adaptive switching between mid-side and -- left-right encoding on stereo input. Set to 'False' to use exhaustive -- searching.- encoderSetLooseMidSideStereo :: Encoder -> Bool -> IO Bool encoderSetLooseMidSideStereo = c_encoder_set_loose_mid_side_stereo @@ -146,7 +137,6 @@  -- | Set the apodization function(s) the encoder will use when windowing -- audio data for LPC analysis.- encoderSetApodization :: Encoder -> ByteString -> IO Bool encoderSetApodization encoder specification =   B.useAsCString specification (c_encoder_set_apodization encoder)@@ -155,7 +145,6 @@   c_encoder_set_apodization :: Encoder -> CString -> IO Bool  -- | Set the maximum LPC order, or 0 to use only the fixed predictors.- encoderSetMaxLpcOrder :: Encoder -> Word32 -> IO Bool encoderSetMaxLpcOrder encoder value =   c_encoder_set_max_lpc_order encoder (fromIntegral value)@@ -165,7 +154,6 @@  -- | Set the precision in bits, of the quantized linear predictor -- coefficients, or 0 to let the encoder select it based on the blocksize.- encoderSetQlpCoeffPrecision :: Encoder -> Word32 -> IO Bool encoderSetQlpCoeffPrecision encoder value =   c_encoder_set_qlp_coeff_precision encoder (fromIntegral value)@@ -176,7 +164,6 @@ -- | Set to 'False' to use only the specified quantized linear predictor -- coefficient precision, or 'True' to search neighboring precision values -- and use the best one.- encoderSetDoQlpCoeffPrecisionSearch :: Encoder -> Bool -> IO Bool encoderSetDoQlpCoeffPrecisionSearch = c_encoder_set_qlp_coeff_prec_search @@ -186,7 +173,6 @@ -- | Set to 'False' to let the encoder estimate the best model order based -- on the residual signal energy, or 'True' to force the encoder to evaluate -- all order models and select the best.- encoderSetDoExhaustiveModelSearch :: Encoder -> Bool -> IO Bool encoderSetDoExhaustiveModelSearch = c_encoder_set_do_exhaustive_model_search @@ -194,7 +180,6 @@   c_encoder_set_do_exhaustive_model_search :: Encoder -> Bool -> IO Bool  -- | Set the minimum partition order to search when coding the residual.- encoderSetMinResidualPartitionOrder :: Encoder -> Word32 -> IO Bool encoderSetMinResidualPartitionOrder encoder value =   c_encoder_set_min_residual_partition_order encoder (fromIntegral value)@@ -203,7 +188,6 @@   c_encoder_set_min_residual_partition_order :: Encoder -> CUInt -> IO Bool  -- | Set the maximum partition order to search when coding the residual.- encoderSetMaxResidualPartitionOrder :: Encoder -> Word32 -> IO Bool encoderSetMaxResidualPartitionOrder encoder value =   c_encoder_set_max_residual_partition_order encoder (fromIntegral value)@@ -216,7 +200,6 @@ -- written to the STREAMINFO block before encoding, and can remove the need -- for the caller to rewrite the value later if the value is known before -- encoding.- encoderSetTotalSamplesEstimate :: Encoder -> Word64 -> IO Bool encoderSetTotalSamplesEstimate = c_encoder_set_total_samples_estimate @@ -228,7 +211,6 @@ -- the original signal against the decoded signal. If a mismatch occurs, the -- process call will return false. Note that this will slow the encoding -- process by the extra time required for decoding and comparison.- encoderSetVerify :: Encoder -> Bool -> IO Bool encoderSetVerify = c_encoder_set_verify @@ -236,7 +218,6 @@   c_encoder_set_verify :: Encoder -> Bool -> IO Bool  -- | Get the current encoder state.- encoderGetState :: Encoder -> IO EncoderState encoderGetState = fmap toEnum' . c_encoder_get_state @@ -244,11 +225,12 @@   c_encoder_get_state :: Encoder -> IO CUInt  -- | Initialize the encoder instance to encode native FLAC files.--encoderInitFile-  :: Encoder           -- ^ Uninitialized encoder instance-  -> FilePath          -- ^ Name of file to encode to-  -> IO EncoderInitStatus+encoderInitFile ::+  -- | Uninitialized encoder instance+  Encoder ->+  -- | Name of file to encode to+  FilePath ->+  IO EncoderInitStatus encoderInitFile encoder path =   withCString path $ \cstr ->     toEnum' <$> c_encoder_init_file encoder cstr nullPtr nullPtr@@ -258,7 +240,6 @@  -- | Finish the encoding process and release resources (also resets encoder -- and its settings). Return 'False' in case of trouble.- encoderFinish :: Encoder -> IO Bool encoderFinish = c_encoder_finish
Codec/Audio/FLAC/StreamEncoder/Internal/Helpers.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+ -- | -- Module      :  Codec.Audio.FLAC.StreamEncoder.Internal.Helpers--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -8,73 +11,72 @@ -- Portability :  portable -- -- Wrappers around helpers written to help work with the stream encoder.--{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE OverloadedStrings        #-}- module Codec.Audio.FLAC.StreamEncoder.Internal.Helpers-  ( encoderProcessHelper-  , renderApodizationSpec )+  ( encoderProcessHelper,+    renderApodizationSpec,+  ) where  import Codec.Audio.FLAC.StreamEncoder.Internal.Types import Data.ByteString (ByteString)+import Data.ByteString.Builder qualified as BU+import Data.ByteString.Lazy qualified as BL import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty (..))-import Data.Monoid ((<>))+import Data.List.NonEmpty qualified as NE import Data.Word (Word64) import Foreign.C.String import Numeric.Natural-import qualified Data.ByteString.Builder as BU-import qualified Data.ByteString.Lazy    as BL-import qualified Data.List.NonEmpty      as NE  -- | Encode given input file, return 'False' in case of failure.--encoderProcessHelper-  :: Encoder           -- ^ 'Encoder' to use-  -> Word64            -- ^ Offset of data chunk-  -> Word64            -- ^ Size of data chunk-  -> FilePath          -- ^ Location of input file (normalized)-  -> IO Bool           -- ^ 'False' in case of trouble+encoderProcessHelper ::+  -- | 'Encoder' to use+  Encoder ->+  -- | Offset of data chunk+  Word64 ->+  -- | Size of data chunk+  Word64 ->+  -- | Location of input file (normalized)+  FilePath ->+  -- | 'False' in case of trouble+  IO Bool encoderProcessHelper encoder dataOffset dataSize ipath =   withCString ipath $ \ipathPtr ->     c_encoder_process_helper-      encoder          -- stream encoder-      dataOffset       -- offset of data chunk-      dataSize         -- size of data chunk-      ipathPtr         -- path to input file+      encoder -- stream encoder+      dataOffset -- offset of data chunk+      dataSize -- size of data chunk+      ipathPtr -- path to input file  foreign import ccall unsafe "FLAC__stream_encoder_process_helper"   c_encoder_process_helper :: Encoder -> Word64 -> Word64 -> CString -> IO Bool  -- | Render apodization functions specification as per description here: -- <https://xiph.org/flac/api/group__flac__stream__encoder.html#ga6598f09ac782a1f2a5743ddf247c81c8>.- renderApodizationSpec :: NonEmpty ApodizationFunction -> ByteString renderApodizationSpec =-  BL.toStrict         .-  BU.toLazyByteString .-  mconcat             .-  intersperse ";"     .-  NE.toList           .-  fmap f+  BL.toStrict+    . BU.toLazyByteString+    . mconcat+    . intersperse ";"+    . NE.toList+    . fmap f   where     f :: ApodizationFunction -> BU.Builder-    f Bartlett                = "bartlett"-    f BartlettHann            = "bartlett_hann"-    f Blackman                = "blackman"+    f Bartlett = "bartlett"+    f BartlettHann = "bartlett_hann"+    f Blackman = "blackman"     f BlackmanHarris4Term92Db = "blackman_harris_4term_92db"-    f Connes                  = "connes"-    f Flattop                 = "flattop"-    f (Gauss stddev)          = "gauss(" <> BU.doubleDec stddev <> ")"-    f Hamming                 = "hamming"-    f Hann                    = "hann"-    f KaiserBessel            = "kaiser_bessel"-    f Nuttall                 = "nuttall"-    f Rectangle               = "rectangle"-    f Triangle                = "triangle"-    f (Tukey p)               = "tukey(" <> BU.doubleDec p <> ")"+    f Connes = "connes"+    f Flattop = "flattop"+    f (Gauss stddev) = "gauss(" <> BU.doubleDec stddev <> ")"+    f Hamming = "hamming"+    f Hann = "hann"+    f KaiserBessel = "kaiser_bessel"+    f Nuttall = "nuttall"+    f Rectangle = "rectangle"+    f Triangle = "triangle"+    f (Tukey p) = "tukey(" <> BU.doubleDec p <> ")"     f (PartialTukey n Nothing) =       "partial_tukey(" <> natDec n <> ")"     f (PartialTukey n (Just (ov, Nothing))) =@@ -87,6 +89,6 @@       "punchout_tukey(" <> natDec n <> "/" <> BU.doubleDec ov <> ")"     f (PunchoutTukey n (Just (ov, Just p))) =       "punchout_tukey(" <> natDec n <> "/" <> BU.doubleDec ov <> "/" <> BU.doubleDec p <> ")"-    f Welch                   = "welch"+    f Welch = "welch"     natDec :: Natural -> BU.Builder     natDec = BU.integerDec . fromIntegral
Codec/Audio/FLAC/StreamEncoder/Internal/Types.hs view
@@ -1,6 +1,6 @@ -- | -- Module      :  Codec.Audio.FLAC.StreamEncoder.Internal.Types--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -8,13 +8,13 @@ -- Portability :  portable -- -- Mostly non-public stream encoder-specific helper types.- module Codec.Audio.FLAC.StreamEncoder.Internal.Types-  ( Encoder (..)-  , EncoderInitStatus (..)-  , EncoderState (..)-  , EncoderException (..)-  , ApodizationFunction (..) )+  ( Encoder (..),+    EncoderInitStatus (..),+    EncoderState (..),+    EncoderException (..),+    ApodizationFunction (..),+  ) where  import Codec.Audio.Wave (SampleFormat)@@ -25,87 +25,82 @@  -- | An opaque newtype wrapper around @'Ptr' 'Void'@, serves to represent a -- pointer to an encoder instance.- newtype Encoder = Encoder (Ptr Void)  -- | Status of encoder initialization process.- data EncoderInitStatus-  = EncoderInitStatusOK-    -- ^ Initialization was successful.-  | EncoderInitStatusEncoderError-    -- ^ General failure to set up encoder.-  | EncoderInitStatusUnsupportedCointainer-    -- ^ The library was not compiled with support for the given container+  = -- | Initialization was successful.+    EncoderInitStatusOK+  | -- | General failure to set up encoder.+    EncoderInitStatusEncoderError+  | -- | The library was not compiled with support for the given container     -- format.-  | EncoderInitStatusInvalidCallbacks-    -- ^ A required callback was not supplied.-  | EncoderInitStatusInvalidNumberOfChannels-    -- ^ The encoder has an invalid setting for the number of channels.-  | EncoderInitStatusInvalidBitsPerSample-    -- ^ The encoder has an invalid setting for the bits-per-sample. FLAC+    EncoderInitStatusUnsupportedCointainer+  | -- | A required callback was not supplied.+    EncoderInitStatusInvalidCallbacks+  | -- | The encoder has an invalid setting for the number of channels.+    EncoderInitStatusInvalidNumberOfChannels+  | -- | The encoder has an invalid setting for the bits-per-sample. FLAC     -- supports 4-32 bps but the reference encoder currently supports only     -- up to 24 bps.-  | EncoderInitStatusInvalidSampleRate-    -- ^ The encoder has an invalid setting for the sample rate.-  | EncoderInitStatusInvalidBlockSize-    -- ^ The encoder has an invalid setting for the block size.-  | EncoderInitStatusInvalidMaxLpcOrder-    -- ^ The encoder has an invalid setting for the maximum LPC order.-  | EncoderInitStatusInvalidQlpCoeffPrecision-    -- ^ The encoder has an invalid setting for the precision of the+    EncoderInitStatusInvalidBitsPerSample+  | -- | The encoder has an invalid setting for the sample rate.+    EncoderInitStatusInvalidSampleRate+  | -- | The encoder has an invalid setting for the block size.+    EncoderInitStatusInvalidBlockSize+  | -- | The encoder has an invalid setting for the maximum LPC order.+    EncoderInitStatusInvalidMaxLpcOrder+  | -- | The encoder has an invalid setting for the precision of the     -- quantized linear predictor coefficients.-  | EncoderInitStatusBlockSizeTooSmallForLpcOrder-    -- ^ The specified block size is less than the maximum LPC order.-  | EncoderInitStatusNotStreamable-    -- ^ The encoder is bound to the Subset but other settings violate it.-  | EncoderInitStatusInvalidMetadata-    -- ^ The metadata input to the encoder is invalid (should never happen+    EncoderInitStatusInvalidQlpCoeffPrecision+  | -- | The specified block size is less than the maximum LPC order.+    EncoderInitStatusBlockSizeTooSmallForLpcOrder+  | -- | The encoder is bound to the Subset but other settings violate it.+    EncoderInitStatusNotStreamable+  | -- | The metadata input to the encoder is invalid (should never happen     -- with this binding).-  | EncoderInitStatusAlreadyInitialized-    -- ^ Initialization was attempted on already initialized encoder.+    EncoderInitStatusInvalidMetadata+  | -- | Initialization was attempted on already initialized encoder.+    EncoderInitStatusAlreadyInitialized   deriving (Show, Read, Eq, Ord, Bounded, Enum)  -- | Enumeration of encoder states.- data EncoderState-  = EncoderStateOK-    -- ^ The encoder is in the normal OK state and samples can be processed.-  | EncoderStateUninitialized-    -- ^ The encoder is in the uninitialized state.-  | EncoderStateOggError-    -- ^ An error occurred in the underlying Ogg layer.-  | EncoderStateVerifyDecoderError-    -- ^ An error occurred in the underlying verify stream decoder.-  | EncoderStateVerifyMismatchInAudioData-    -- ^ The verify decoder detected a mismatch between the original audio+  = -- | The encoder is in the normal OK state and samples can be processed.+    EncoderStateOK+  | -- | The encoder is in the uninitialized state.+    EncoderStateUninitialized+  | -- | An error occurred in the underlying Ogg layer.+    EncoderStateOggError+  | -- | An error occurred in the underlying verify stream decoder.+    EncoderStateVerifyDecoderError+  | -- | The verify decoder detected a mismatch between the original audio     -- signal and the decoded audio signal.-  | EncoderStateClientError-    -- ^ One of the callbacks returned a fatal error.-  | EncoderStateIOError-    -- ^ An I\/O error occurred while opening\/reading\/writing a file.-  | EncoderStateFramingError-    -- ^ An error occurred while writing the stream.-  | EncoderStateMemoryAllocationError-    -- ^ Memory allocation failed.+    EncoderStateVerifyMismatchInAudioData+  | -- | One of the callbacks returned a fatal error.+    EncoderStateClientError+  | -- | An I\/O error occurred while opening\/reading\/writing a file.+    EncoderStateIOError+  | -- | An error occurred while writing the stream.+    EncoderStateFramingError+  | -- | Memory allocation failed.+    EncoderStateMemoryAllocationError   deriving (Show, Read, Eq, Ord, Bounded, Enum)  -- | Exception that is thrown when encoding fails for some reason.- data EncoderException-  = EncoderInvalidSampleFormat SampleFormat-    -- ^ Input WAVE file had this sample format, which is not supported+  = -- | Input WAVE file had this sample format, which is not supported     -- (usually happens with floating point samples right now).-  | EncoderInitFailed EncoderInitStatus-    -- ^ Encoder initialization failed.-  | EncoderFailed EncoderState-    -- ^ Encoder failed.+    EncoderInvalidSampleFormat SampleFormat+  | -- | Encoder initialization failed.+    EncoderInitFailed EncoderInitStatus+  | -- | Encoder failed.+    EncoderFailed EncoderState   deriving (Eq, Show, Read)  instance Exception EncoderException  -- | Supported apodization functions.- data ApodizationFunction   = Bartlett   | BartlettHann@@ -113,31 +108,31 @@   | BlackmanHarris4Term92Db   | Connes   | Flattop-  | Gauss Double-    -- ^ The parameter is standard deviation @STDDEV@, @0 < STDDEV <= 0.5@.+  | -- | The parameter is standard deviation @STDDEV@, @0 < STDDEV <= 0.5@.+    Gauss Double   | Hamming   | Hann   | KaiserBessel   | Nuttall   | Rectangle   | Triangle-  | Tukey Double-    -- ^ The parameter is the fraction of the window that is tapered @P@,+  | -- | The parameter is the fraction of the window that is tapered @P@,     -- @0 <= P <= 1@. @P == 0@ corresponds to 'Rectangle' and @P = 1@     -- corresponds to 'Hann'.-  | PartialTukey Natural (Maybe (Double, Maybe Double))-    -- ^ The parameters are a series of small windows (all treated+    Tukey Double+  | -- | The parameters are a series of small windows (all treated     -- separately). The three parameters are @n@, @ov@ and @P@. @n@ is the     -- number of functions to add, @ov@ is the overlap of the windows. @P@     -- is the fraction of the window that is tapered, like with a regular     -- tukey window. The function can be specified with only a number, a     -- number and an overlap, or a number, an overlap and a @P@. @ov@ should     -- be smaller than 1 and can be negative.-  | PunchoutTukey Natural (Maybe (Double, Maybe Double))-    -- ^ The parameters are a series of windows that have a hole in them. In+    PartialTukey Natural (Maybe (Double, Maybe Double))+  | -- | The parameters are a series of windows that have a hole in them. In     -- this way, the predictor is constructed with only a part of the block,     -- which helps in case a block consists of dissimilar parts. All said     -- about the parameters in the comment for 'PartialTukey' applies here,     -- with the exception that @ov@ is the overlap in the gaps in this case.+    PunchoutTukey Natural (Maybe (Double, Maybe Double))   | Welch   deriving (Eq, Show, Read, Ord)
Codec/Audio/FLAC/Util.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE FlexibleContexts #-}+ -- | -- Module      :  Codec.Audio.FLAC.Util--- Copyright   :  © 2016–2019 Mark Karpov+-- Copyright   :  © 2016–present Mark Karpov -- License     :  BSD 3 clause -- -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>@@ -8,66 +10,58 @@ -- Portability :  portable -- -- Random non-public helpers.--{-# LANGUAGE FlexibleContexts #-}- module Codec.Audio.FLAC.Util-  ( maybePtr-  , toEnum'-  , fromEnum'-  , peekCStringText-  , withCStringText-  , withTempFile' )+  ( maybePtr,+    toEnum',+    fromEnum',+    peekCStringText,+    withCStringText,+    withTempFile',+  ) where  import Control.Exception+import Data.ByteString qualified as B import Data.Coerce import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T import Foreign import Foreign.C.String import System.Directory import System.FilePath import System.IO-import qualified Data.ByteString    as B-import qualified Data.Text          as T-import qualified Data.Text.Encoding as T  -- | Coerce to 'Ptr' and check if it's a null pointer, return 'Nothing' if -- it is, otherwise return the given pointer unchanged. Needless to say that--- this thing is unsafe.--maybePtr :: Coercible a (Ptr p) => a -> Maybe a+-- this is unsafe.+maybePtr :: (Coercible a (Ptr p)) => a -> Maybe a maybePtr a   | coerce a == nullPtr = Nothing-  | otherwise           = Just a+  | otherwise = Just a  -- | A version of 'toEnum' that converts from any 'Integral' type.- toEnum' :: (Integral a, Enum b) => a -> b toEnum' = toEnum . fromIntegral  -- | A version of 'fromEnum' that is polymorphic in return type.- fromEnum' :: (Integral a, Enum b) => b -> a fromEnum' = fromIntegral . fromEnum  -- | Peek 'CString' and decode it as UTF-8 encoded value.- peekCStringText :: CString -> IO Text peekCStringText = fmap T.decodeUtf8 . B.packCString --- | Convert a 'Text' value to null-terminated C string that will be freed+-- | Convert a 'Text' value to a null-terminated C string that will be freed -- automatically. Null bytes are removed from the 'Text' value first.- withCStringText :: Text -> (CString -> IO a) -> IO a withCStringText text = B.useAsCString bytes   where     bytes = T.encodeUtf8 (T.filter (/= '\0') text)  -- | A custom wrapper for creating temporary files in the same directory as--- given file. 'Handle' is not opened, you only get 'FilePath' in the+-- the given file. 'Handle' is not opened, you only get 'FilePath' in the -- callback.- withTempFile' :: FilePath -> (FilePath -> IO a) -> IO a withTempFile' path m = bracketOnError acquire cleanup $   \(path', h) -> hClose h >> m path'@@ -76,11 +70,10 @@     -- NOTE We need ignoringIOErrors in the case exception strikes before we     -- create the actual file.     cleanup = ignoringIOErrors . removeFile . fst-    dir     = takeDirectory path-    file    = takeFileName  path---- | Perform specified action ignoring IO exceptions it may throw.+    dir = takeDirectory path+    file = takeFileName path +-- | Perform the specified action ignoring IO exceptions it may throw. ignoringIOErrors :: IO () -> IO () ignoringIOErrors ioe = ioe `catch` handler   where
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2016–2018 Mark Karpov+Copyright © 2016–present Mark Karpov  All rights reserved.
README.md view
@@ -4,7 +4,7 @@ [![Hackage](https://img.shields.io/hackage/v/flac.svg?style=flat)](https://hackage.haskell.org/package/flac) [![Stackage Nightly](http://stackage.org/package/flac/badge/nightly)](http://stackage.org/nightly/package/flac) [![Stackage LTS](http://stackage.org/package/flac/badge/lts)](http://stackage.org/lts/package/flac)-[![Build Status](https://travis-ci.org/mrkkrp/flac.svg?branch=master)](https://travis-ci.org/mrkkrp/flac)+![CI](https://github.com/mrkkrp/flac/workflows/CI/badge.svg?branch=master)  * [Aims of the project](#aims-of-the-project) * [Motivation](#motivation)@@ -15,8 +15,8 @@ * [Contribution](#contribution) * [License](#license) -This is a complete high-level Haskell binding-to [libFLAC](https://xiph.org/flac/)—reference FLAC implementation.+This is a complete high-level Haskell binding to+[libFLAC](https://xiph.org/flac/)—reference FLAC implementation.  > As the maintainer of the C FLAC code base, I must say I'm impressed. Quite > honestly, I think the C API is horrible.@@ -25,79 +25,60 @@  ## Aims of the project -Here are several ideas the project follows:--* Concentrate only on native FLAC format without messing with other audio-  formats or their flavors. This library is about FLAC only.--* Be a complete interface for FLAC file manipulation in Haskell. “Complete”-  means that everything supported by the reference implementation should be-  supported by this package. This is in the hope to prevent fragmentation-  and proliferation of different libraries to work with FLAC with each of-  them covering only some 80% of functionality the library author needed and-  neglecting other 20%.--* Be as efficient as the underlying C implementation, avoid adding any sort-  of overhead (memory/speed/or otherwise).--* Provide *idiot-proof* API using type system to kindly guard against bad-  things, but not so much to remain beginner-friendly and simple.+These are the goals of the project: -* Make invalid code and data unrepresentable.+* Be a complete interface for FLAC file manipulation in Haskell.+* Be as efficient as the underlying C implementation.+* Provide a safe API using type system to kindly guard against bad things,+  but not too much so as to remain beginner-friendly and simple.  ## Motivation -FLAC is awesome and Haskell is awesome, surely there should be a way to-achieve an even higher level of awesomeness by coding a safe Haskell API to-the fast libFLAC library.+FLAC is awesome and Haskell is awesome, surely there should be a safe+Haskell API to the fast libFLAC library! -Seriously though, we-have [`htaglib`](https://hackage.haskell.org/package/htaglib) to work with-audio metadata, but it does not support a lot of FLAC-specific things I'd-love to manipulate. We-have [`hsndfile`](https://hackage.haskell.org/package/hsndfile), but I don't+Seriously though, we have+[`htaglib`](https://hackage.haskell.org/package/htaglib) to work with audio+metadata, but it does not support FLAC-specific thing I would like to+manipulate. We have+[`hsndfile`](https://hackage.haskell.org/package/hsndfile), but I don't really want to read FLAC data into a buffer or Haskell `Vector`. How simple is it (if possible) to decode a FLAC file using that library? How simple is-it to figure out where to begin with such a task? With `flac` it's-`decodeFlac def "myfile.flac" "myfile.wav"`—done, average song in a fraction-of second.+it to figure out where to begin with such a task? With `flac` it is one line+of code.  ## Provided functionality -Here we go:+`flac` can work with:  * Metadata—full support for reading/writing/deleting of all audio   parameters, application data, seek tables, vorbis comments of all sorts,   CUE sheets, and even pictures. -* Stream decoder—simple interface for decoding to vanilla WAVE and RF64-  (support for files larger than 4 Gb).+* Stream decoder—simple interface for decoding to WAVE and RF64. -* Stream encoder—a lot of options to tweak, everything that libFLAC has, but-  you can also use `def` and just encode vanilla WAVE or RF64 file into-  native FLAC. Simple and efficient.+* Stream encoder—a lot of options to tweak, everything that libFLAC+  supports.  ## Limitations  Right now there are three main limitations: -* No Ogg FLAC support, and I do not plan to add it, but I'll accept a PR-  adding support for Ogg FLAC.+* No Ogg FLAC support, and I do not plan to add it; I'll accept a PR adding+  support for Ogg FLAC.  * It's not possible to use custom callbacks for printing decoding/encoding-  progress in real-time and stuff like that. Not a big issue IMO, given that-  we get nice and safe API instead.+  progress in real-time. -* Only works on little-endian architectures so far, I'll accept a PR lifting+* Only works on little-endian architectures so far; I'll accept a PR lifting   this limitation.  ## Quick start -The best way to start using `flac` is to take a look-at [the Haddocks](https://hackage.haskell.org/package/flac). Encoding and-decoding are so simple that even a baby could handle it, and for metadata-there are examples and a lot of details in the docs. Feel free to ask me a-question if you get stuck with something though.+The best way to start using `flac` is to take a look at [the+Haddocks](https://hackage.haskell.org/package/flac). Encoding and decoding+should be simple to understand, for metadata there are examples in the docs.+Feel free to ask me a question if you get stuck with something.  ## Related packages @@ -108,13 +89,13 @@  ## Contribution -Please kindly direct all issues, bugs, and questions to-[the GitHub issue tracker for this project](https://github.com/mrkkrp/flac/issues).+Please direct all issues, bugs, and questions to [the GitHub issue tracker+for this project](https://github.com/mrkkrp/flac/issues). -Pull requests are also welcome and will be reviewed quickly.+Pull requests are also welcome.  ## License -Copyright © 2016–2019 Mark Karpov+Copyright © 2016–present Mark Karpov  Distributed under BSD 3 clause license.
− Setup.hs 
@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain
flac.cabal view
@@ -1,101 +1,110 @@-name:                 flac-version:              0.2.0-cabal-version:        1.18-tested-with:          GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3-license:              BSD3-license-file:         LICENSE.md-author:               Mark Karpov <markkarpov92@gmail.com>-maintainer:           Mark Karpov <markkarpov92@gmail.com>-homepage:             https://github.com/mrkkrp/flac-bug-reports:          https://github.com/mrkkrp/flac/issues-category:             Codec, Audio-synopsis:             Complete high-level binding to libFLAC-build-type:           Simple-description:          Complete high-level binding to libFLAC.-extra-doc-files:      CHANGELOG.md-                    , README.md-extra-source-files:   cbits/*.h-data-files:           audio-samples/sample.flac-                    , audio-samples/*.rf64-                    , audio-samples/*.wav+cabal-version:      2.4+name:               flac+version:            0.2.1+license:            BSD-3-Clause+license-file:       LICENSE.md+maintainer:         Mark Karpov <markkarpov92@gmail.com>+author:             Mark Karpov <markkarpov92@gmail.com>+tested-with:        ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1+homepage:           https://github.com/mrkkrp/flac+bug-reports:        https://github.com/mrkkrp/flac/issues+synopsis:           Complete high-level binding to libFLAC+description:        Complete high-level binding to libFLAC.+category:           Codec, Audio+build-type:         Simple+data-files:+    audio-samples/sample.flac+    audio-samples/*.rf64+    audio-samples/*.wav +extra-source-files: cbits/*.h+extra-doc-files:+    CHANGELOG.md+    README.md+ source-repository head-  type:               git-  location:           https://github.com/mrkkrp/flac.git+    type:     git+    location: https://github.com/mrkkrp/flac.git  flag dev-  description:        Turn on development settings.-  manual:             True-  default:            False+    description: Turn on development settings.+    default:     False+    manual:      True  library-  build-depends:      base             >= 4.8    && < 5.0-                    , bytestring       >= 0.2    && < 0.11-                    , containers       >= 0.5    && < 0.7-                    , directory        >= 1.2.2  && < 1.4-                    , exceptions       >= 0.6    && < 0.11-                    , filepath         >= 1.2    && < 1.5-                    , mtl              >= 2.0    && < 3.0-                    , text             >= 0.2    && < 1.3-                    , transformers     >= 0.4    && < 0.6-                    , vector           >= 0.10   && < 0.13-                    , wave             >= 0.1.2  && < 0.2-  if !impl(ghc >= 8.0)-    build-depends:    semigroups       == 0.18.*-  extra-libraries:    FLAC-  exposed-modules:    Codec.Audio.FLAC.Metadata-                    , Codec.Audio.FLAC.Metadata.CueSheet-                    , Codec.Audio.FLAC.StreamDecoder-                    , Codec.Audio.FLAC.StreamEncoder-                    , Codec.Audio.FLAC.StreamEncoder.Apodization-  other-modules:      Codec.Audio.FLAC.Metadata.Internal.Level2Interface-                    , Codec.Audio.FLAC.Metadata.Internal.Level2Interface.Helpers-                    , Codec.Audio.FLAC.Metadata.Internal.Object-                    , Codec.Audio.FLAC.Metadata.Internal.Types-                    , Codec.Audio.FLAC.StreamDecoder.Internal-                    , Codec.Audio.FLAC.StreamDecoder.Internal.Helpers-                    , Codec.Audio.FLAC.StreamDecoder.Internal.Types-                    , Codec.Audio.FLAC.StreamEncoder.Internal-                    , Codec.Audio.FLAC.StreamEncoder.Internal.Helpers-                    , Codec.Audio.FLAC.StreamEncoder.Internal.Types-                    , Codec.Audio.FLAC.Util-  c-sources:          cbits/metadata_level2_helpers.c-                    , cbits/stream_decoder_helpers.c-                    , cbits/stream_encoder_helpers.c-  include-dirs:       cbits-  if flag(dev)-    ghc-options:      -Wall -Werror -fsimpl-tick-factor=150-  else-    ghc-options:      -O2 -Wall -fsimpl-tick-factor=150-  if flag(dev) && impl(ghc >= 8.0)-    ghc-options:      -Wcompat-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wnoncanonical-monad-instances-                      -Wnoncanonical-monadfail-instances-  default-language:   Haskell2010+    exposed-modules:+        Codec.Audio.FLAC.Metadata+        Codec.Audio.FLAC.Metadata.CueSheet+        Codec.Audio.FLAC.StreamDecoder+        Codec.Audio.FLAC.StreamEncoder+        Codec.Audio.FLAC.StreamEncoder.Apodization +    c-sources:+        cbits/metadata_level2_helpers.c+        cbits/stream_decoder_helpers.c+        cbits/stream_encoder_helpers.c++    other-modules:+        Codec.Audio.FLAC.Metadata.Internal.Level2Interface+        Codec.Audio.FLAC.Metadata.Internal.Level2Interface.Helpers+        Codec.Audio.FLAC.Metadata.Internal.Object+        Codec.Audio.FLAC.Metadata.Internal.Types+        Codec.Audio.FLAC.StreamDecoder.Internal+        Codec.Audio.FLAC.StreamDecoder.Internal.Helpers+        Codec.Audio.FLAC.StreamDecoder.Internal.Types+        Codec.Audio.FLAC.StreamEncoder.Internal+        Codec.Audio.FLAC.StreamEncoder.Internal.Helpers+        Codec.Audio.FLAC.StreamEncoder.Internal.Types+        Codec.Audio.FLAC.Util++    default-language: GHC2021+    extra-libraries:  FLAC+    include-dirs:     cbits+    build-depends:+        base >=4.15 && <5,+        bytestring >=0.2 && <0.12,+        containers >=0.5 && <0.7,+        directory >=1.2.2 && <1.4,+        exceptions >=0.6 && <0.11,+        filepath >=1.2 && <1.5,+        mtl >=2 && <3,+        text >=0.2 && <2.2,+        vector >=0.10 && <0.14,+        wave >=0.1.2 && <0.3++    if flag(dev)+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages++    if impl(ghc >=9.8)+        ghc-options: -Wno-x-partial+ test-suite tests-  main-is:            Spec.hs-  other-modules:      Codec.Audio.FLAC.MetadataSpec-                    , Codec.Audio.FLAC.StreamEncoderSpec-  hs-source-dirs:     tests-  type:               exitcode-stdio-1.0-  build-depends:      base             >= 4.8    && < 5.0-                    , bytestring       >= 0.2    && < 0.11-                    , directory        >= 1.2.2  && < 1.4-                    , filepath         >= 1.2    && < 1.5-                    , flac-                    , hspec            >= 2.0    && < 3.0-                    , temporary        >= 1.1    && < 1.4-                    , transformers     >= 0.4    && < 0.6-                    , vector           >= 0.10   && < 0.13-                    , wave             >= 0.1.2  && < 0.2-  build-tools:        hspec-discover   >= 2.0    && < 3.0-  if !impl(ghc >= 8.0)-    build-depends:    semigroups       == 0.18.*-  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  default-language:   Haskell2010+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    build-tool-depends: hspec-discover:hspec-discover >=2 && <3+    hs-source-dirs:     tests+    other-modules:+        Codec.Audio.FLAC.MetadataSpec+        Codec.Audio.FLAC.StreamEncoderSpec++    default-language:   GHC2021+    build-depends:+        base >=4.15 && <5,+        bytestring >=0.2 && <0.12,+        directory >=1.2.2 && <1.4,+        filepath >=1.2 && <1.5,+        flac,+        hspec >=2 && <3,+        temporary >=1.1 && <1.4,+        vector >=0.10 && <0.14,+        wave >=0.1.2 && <0.3++    if flag(dev)+        ghc-options:+            -Wall -Werror -Wredundant-constraints -Wpartial-fields+            -Wunused-packages++    else+        ghc-options: -Wall
tests/Codec/Audio/FLAC/MetadataSpec.hs view
@@ -1,26 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} -module Codec.Audio.FLAC.MetadataSpec-  ( spec )-where+module Codec.Audio.FLAC.MetadataSpec (spec) where  import Codec.Audio.FLAC.Metadata hiding (runFlacMeta)+import Codec.Audio.FLAC.Metadata qualified as Flac import Codec.Audio.FLAC.Metadata.CueSheet import Codec.Audio.Wave import Control.Monad import Control.Monad.IO.Class (MonadIO (..)) import Data.ByteString (ByteString)+import Data.ByteString qualified as B import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NE import Data.Vector (Vector)+import Data.Vector qualified as V import System.Directory import System.IO import System.IO.Temp (withSystemTempFile) import Test.Hspec hiding (shouldBe, shouldReturn)-import qualified Codec.Audio.FLAC.Metadata as Flac-import qualified Data.ByteString           as B-import qualified Data.List.NonEmpty        as NE-import qualified Data.Vector               as V-import qualified Test.Hspec                as Hspec+import Test.Hspec qualified as Hspec  -- TODO How to share the same sandbox between several subsequent tests? This -- would allow for more precise labelling.@@ -96,29 +94,32 @@     it "is set/read/deleted correctly" $ \path -> do       -- Can set application data.       runFlacMeta def path $ do-        Application "foo"  =-> Just "foo"+        Application "foo" =-> Just "foo"         Application "bobo" =-> Just "bobo"-        getMetaChain `shouldReturn` StreamInfoBlock :|-          [ApplicationBlock,ApplicationBlock,VorbisCommentBlock,PaddingBlock]+        getMetaChain+          `shouldReturn` StreamInfoBlock+            :| [ApplicationBlock, ApplicationBlock, VorbisCommentBlock, PaddingBlock]         isMetaChainModified `shouldReturn` True       -- Can read it back.       runFlacMeta def path . checkNoMod $ do-        retrieve (Application "foo")  `shouldReturn` Just "foo"+        retrieve (Application "foo") `shouldReturn` Just "foo"         retrieve (Application "bobo") `shouldReturn` Just "bobo"       -- Can wipe one without affecting the other.       runFlacMeta def path $ do         Application "foo" =-> Nothing-        retrieve (Application "foo")  `shouldReturn` Nothing+        retrieve (Application "foo") `shouldReturn` Nothing         retrieve (Application "bobo") `shouldReturn` Just "bobo"-        getMetaChain `shouldReturn` StreamInfoBlock :|-          [ApplicationBlock,VorbisCommentBlock,PaddingBlock]+        getMetaChain+          `shouldReturn` StreamInfoBlock+            :| [ApplicationBlock, VorbisCommentBlock, PaddingBlock]         isMetaChainModified `shouldReturn` True       -- Can overwrite application data.       runFlacMeta def path $ do         Application "bobo" =-> Just "moon"         retrieve (Application "bobo") `shouldReturn` Just "moon"-        getMetaChain `shouldReturn` StreamInfoBlock :|-          [ApplicationBlock,VorbisCommentBlock,PaddingBlock]+        getMetaChain+          `shouldReturn` StreamInfoBlock+            :| [ApplicationBlock, VorbisCommentBlock, PaddingBlock]         isMetaChainModified `shouldReturn` True       -- Can wipe the other one bringing it to the default state.       runFlacMeta def path $ do@@ -126,20 +127,22 @@         getMetaChain `shouldReturn` refChain         isMetaChainModified `shouldReturn` True       runFlacMeta def path . checkNoMod $ do-        retrieve (Application "foo")  `shouldReturn` Nothing+        retrieve (Application "foo") `shouldReturn` Nothing         retrieve (Application "bobo") `shouldReturn` Nothing    describe "SeekTable" $ do     it "raises exception when invalid seek table given" $ \path -> do-      let m = runFlacMeta def path $-            SeekTable =-> Just invalidSeekTable+      let m =+            runFlacMeta def path $+              SeekTable =-> Just invalidSeekTable       m `shouldThrow` (== MetaInvalidSeekTable)     it "is set/read/deleted correctly" $ \path -> do       -- Can set seek table if it's correct.       runFlacMeta def path $ do         SeekTable =-> Just testSeekTable-        getMetaChain `shouldReturn` StreamInfoBlock :|-          [SeekTableBlock,VorbisCommentBlock,PaddingBlock]+        getMetaChain+          `shouldReturn` StreamInfoBlock+            :| [SeekTableBlock, VorbisCommentBlock, PaddingBlock]         isMetaChainModified `shouldReturn` True       -- Can read it back.       runFlacMeta def path . checkNoMod $@@ -153,21 +156,23 @@         SeekTable =-> Nothing     context "when auto-vacuum disabled" $       it "can write empty seek table" $ \path -> do-        runFlacMeta def { metaAutoVacuum = False } path $ do+        runFlacMeta def {metaAutoVacuum = False} path $ do           SeekTable =-> Just V.empty           retrieve SeekTable `shouldReturn` Just V.empty-          getMetaChain `shouldReturn` StreamInfoBlock :|-            [SeekTableBlock,VorbisCommentBlock,PaddingBlock]+          getMetaChain+            `shouldReturn` StreamInfoBlock+              :| [SeekTableBlock, VorbisCommentBlock, PaddingBlock]           isMetaChainModified `shouldReturn` True         runFlacMeta def path . checkNoMod $           retrieve SeekTable `shouldReturn` Just V.empty     context "when auto-vacuum enabled" $       it "empty seek table is removed automatically" $ \path -> do-        runFlacMeta def { metaAutoVacuum = True } path $ do+        runFlacMeta def {metaAutoVacuum = True} path $ do           SeekTable =-> Just V.empty           retrieve SeekTable `shouldReturn` Just V.empty-          getMetaChain `shouldReturn` StreamInfoBlock :|-            [SeekTableBlock,VorbisCommentBlock,PaddingBlock]+          getMetaChain+            `shouldReturn` StreamInfoBlock+              :| [SeekTableBlock, VorbisCommentBlock, PaddingBlock]           isMetaChainModified `shouldReturn` True         runFlacMeta def path . checkNoMod $ do           retrieve SeekTable `shouldReturn` Nothing@@ -178,55 +183,61 @@       -- Can set vorbis vendor.       runFlacMeta def path $ do         VorbisVendor =-> Just "foo"-        getMetaChain `shouldReturn` StreamInfoBlock :|-          [VorbisCommentBlock,PaddingBlock]+        getMetaChain+          `shouldReturn` StreamInfoBlock+            :| [VorbisCommentBlock, PaddingBlock]         isMetaChainModified `shouldReturn` True       -- Can read it back.       runFlacMeta def path . checkNoMod $         retrieve VorbisVendor `shouldReturn` Just "foo"     context "when auto-vacuum disabled" $       it "deletion just sets the field to empty string" $ \path -> do-        runFlacMeta def { metaAutoVacuum = False } path $ do+        runFlacMeta def {metaAutoVacuum = False} path $ do           VorbisVendor =-> Nothing           retrieve VorbisVendor `shouldReturn` Just ""-          getMetaChain `shouldReturn` StreamInfoBlock :|-            [VorbisCommentBlock,PaddingBlock]+          getMetaChain+            `shouldReturn` StreamInfoBlock+              :| [VorbisCommentBlock, PaddingBlock]           isMetaChainModified `shouldReturn` True         runFlacMeta def path . checkNoMod $           retrieve VorbisVendor `shouldReturn` Just ""     context "when auto-vacuum enabled" $ do       context "when no other vorbis fields set" $         it "empty vendor causes removal of vorbis vendor block" $ \path -> do-          runFlacMeta def { metaAutoVacuum = True } path $ do+          runFlacMeta def {metaAutoVacuum = True} path $ do             VorbisVendor =-> Nothing             retrieve VorbisVendor `shouldReturn` Just ""-            getMetaChain `shouldReturn` StreamInfoBlock :|-              [VorbisCommentBlock,PaddingBlock]+            getMetaChain+              `shouldReturn` StreamInfoBlock+                :| [VorbisCommentBlock, PaddingBlock]             isMetaChainModified `shouldReturn` True           runFlacMeta def path . checkNoMod $ do             retrieve VorbisVendor `shouldReturn` Nothing             getMetaChain `shouldReturn` StreamInfoBlock :| [PaddingBlock]       context "when other vorbis fields exist" $         it "deletion just sets the field to empty string" $ \path -> do-          runFlacMeta def { metaAutoVacuum = True } path $ do+          runFlacMeta def {metaAutoVacuum = True} path $ do             VorbisComment Title =-> Just "bobla"             VorbisVendor =-> Nothing             retrieve VorbisVendor `shouldReturn` Just ""-            getMetaChain `shouldReturn` StreamInfoBlock :|-              [VorbisCommentBlock,PaddingBlock]+            getMetaChain+              `shouldReturn` StreamInfoBlock+                :| [VorbisCommentBlock, PaddingBlock]             isMetaChainModified `shouldReturn` True           runFlacMeta def path . checkNoMod $ do             retrieve VorbisVendor `shouldReturn` Just ""-            getMetaChain `shouldReturn` StreamInfoBlock :|-              [VorbisCommentBlock,PaddingBlock]+            getMetaChain+              `shouldReturn` StreamInfoBlock+                :| [VorbisCommentBlock, PaddingBlock] -  describe "VorbisComment" . forM_ [minBound..maxBound] $ \vfield ->+  describe "VorbisComment" . forM_ [minBound .. maxBound] $ \vfield ->     it (show vfield ++ " is set/read/deleted correctly") $ \path -> do       -- Can set vorbis comment.       runFlacMeta def path $ do         VorbisComment vfield =-> Just "foo"-        getMetaChain `shouldReturn` StreamInfoBlock :|-          [VorbisCommentBlock,PaddingBlock]+        getMetaChain+          `shouldReturn` StreamInfoBlock+            :| [VorbisCommentBlock, PaddingBlock]         isMetaChainModified `shouldReturn` True       -- Can read it back.       runFlacMeta def path . checkNoMod $@@ -243,8 +254,9 @@   describe "CueSheet" $ do     context "when the CUE sheet is for a CD" $       it "raises exception when invalid CDDA CUE sheet is given" $ \path -> do-        let m = runFlacMeta def path $-              CueSheet =-> Just invalidCueSheet { cueIsCd = True }+        let m =+              runFlacMeta def path $+                CueSheet =-> Just invalidCueSheet {cueIsCd = True}             leadInError = "CD-DA cue sheet must have a lead-in length of at least 2 seconds"         m `shouldThrow` (== MetaInvalidCueSheet leadInError)     context "when the CUE sheet is not for a CD" $@@ -252,13 +264,14 @@         -- NOTE All other possible issues have been taken care of by the         -- type system and carefully arranged data type definitions.         runFlacMeta def path $-          CueSheet =-> Just invalidCueSheet { cueIsCd = False }+          CueSheet =-> Just invalidCueSheet {cueIsCd = False}     it "is set/read/deleted correctly" $ \path -> do       -- Can set CUE sheet if it's correct.       runFlacMeta def path $ do         CueSheet =-> Just testCueSheet-        getMetaChain `shouldReturn` StreamInfoBlock :|-          [CueSheetBlock,VorbisCommentBlock,PaddingBlock]+        getMetaChain+          `shouldReturn` StreamInfoBlock+            :| [CueSheetBlock, VorbisCommentBlock, PaddingBlock]         isMetaChainModified `shouldReturn` True       -- Can read it back.       runFlacMeta def path . checkNoMod $@@ -271,18 +284,20 @@       runFlacMeta def path . checkNoMod $         CueSheet =-> Nothing -  describe "Picture" . forM_ [minBound..maxBound] $ \ptype -> do+  describe "Picture" . forM_ [minBound .. maxBound] $ \ptype -> do     it (show ptype ++ " raises exception on invalid picture") $ \path -> do-      let m = runFlacMeta def path $-            Picture ptype =-> Just invalidPicture+      let m =+            runFlacMeta def path $+              Picture ptype =-> Just invalidPicture           mimeTypeError = "MIME type string must contain only printable ASCII characters (0x20-0x7e)"       m `shouldThrow` (== MetaInvalidPicture mimeTypeError)     it (show ptype ++ " is set/read/deleted correctly") $ \path -> do       -- Can set a picture.       runFlacMeta def path $ do         Picture ptype =-> Just testPicture-        getMetaChain `shouldReturn` StreamInfoBlock :|-          [PictureBlock,VorbisCommentBlock,PaddingBlock]+        getMetaChain+          `shouldReturn` StreamInfoBlock+            :| [PictureBlock, VorbisCommentBlock, PaddingBlock]         isMetaChainModified `shouldReturn` True       -- Can read it back.       runFlacMeta def path . checkNoMod $@@ -298,7 +313,7 @@   describe "wipeVorbisComment" $     it "wipes all “vorbis comment” metadata blocks" $ \path -> do       runFlacMeta def path $ do-        VorbisComment Title  =-> Just "Title"+        VorbisComment Title =-> Just "Title"         VorbisComment Artist =-> Just "Artist"       runFlacMeta def path $ do         wipeVorbisComment@@ -310,7 +325,7 @@   describe "wipeApplications" $     it "wipes all “application” metadata blocks" $ \path -> do       runFlacMeta def path $ do-        Application "foo"  =-> Just "foo"+        Application "foo" =-> Just "foo"         Application "bobo" =-> Just "bobo"       runFlacMeta def path $ do         wipeApplications@@ -345,7 +360,7 @@     it "wipes all “picture” metadata blocks" $ \path -> do       runFlacMeta def path $ do         Picture PictureFrontCover =-> Just testPicture-        Picture PictureBackCover  =-> Just testPicture+        Picture PictureBackCover =-> Just testPicture       runFlacMeta def path $ do         wipePictures         getMetaChain `shouldReturn` refChain@@ -357,32 +372,27 @@ -- Helpers  -- | A shortcut for 'defaultMetaSettings'.- def :: MetaSettings def = defaultMetaSettings  infix 1 `shouldBe`, `shouldReturn`  -- | Lifted 'Hspec.shouldBe'.- shouldBe :: (MonadIO m, Show a, Eq a) => a -> a -> m () shouldBe x y = liftIO (x `Hspec.shouldBe` y)  -- | Lifted 'Hspec.shouldReturn'.- shouldReturn :: (MonadIO m, Show a, Eq a) => m a -> a -> m () shouldReturn m y = m >>= (`shouldBe` y)  -- | Type constrained version of 'Flac.runFlacMeta' to remove type -- ambiguity.- runFlacMeta :: MetaSettings -> FilePath -> FlacMeta a -> IO a runFlacMeta = Flac.runFlacMeta  -- | Make a temporary copy of @audio-samples/sample.flac@ file and provide -- the path to the file. Automatically remove the file when the test -- finishes.- withSandbox :: ActionWith FilePath -> IO () withSandbox action = withSystemTempFile "sample.flac" $ \path h -> do   hClose h@@ -390,131 +400,137 @@   action path  -- | Check that the inner action does not modify the chain.- checkNoMod :: FlacMeta a -> FlacMeta a checkNoMod m = do   chainBefore <- getMetaChain   result <- m-  chainAfter  <- getMetaChain+  chainAfter <- getMetaChain   chainAfter `shouldBe` chainBefore   isMetaChainModified `shouldReturn` False   return result  -- | MD5 sum of uncompressed audio data of the unmodified sample we use in -- these tests.- refMD5Sum :: ByteString-refMD5Sum = B.pack [89,191,106,236,125,27,65,161,78,138,172,153,91,60,42,109]+refMD5Sum = B.pack [89, 191, 106, 236, 125, 27, 65, 161, 78, 138, 172, 153, 91, 60, 42, 109]  -- | The sequence of metadata blocks as they appear in the unmodified sample -- we use in these tests.- refChain :: NonEmpty MetadataType refChain = StreamInfoBlock :| [VorbisCommentBlock, PaddingBlock]  -- | A correct seek table.- testSeekTable :: Vector SeekPoint-testSeekTable = V.fromList-  [ SeekPoint 1 10 100-  , SeekPoint 2 20 108-  , SeekPoint 3 30 101 ]+testSeekTable =+  V.fromList+    [ SeekPoint 1 10 100,+      SeekPoint 2 20 108,+      SeekPoint 3 30 101+    ]  -- | An invalid seek table.- invalidSeekTable :: Vector SeekPoint-invalidSeekTable = V.fromList-  [ SeekPoint 0 0 100-  , SeekPoint 0 0 108-  , SeekPoint 0 0 101 ]+invalidSeekTable =+  V.fromList+    [ SeekPoint 0 0 100,+      SeekPoint 0 0 108,+      SeekPoint 0 0 101+    ]  -- | A correct CUE sheet.- testCueSheet :: CueSheetData-testCueSheet = CueSheetData-  { cueCatalog = "1112223334445"-  , cueLeadIn  = 88200 -- at least two seconds-  , cueIsCd    = True-  , cueTracks  =-    [ CueTrack-      { cueTrackOffset      = 588 * 2-      , cueTrackIsrc        = "abcde1234567"-      , cueTrackAudio       = True-      , cueTrackPreEmphasis = True-      , cueTrackPregapIndex = Nothing-      , cueTrackIndices     = NE.fromList [0,588,588 * 2] }-    , CueTrack-      { cueTrackOffset      = 588 * 3-      , cueTrackIsrc        = "abced1234576"-      , cueTrackAudio       = False-      , cueTrackPreEmphasis = False-      , cueTrackPregapIndex = Just 588-      , cueTrackIndices     = NE.fromList [0,588,588 * 7] }-    ]-  , cueLeadOutTrack =-      CueTrack-      { cueTrackOffset      = 588 * 10-      , cueTrackIsrc        = ""-      , cueTrackAudio       = True-      , cueTrackPreEmphasis = False-      , cueTrackPregapIndex = Just (588 * 9)-      , cueTrackIndices     = NE.fromList [0] }-  }+testCueSheet =+  CueSheetData+    { cueCatalog = "1112223334445",+      cueLeadIn = 88200, -- at least two seconds+      cueIsCd = True,+      cueTracks =+        [ CueTrack+            { cueTrackOffset = 588 * 2,+              cueTrackIsrc = "abcde1234567",+              cueTrackAudio = True,+              cueTrackPreEmphasis = True,+              cueTrackPregapIndex = Nothing,+              cueTrackIndices = NE.fromList [0, 588, 588 * 2]+            },+          CueTrack+            { cueTrackOffset = 588 * 3,+              cueTrackIsrc = "abced1234576",+              cueTrackAudio = False,+              cueTrackPreEmphasis = False,+              cueTrackPregapIndex = Just 588,+              cueTrackIndices = NE.fromList [0, 588, 588 * 7]+            }+        ],+      cueLeadOutTrack =+        CueTrack+          { cueTrackOffset = 588 * 10,+            cueTrackIsrc = "",+            cueTrackAudio = True,+            cueTrackPreEmphasis = False,+            cueTrackPregapIndex = Just (588 * 9),+            cueTrackIndices = NE.fromList [0]+          }+    }  -- | An invalid CUE sheet.- invalidCueSheet :: CueSheetData-invalidCueSheet =  CueSheetData-  { cueCatalog = "1112223334445"-  , cueLeadIn  = 1401 -- less than two seconds — illegal-  , cueIsCd    = True-  , cueTracks  =-    [ CueTrack-      { cueTrackOffset      = 1212-      , cueTrackIsrc        = "abcde1234567"-      , cueTrackAudio       = True-      , cueTrackPreEmphasis = True-      , cueTrackPregapIndex = Nothing-      , cueTrackIndices     = NE.fromList [0,13,1096] }-    , CueTrack-      { cueTrackOffset      = 1313-      , cueTrackIsrc        = "abced1234576"-      , cueTrackAudio       = False-      , cueTrackPreEmphasis = False-      , cueTrackPregapIndex = Just 588-      , cueTrackIndices     = NE.fromList [0,19,1069] }-    ]-  , cueLeadOutTrack =-      CueTrack-      { cueTrackOffset      = 8888-      , cueTrackIsrc        = ""-      , cueTrackAudio       = True-      , cueTrackPreEmphasis = False-      , cueTrackPregapIndex = Just 588-      , cueTrackIndices     = NE.fromList [0]-      }-  }+invalidCueSheet =+  CueSheetData+    { cueCatalog = "1112223334445",+      cueLeadIn = 1401, -- less than two seconds — illegal+      cueIsCd = True,+      cueTracks =+        [ CueTrack+            { cueTrackOffset = 1212,+              cueTrackIsrc = "abcde1234567",+              cueTrackAudio = True,+              cueTrackPreEmphasis = True,+              cueTrackPregapIndex = Nothing,+              cueTrackIndices = NE.fromList [0, 13, 1096]+            },+          CueTrack+            { cueTrackOffset = 1313,+              cueTrackIsrc = "abced1234576",+              cueTrackAudio = False,+              cueTrackPreEmphasis = False,+              cueTrackPregapIndex = Just 588,+              cueTrackIndices = NE.fromList [0, 19, 1069]+            }+        ],+      cueLeadOutTrack =+        CueTrack+          { cueTrackOffset = 8888,+            cueTrackIsrc = "",+            cueTrackAudio = True,+            cueTrackPreEmphasis = False,+            cueTrackPregapIndex = Just 588,+            cueTrackIndices = NE.fromList [0]+          }+    }  -- | A correct picture.- testPicture :: PictureData-testPicture = PictureData-  { pictureMimeType    = "application/jpeg"-  , pictureDescription = "Good description."-  , pictureWidth       = 100-  , pictureHeight      = 100-  , pictureDepth       = 24-  , pictureColors      = 0-  , pictureData        = "Some picture data goes here, honest." }+testPicture =+  PictureData+    { pictureMimeType = "application/jpeg",+      pictureDescription = "Good description.",+      pictureWidth = 100,+      pictureHeight = 100,+      pictureDepth = 24,+      pictureColors = 0,+      pictureData = "Some picture data goes here, honest."+    }  -- | An invalid picture.- invalidPicture :: PictureData-invalidPicture = PictureData-  { pictureMimeType    = "application\1/jpeg"-  , pictureDescription = "Bad\1 description."-  , pictureWidth       = 100-  , pictureHeight      = 100-  , pictureDepth       = 24-  , pictureColors      = 0-  , pictureData        = "Some picture data goes here, honest." }+invalidPicture =+  PictureData+    { pictureMimeType = "application\1/jpeg",+      pictureDescription = "Bad\1 description.",+      pictureWidth = 100,+      pictureHeight = 100,+      pictureDepth = 24,+      pictureColors = 0,+      pictureData = "Some picture data goes here, honest."+    }
tests/Codec/Audio/FLAC/StreamEncoderSpec.hs view
@@ -1,26 +1,19 @@ {-# LANGUAGE RecordWildCards #-} -module Codec.Audio.FLAC.StreamEncoderSpec-  ( spec )-where+module Codec.Audio.FLAC.StreamEncoderSpec (spec) where  import Codec.Audio.FLAC.StreamDecoder import Codec.Audio.FLAC.StreamEncoder import Codec.Audio.Wave import Control.Monad import Data.ByteString (ByteString)+import Data.ByteString qualified as B import System.Directory import System.FilePath import System.IO import System.IO.Temp (withSystemTempDirectory) import Test.Hspec-import qualified Data.ByteString as B --- NOTE OK, we test here a lot of things at the same time, which may--- disappoint adepts of various testing techniques and principles, but it's--- easier to test many things simultaneously in this case, and when--- something is not right, it's usually obvious what's wrong.- spec :: Spec spec =   describe "encodeFlac and decodeFlac" $@@ -31,11 +24,20 @@         old <- Blind <$> fetchWaveBody path         -- We first let the built-in verification mechanics catch possible         -- errors.-        encodeFlac defaultEncoderSettings-          { encoderVerify = True } path path-        -- Then we let decoder check that the streams match with MD5 hash.-        decodeFlac defaultDecoderSettings-          { decoderMd5Checking = True } path path+        encodeFlac+          defaultEncoderSettings+            { encoderVerify = True+            }+          path+          path+        -- Then we let decoder check that the streams match with the MD5+        -- hash.+        decodeFlac+          defaultDecoderSettings+            { decoderMd5Checking = True+            }+          path+          path         -- But we also want to be sure that audio streams match         -- byte-by-byte, we can't trust just FLAC's own checking.         new <- Blind <$> fetchWaveBody path@@ -46,14 +48,13 @@  newtype Blind a = Blind a -instance Eq a => Eq (Blind a) where+instance (Eq a) => Eq (Blind a) where   (Blind x) == (Blind y) = x == y  instance Show (Blind a) where   show _ = "<blind data cannot be shown>"  -- | Run given test with various WAVE files.- withVariousWaves :: SpecWith FilePath -> SpecWith () withVariousWaves m =   forM_ waveFiles $ \(path, desc) ->@@ -62,7 +63,6 @@ -- | Make a temporary copy of given file and provide the path to the file in -- a sandbox directory. Automatically remove the files when the test -- finishes.- withSandbox :: FilePath -> ActionWith FilePath -> IO () withSandbox path action =   withSystemTempDirectory "flac-test" $ \dir -> do@@ -72,7 +72,6 @@  -- | Extract body of given WAVE or RF64 file as a strict 'ByteString'. -- Needless to say that the body should be relatively short.- fetchWaveBody :: FilePath -> IO ByteString fetchWaveBody path = do   Wave {..} <- readWaveFile path@@ -82,34 +81,49 @@  waveFiles :: [(FilePath, String)] waveFiles =-  [ ( "audio-samples/1ch-44100hz-16bit.rf64"-    , "1 channel 44100 Hz 16 bit (RF64)" )-  , ( "audio-samples/1ch-44100hz-16bit.wav"-    , "1 channel 44100 Hz 16 bit (WAVE)" )-  , ( "audio-samples/1ch-44100hz-16bit-x.wav"-    , "1 channel 44100 Hz 16 bit (WAVEX)" )-  , ( "audio-samples/2ch-11025hz-24bit.rf64"-    , "2 channels 11025 Hz 24 bit (RF64)" )-  , ( "audio-samples/2ch-11025hz-24bit.wav"-    , "2 channels 11025 Hz 24 bit (WAVE)" )-  , ( "audio-samples/2ch-11025hz-24bit-x.wav"-    , "2 channels 11025 Hz 24 bit (WAVEX)" )-  , ( "audio-samples/2ch-8000hz-8bit.rf64"-    , "2 channels 8000 Hz 8 bit (RF64)" )-  , ( "audio-samples/2ch-8000hz-8bit.wav"-    , "2 channels 8000 Hz 8 bit (WAVE)" )-  , ( "audio-samples/2ch-8000hz-8bit-x.wav"-    , "2 channels 8000 Hz 8 bit (WAVEX)" )-  , ( "audio-samples/1ch-44100hz-8bit-full-range.wav"-    , "1 channel 44100 Hz 8 bit full range (WAVE)" )-  , ( "audio-samples/1ch-44100hz-8bit-silence.wav"-    , "1 channel 44100 Hz 8 bit silence (WAVE)" )-  , ( "audio-samples/1ch-44100hz-16bit-full-range.wav"-    , "1 channel 44100 Hz 16 bit full range (WAVE)" )-  , ( "audio-samples/1ch-44100hz-16bit-silence.wav"-    , "1 channel 44100 Hz 16 bit silence (WAVE)" )-  , ( "audio-samples/1ch-44100hz-24bit-full-range.wav"-    , "1 channel 44100 Hz 24 bit full range (WAVE)" )-  , ( "audio-samples/1ch-44100hz-24bit-silence.wav"-    , "1 channel 44100 Hz 24 bit silence (WAVE)" )+  [ ( "audio-samples/1ch-44100hz-16bit.rf64",+      "1 channel 44100 Hz 16 bit (RF64)"+    ),+    ( "audio-samples/1ch-44100hz-16bit.wav",+      "1 channel 44100 Hz 16 bit (WAVE)"+    ),+    ( "audio-samples/1ch-44100hz-16bit-x.wav",+      "1 channel 44100 Hz 16 bit (WAVEX)"+    ),+    ( "audio-samples/2ch-11025hz-24bit.rf64",+      "2 channels 11025 Hz 24 bit (RF64)"+    ),+    ( "audio-samples/2ch-11025hz-24bit.wav",+      "2 channels 11025 Hz 24 bit (WAVE)"+    ),+    ( "audio-samples/2ch-11025hz-24bit-x.wav",+      "2 channels 11025 Hz 24 bit (WAVEX)"+    ),+    ( "audio-samples/2ch-8000hz-8bit.rf64",+      "2 channels 8000 Hz 8 bit (RF64)"+    ),+    ( "audio-samples/2ch-8000hz-8bit.wav",+      "2 channels 8000 Hz 8 bit (WAVE)"+    ),+    ( "audio-samples/2ch-8000hz-8bit-x.wav",+      "2 channels 8000 Hz 8 bit (WAVEX)"+    ),+    ( "audio-samples/1ch-44100hz-8bit-full-range.wav",+      "1 channel 44100 Hz 8 bit full range (WAVE)"+    ),+    ( "audio-samples/1ch-44100hz-8bit-silence.wav",+      "1 channel 44100 Hz 8 bit silence (WAVE)"+    ),+    ( "audio-samples/1ch-44100hz-16bit-full-range.wav",+      "1 channel 44100 Hz 16 bit full range (WAVE)"+    ),+    ( "audio-samples/1ch-44100hz-16bit-silence.wav",+      "1 channel 44100 Hz 16 bit silence (WAVE)"+    ),+    ( "audio-samples/1ch-44100hz-24bit-full-range.wav",+      "1 channel 44100 Hz 24 bit full range (WAVE)"+    ),+    ( "audio-samples/1ch-44100hz-24bit-silence.wav",+      "1 channel 44100 Hz 24 bit silence (WAVE)"+    )   ]