diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index 0000737..0251a9f 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -27,7 +27,7 @@ jobs: with: ghc-version: ${{ matrix.ghc }} cabal-version: ${{ matrix.cabal }} - - run: sudo apt-get update && sudo apt-get install libtagc0-dev + - run: sudo apt-get update && sudo apt-get install libtag-c-dev - run: cabal update - run: cabal freeze - uses: actions/cache@v4.3.0 diff --git a/Sound/HTagLib.hs b/Sound/HTagLib.hs index 913b645..613d7ed 100644 --- a/Sound/HTagLib.hs +++ b/Sound/HTagLib.hs @@ -24,6 +24,7 @@ module Sound.HTagLib bitRateGetter, sampleRateGetter, channelsGetter, + propertyGetter, -- * Setters setTags, @@ -35,6 +36,7 @@ module Sound.HTagLib genreSetter, yearSetter, trackNumberSetter, + propertySetter, -- * Data types Title, diff --git a/Sound/HTagLib/Getter.hs b/Sound/HTagLib/Getter.hs index e9b508d..aa16bc9 100644 --- a/Sound/HTagLib/Getter.hs +++ b/Sound/HTagLib/Getter.hs @@ -29,10 +29,12 @@ module Sound.HTagLib.Getter bitRateGetter, sampleRateGetter, channelsGetter, + propertyGetter, ) where import Control.Monad.IO.Class +import Data.Text (Text) import Sound.HTagLib.Internal qualified as I import Sound.HTagLib.Type @@ -137,3 +139,7 @@ sampleRateGetter = TagGetter I.getSampleRate -- | Getter to retrieve the number of channels of the audio data. channelsGetter :: TagGetter Channels channelsGetter = TagGetter I.getChannels + +-- | Getter to retrieve a property by its name. +propertyGetter :: Text -> TagGetter [Text] +propertyGetter = TagGetter . I.propertyGet diff --git a/Sound/HTagLib/Internal.hs b/Sound/HTagLib/Internal.hs index 4905ba0..85b95b5 100644 --- a/Sound/HTagLib/Internal.hs +++ b/Sound/HTagLib/Internal.hs @@ -43,6 +43,11 @@ module Sound.HTagLib.Internal -- * Special convenience ID3v2 functions id3v2SetEncoding, + + -- * Properties API + propertySet, + propertySetAppend, + propertyGet, ) where @@ -162,6 +167,21 @@ foreign import ccall unsafe "taglib/tag_c.h taglib_audioproperties_channels" foreign import ccall unsafe "taglib/tag_c.h taglib_id3v2_set_default_text_encoding" c_taglib_id3v2_set_default_text_encoding :: CInt -> IO () +---------------------------------------------------------------------------- +-- Properties API + +foreign import ccall unsafe "taglib/tag_c.h taglib_property_set" + c_taglib_property_set :: Ptr TagLibFile -> CString -> CString -> IO () + +foreign import ccall unsafe "taglib/tag_c.h taglib_property_set_append" + c_taglib_property_set_append :: Ptr TagLibFile -> CString -> CString -> IO () + +foreign import ccall unsafe "taglib/tag_c.h taglib_property_get" + c_taglib_property_get :: Ptr TagLibFile -> CString -> IO (Ptr CString) + +foreign import ccall unsafe "taglib/tag_c.h taglib_property_free" + c_taglib_property_free :: Ptr CString -> IO () + ---------------------------------------------------------------------------- -- File API @@ -313,6 +333,45 @@ getChannels = id3v2SetEncoding :: T.ID3v2Encoding -> IO () id3v2SetEncoding = c_taglib_id3v2_set_default_text_encoding . enumToCInt +---------------------------------------------------------------------------- +-- Properties API + +propertySet :: Text -> Maybe Text -> FileId -> IO () +propertySet = propertySetHelper c_taglib_property_set + +propertySetAppend :: Text -> Maybe Text -> FileId -> IO () +propertySetAppend = propertySetHelper c_taglib_property_set_append + +propertySetHelper :: + (Ptr TagLibFile -> CString -> CString -> IO ()) -> + Text -> + Maybe Text -> + FileId -> + IO () +propertySetHelper f prop mvalue (FileId ptr) = + useAsCString (encodeUtf8 prop) $ \cprop -> + case mvalue of + Nothing -> f ptr cprop nullPtr + Just value -> useAsCString (encodeUtf8 value) $ f ptr cprop + +propertyGet :: Text -> FileId -> IO [Text] +propertyGet prop (FileId ptr) = + useAsCString (encodeUtf8 prop) $ \cprop -> + bracket + (c_taglib_property_get ptr cprop) + c_taglib_property_free + (ppCharToTexts []) + where + ppCharToTexts texts ppchar + | ppchar == nullPtr = return (reverse texts) + | otherwise = do + pchar <- peek ppchar + if pchar == nullPtr + then return (reverse texts) + else do + text <- decodeUtf8 <$> packCString pchar + ppCharToTexts (text : texts) (advancePtr ppchar 1) + ---------------------------------------------------------------------------- -- Helpers diff --git a/Sound/HTagLib/Setter.hs b/Sound/HTagLib/Setter.hs index 3f728f7..beb48dc 100644 --- a/Sound/HTagLib/Setter.hs +++ b/Sound/HTagLib/Setter.hs @@ -25,12 +25,14 @@ module Sound.HTagLib.Setter genreSetter, yearSetter, trackNumberSetter, + propertySetter, ) where import Control.Applicative ((<|>)) import Control.Monad.IO.Class import Data.Foldable (forM_) +import Data.Text (Text) import Sound.HTagLib.Internal qualified as I import Sound.HTagLib.Type @@ -49,7 +51,8 @@ data TagSetter = TagSetter sdComment :: Maybe Comment, sdGenre :: Maybe Genre, sdYear :: Maybe (Maybe Year), - sdTrackNumber :: Maybe (Maybe TrackNumber) + sdTrackNumber :: Maybe (Maybe TrackNumber), + sdProperties :: [(Text, [Text])] } -- | @since 1.2.0 @@ -63,7 +66,8 @@ instance Semigroup TagSetter where sdComment = f sdComment, sdGenre = f sdGenre, sdYear = f sdYear, - sdTrackNumber = f sdTrackNumber + sdTrackNumber = f sdTrackNumber, + sdProperties = f sdProperties } instance Monoid TagSetter where @@ -75,7 +79,8 @@ instance Monoid TagSetter where sdComment = Nothing, sdGenre = Nothing, sdYear = Nothing, - sdTrackNumber = Nothing + sdTrackNumber = Nothing, + sdProperties = [] } mappend = (<>) @@ -131,7 +136,13 @@ execSetter path enc t TagSetter {..} = liftIO . I.withFile path t $ \fid -> do writeTag sdGenre I.setGenre writeTag sdYear I.setYear writeTag sdTrackNumber I.setTrackNumber + forM_ sdProperties (writeProperty fid) I.saveFile path fid + where + writeProperty fid (k, []) = I.propertySet k Nothing fid + writeProperty fid (k, v : vs) = do + I.propertySet k (Just v) fid + forM_ vs $ \v' -> I.propertySetAppend k (Just v') fid -- | Setter for the track title. titleSetter :: Title -> TagSetter @@ -160,3 +171,7 @@ yearSetter x = mempty {sdYear = Just x} -- | Setter for the track number, use 'Nothing' to clear the field. trackNumberSetter :: Maybe TrackNumber -> TagSetter trackNumberSetter x = mempty {sdTrackNumber = Just x} + +-- | Setter for a property with a given key, use an empty list to clear it. +propertySetter :: Text -> [Text] -> TagSetter +propertySetter k v = mempty {sdProperties = [(k, v)]} diff --git a/audio-samples/sample.flac b/audio-samples/sample.flac index 3fe3a91..d8450b2 100644 Binary files a/audio-samples/sample.flac and b/audio-samples/sample.flac differ diff --git a/audio-samples/sample.mp3 b/audio-samples/sample.mp3 index 672985c..393bab9 100644 Binary files a/audio-samples/sample.mp3 and b/audio-samples/sample.mp3 differ diff --git a/htaglib.cabal b/htaglib.cabal index 828bb03..d3a062f 100644 --- a/htaglib.cabal +++ b/htaglib.cabal @@ -69,7 +69,8 @@ test-suite tests directory >=1.2 && <1.4, filepath >=1.4 && <2, hspec >=2 && <3, - htaglib + htaglib, + text >=1 && <2.2 if flag(dev) ghc-options: diff --git a/tests/Sound/HTagLib/SetterSpec.hs b/tests/Sound/HTagLib/SetterSpec.hs index 9f97bd7..ab4311a 100644 --- a/tests/Sound/HTagLib/SetterSpec.hs +++ b/tests/Sound/HTagLib/SetterSpec.hs @@ -29,7 +29,8 @@ updateSampleTags tags = atComment = mkComment "comment'", atGenre = mkGenre "genre'", atYear = mkYear 2056, - atTrackNumber = mkTrackNumber 8 + atTrackNumber = mkTrackNumber 8, + atAlbumArtistProperty = ["albumartist'"] } simpleSetter :: AudioTags -> Expectation diff --git a/tests/Sound/HTagLib/Test/Util.hs b/tests/Sound/HTagLib/Test/Util.hs index 681d38b..1f83c96 100644 --- a/tests/Sound/HTagLib/Test/Util.hs +++ b/tests/Sound/HTagLib/Test/Util.hs @@ -11,6 +11,7 @@ module Sound.HTagLib.Test.Util where import Data.Maybe (fromJust) +import Data.Text (Text) import Sound.HTagLib import Test.Hspec @@ -26,7 +27,8 @@ data AudioTags = AudioTags atDuration :: Duration, atBitRate :: BitRate, atSampleRate :: SampleRate, - atChannels :: Channels + atChannels :: Channels, + atAlbumArtistProperty :: [Text] } deriving (Show, Eq) @@ -45,6 +47,7 @@ sampleGetter path = <*> bitRateGetter <*> sampleRateGetter <*> channelsGetter + <*> propertyGetter "ALBUMARTIST" sampleSetter :: TagSetter sampleSetter = @@ -56,6 +59,7 @@ sampleSetter = <> genreSetter (mkGenre "genre'") <> yearSetter (mkYear 2056) <> trackNumberSetter (mkTrackNumber 8) + <> propertySetter "ALBUMARTIST" ["albumartist'"] sampleTags :: AudioTags sampleTags = @@ -71,7 +75,8 @@ sampleTags = atDuration = fromJust $ mkDuration 0, atBitRate = fromJust $ mkBitRate 0, atSampleRate = fromJust $ mkSampleRate 44100, - atChannels = fromJust $ mkChannels 2 + atChannels = fromJust $ mkChannels 2, + atAlbumArtistProperty = ["albumartist"] } fileList :: [(FileType, AudioTags)]