From c662bd105e83271816629dcf97857f9cfb479026 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 13 Oct 2025 14:33:48 +0200 Subject: [PATCH 1/3] Add the property API --- Sound/HTagLib.hs | 2 ++ Sound/HTagLib/Getter.hs | 6 ++++ Sound/HTagLib/Internal.hs | 57 ++++++++++++++++++++++++++++++ Sound/HTagLib/Setter.hs | 21 +++++++++-- audio-samples/sample.flac | Bin 11459 -> 11486 bytes audio-samples/sample.mp3 | Bin 7695 -> 7823 bytes htaglib.cabal | 3 +- tests/Sound/HTagLib/SetterSpec.hs | 3 +- tests/Sound/HTagLib/Test/Util.hs | 9 +++-- 9 files changed, 94 insertions(+), 7 deletions(-) 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..e4c3b44 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,43 @@ 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 = 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 3fe3a919fee0b7c091c8761c594c043caa90db7e..d8450b25bb792d19305853093da84ff929564022 100644 GIT binary patch delta 47 zcmX>cc`tH;F5|I@dMb>Z6NB5N#2FYE9DSTZeI0{BJcC1Q6LXSEa}$e7GK)9fc&!Zp DcgqmC delta 20 ccmcZ?c{p-{F5~KndMb<@6NB3}etD%009vC6%>V!Z diff --git a/audio-samples/sample.mp3 b/audio-samples/sample.mp3 index 672985c97e24a1f4bbdb39a538b89c1f5d43263e..393bab9bc80a702d9ed18827cd359f65d127eb82 100644 GIT binary patch delta 208 zcmeCT>9?)-bTMXO00Ks3XMbN`AcF^pBO)RglJj$OQ}aqf9DSUCB5XjMn3GhR8{+Km z2j!=y<`t!exCA)^`K&-}WMFC<;u&HDl`hFF$w>_fa5V(-*?~B*s3fzv1SkMf0JMb} zWS(#?R5-}l8z{^K#O4z>N^e}7B+C)v=nghx;zmg}h^mPjC0N0(019z~tb;mo;zlth G_WuBN@-#O9 delta 171 zcmeCT?YF7-bTMXO00Ktk5NCfsAcGBv(^K<`QbQbloS^)~oTSp+kRWGoAfE|{%|kpx zjG%HQnI$=?A(5^@Kt3xF8yT3IhPVVdBXOPmeSLvk9v}vRpF 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)] From 6372e8b6aa4a3a88872ef78672ce655b6a2acc59 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 13 Oct 2025 15:21:59 +0200 Subject: [PATCH 2/3] Bump taglib to the version shipped with current ubuntu --- .github/workflows/ci.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 13d5981afa57b52cda717e5f96028c27fa71da2a Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 13 Oct 2025 17:07:58 +0200 Subject: [PATCH 3/3] Fix crash when a property is not present in the file --- Sound/HTagLib/Internal.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/Sound/HTagLib/Internal.hs b/Sound/HTagLib/Internal.hs index e4c3b44..85b95b5 100644 --- a/Sound/HTagLib/Internal.hs +++ b/Sound/HTagLib/Internal.hs @@ -362,13 +362,15 @@ propertyGet prop (FileId ptr) = c_taglib_property_free (ppCharToTexts []) where - ppCharToTexts texts ppchar = do - pchar <- peek ppchar - if pchar == nullPtr - then return (reverse texts) - else do - text <- decodeUtf8 <$> packCString pchar - ppCharToTexts (text : texts) (advancePtr ppchar 1) + 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