Add the property API

Author: jecaro

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,

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

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
 

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)]}

audio-samples/sample.flac

@@ -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:

audio-samples/sample.mp3

@@ -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

htaglib.cabal

@@ -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)]