Add tests and Unicode support

Codec/Audio/LAME.hs

@@ -10,7 +10,8 @@
 -- The module provides an interface to LAME MP3 encoder. All you need to do
 -- to encode a WAVE (or RF64) file is to call 'encodeMp3', which see.
 
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
 
 module Codec.Audio.LAME
   ( encodeMp3
@@ -34,6 +35,7 @@ import System.Directory
 import System.FilePath
 import System.IO
 import qualified Codec.Audio.LAME.Internal as I
+import qualified Data.Text                 as T
 
 -- | LAME encoder settings.
 --
@@ -246,13 +248,13 @@ encodeMp3 EncoderSettings {..} ipath' opath' = liftIO . I.withLame $ \l -> do
     Id3v1Only -> I.id3TagV1Only l
     Id3v2Only -> I.id3TagV2Only l
     Id3Both   -> I.id3TagAddV2  l
-  forM_ encoderTagTitle   (I.id3TagSetTitle   l)
-  forM_ encoderTagArtist  (I.id3TagSetArtist  l)
-  forM_ encoderTagAlbum   (I.id3TagSetAlbum   l)
-  forM_ encoderTagYear    (I.id3TagSetYear    l)
-  forM_ encoderTagComment (I.id3TagSetComment l)
-  forM_ encoderTagTrack   (uncurry $ I.id3TagSetTrack l)
-  forM_ encoderTagGenre   (I.id3TagSetGenre   l)
+  forM_ encoderTagTitle   (I.id3TagSetTextInfo l "TIT2")
+  forM_ encoderTagArtist  (I.id3TagSetTextInfo l "TPE1")
+  forM_ encoderTagAlbum   (I.id3TagSetTextInfo l "TALB")
+  forM_ encoderTagYear    (I.id3TagSetTextInfo l "TYER")
+  forM_ encoderTagComment (I.id3TagSetTextInfo l "COMM")
+  forM_ encoderTagTrack   (uncurry renderTrackNumber >=> I.id3TagSetTextInfo l "TRCK")
+  forM_ encoderTagGenre   (I.id3TagSetTextInfo l "TCON")
   setupFilter I.setLowpassFreq  I.setLowpassWidth  l encoderLowpassFilter
   setupFilter I.setHighpassFreq I.setHighpassWidth l encoderHighpassFilter
   I.initParams l
@@ -300,3 +302,8 @@ ignoringIOErrors ioe = ioe `catch` handler
   where
     handler :: IOError -> IO ()
     handler = const (return ())
+
+renderTrackNumber :: Word8 -> Maybe Word8 -> IO Text
+renderTrackNumber 0 t          = throwM (I.LameInvalidTrackNumber 0 t)
+renderTrackNumber n t@(Just 0) = throwM (I.LameInvalidTrackNumber n t)
+renderTrackNumber n t = return . T.pack $ show n ++ maybe "" (("/" ++) . show) t

Codec/Audio/LAME/Internal.hs

@@ -57,28 +57,19 @@ module Codec.Audio.LAME.Internal
   , id3TagAddV2
   , id3TagV1Only
   , id3TagV2Only
-  , id3TagSetTitle
-  , id3TagSetArtist
-  , id3TagSetAlbum
-  , id3TagSetYear
-  , id3TagSetComment
-  , id3TagSetTrack
-  , id3TagSetGenre
+  , id3TagSetTextInfo
     -- * Encoding
   , encodingHelper )
 where
 
 import Codec.Audio.Wave
-import Control.Monad
 import Control.Monad.Catch
 import Data.Text (Text)
 import Data.Void
 import Foreign hiding (void)
 import Foreign.C.String
 import Unsafe.Coerce
-import qualified Data.ByteString    as B
-import qualified Data.Text          as T
-import qualified Data.Text.Encoding as T
+import qualified Data.Text.Foreign as TF
 
 ----------------------------------------------------------------------------
 -- Types
@@ -438,71 +429,16 @@ id3TagV2Only = c_id3tag_v2_only
 foreign import ccall unsafe "id3tag_v2_only"
   c_id3tag_v2_only :: Lame -> IO ()
 
--- | Set track's “title” tag.
+-- | Set a textual tag identifying it by its ID.
 
-id3TagSetTitle :: Lame -> Text -> IO ()
-id3TagSetTitle l x = withCStringText x (c_id3tag_set_title l)
+id3TagSetTextInfo :: Lame -> String -> Text -> IO ()
+id3TagSetTextInfo l id' text = handleErrors $
+  withCString id' $ \idPtr ->
+    TF.useAsPtr text $ \textPtr len ->
+      c_id3tag_set_textinfo_utf16 l idPtr textPtr (fromIntegral len)
 
-foreign import ccall unsafe "id3tag_set_title"
-  c_id3tag_set_title :: Lame -> CString -> IO ()
-
--- | Set track's “artist” tag.
-
-id3TagSetArtist :: Lame -> Text -> IO ()
-id3TagSetArtist l x = withCStringText x (c_id3tag_set_artist l)
-
-foreign import ccall unsafe "id3tag_set_artist"
-  c_id3tag_set_artist :: Lame -> CString -> IO ()
-
--- | Set track's “album” tag.
-
-id3TagSetAlbum :: Lame -> Text -> IO ()
-id3TagSetAlbum l x = withCStringText x (c_id3tag_set_album l)
-
-foreign import ccall unsafe "id3tag_set_album"
-  c_id3tag_set_album :: Lame -> CString -> IO ()
-
--- | Set track's “year” tag.
-
-id3TagSetYear :: Lame -> Text -> IO ()
-id3TagSetYear l x = withCStringText x (c_id3tag_set_year l)
-
-foreign import ccall unsafe "id3tag_set_year"
-  c_id3tag_set_year :: Lame -> CString -> IO ()
-
--- | Set track's “comment” tag.
-
-id3TagSetComment :: Lame -> Text -> IO ()
-id3TagSetComment l x = withCStringText x (c_id3tag_set_comment l)
-
-foreign import ccall unsafe "id3tag_set_comment"
-  c_id3tag_set_comment :: Lame -> CString -> IO ()
-
--- | Set track number. If at least one argument is 0, an exception will be
--- thrown.
-
-id3TagSetTrack
-  :: Lame              -- ^ The settings
-  -> Word8             -- ^ Index of this track
-  -> Maybe Word8       -- ^ Total number of tracks (optional)
-  -> IO ()
-id3TagSetTrack _ 0 t          = throwM (LameInvalidTrackNumber 0 t)
-id3TagSetTrack _ n t@(Just 0) = throwM (LameInvalidTrackNumber n t)
-id3TagSetTrack l n t =
-  let v = show n ++ maybe "" (("/" ++) . show) t
-  in void $ withCString v (c_id3tag_set_track l)
-
-foreign import ccall unsafe "id3tag_set_track"
-  c_id3tag_set_track :: Lame -> CString -> IO Int
-
--- | Set genre.
-
-id3TagSetGenre :: Lame -> Text -> IO ()
-id3TagSetGenre l x =
-  void $ withCStringText x (c_id3tag_set_genre l)
-
-foreign import ccall unsafe "id3tag_set_genre"
-  c_id3tag_set_genre :: Lame -> CString -> IO Int
+foreign import ccall unsafe "id3tag_set_textinfo_utf16_"
+  c_id3tag_set_textinfo_utf16 :: Lame -> CString -> Ptr Word16 -> Int -> IO Int
 
 ----------------------------------------------------------------------------
 -- Encoding
@@ -566,10 +502,3 @@ handleErrors m = do
     -12 -> throwM LameBadSampleFreq
     -13 -> throwM LameInternalError
     _   -> throwM LameGenericError
-
--- | Convert a 'Text' value to 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)

cbits/helpers.c

@@ -33,6 +33,23 @@
 
 #include "helpers.h"
 
+int id3tag_set_textinfo_utf16_
+  ( lame_global_flags *gfp
+  , const char *id
+  , const uint16_t *raw_text
+  , int len)
+{
+  uint16_t *text = alloca(sizeof(uint16_t) * (len + 2));
+  int i;
+  *(text + 0) = 0xfeff; /* BOM FIXME need to detect endiannes properly */
+  for (i = 0; i < len; i++)
+    {
+      *(text + i + 1) = *(raw_text + i);
+    }
+  *(text + len + 1) = 0;
+  return id3tag_set_textinfo_utf16(gfp, id, text);
+}
+
 static unsigned round_to_bytes(unsigned bits)
 {
   return (bits + (bits % 8)) / 8;

cbits/helpers.h

@@ -42,6 +42,7 @@
 #include <stdint.h>
 #include <stdlib.h>
 
+int id3tag_set_textinfo_utf16_(lame_global_flags *, const char *, const uint16_t *, int);
 int lame_encoding_helper(lame_global_flags *, uint64_t, uint64_t, uint16_t, uint16_t, const char *, const char *);
 
 #endif /* LAME_HASKELL_HELPERS_H */

lame.cabal

@@ -83,9 +83,14 @@ test-suite tests
   hs-source-dirs:     tests
   type:               exitcode-stdio-1.0
   build-depends:      base             >= 4.8   && < 5.0
+                    , data-default-class
+                    , directory        >= 1.2.2 && < 1.4
+                    , filepath         >= 1.2   && < 1.5
                     , hspec            >= 2.0   && < 3.0
-                    , htaglib          >= 1.0   && < 1.1
+                    , htaglib          >= 1.0   && < 1.2
                     , lame             >= 0.1.0
+                    , temporary        >= 1.1   && < 1.3
+                    , text             >= 0.2   && < 1.3
   other-modules:      Codec.Audio.LAMESpec
   if flag(dev)
     ghc-options:      -Wall -Werror

tests/Codec/Audio/LAMESpec.hs

@@ -30,11 +30,118 @@
 -- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 -- POSSIBILITY OF SUCH DAMAGE.
 
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
 module Codec.Audio.LAMESpec
   ( spec )
 where
 
+import Codec.Audio.LAME
+import Control.Monad
+import Data.Default.Class
+import Data.Text (Text)
+import Data.Word (Word8)
+import Sound.HTagLib
+import System.Directory
+import System.FilePath
+import System.IO.Temp (withSystemTempDirectory)
 import Test.Hspec
+import qualified Data.Text as T
+
+data Info = Info
+  { infoTitle       :: Title
+  , infoArtist      :: Artist
+  , infoAlbum       :: Album
+  , infoComment     :: Comment
+  , infoGenre       :: Genre
+  , infoYear        :: Maybe Year
+  , infoTrackNumber :: Maybe TrackNumber
+  , infoDuration    :: Duration
+  , infoBitRate     :: BitRate
+  , infoSampleRate  :: SampleRate
+  , infoChannels    :: Channels
+  } deriving (Eq, Show)
 
 spec :: Spec
-spec = return ()
+spec =
+  describe "encodeMp3" $
+    withVariousWaves $
+      it "produces correct MP3 file" $ \(ipath, opath) -> do
+        encodeMp3 def
+          { encoderTagTitle   = pure tagTitle
+          , encoderTagArtist  = pure tagArtist
+          , encoderTagAlbum   = pure tagAlbum
+          , encoderTagYear    = pure tagYear
+          , encoderTagComment = pure tagComment
+          , encoderTagTrack   = pure tagTrack
+          , encoderTagGenre   = pure tagGenre }
+          ipath
+          opath
+        Info {..} <- getTags' opath MPEG $ Info
+          <$> titleGetter
+          <*> artistGetter
+          <*> albumGetter
+          <*> commentGetter
+          <*> genreGetter
+          <*> yearGetter
+          <*> trackNumberGetter
+          <*> durationGetter
+          <*> bitRateGetter
+          <*> sampleRateGetter
+          <*> channelsGetter
+        unTitle infoTitle `shouldBe` tagTitle
+        unArtist infoArtist `shouldBe` tagArtist
+        unAlbum infoAlbum `shouldBe` tagAlbum
+        fmap (T.pack . show . unYear) infoYear  `shouldBe` pure tagYear
+        unComment infoComment `shouldBe` tagComment
+        fmap unTrackNumber infoTrackNumber `shouldBe`
+          (pure . fromIntegral . fst) tagTrack
+        unGenre infoGenre `shouldBe` tagGenre
+        unDuration infoDuration `shouldBe` 1
+        unBitRate infoBitRate `shouldBe` 128
+        unSampleRate infoSampleRate `shouldBe` 44100
+        unChannels infoChannels `shouldBe` 2
+
+----------------------------------------------------------------------------
+-- Helpers
+
+-- | Run given test with various WAVE files.
+
+withVariousWaves :: SpecWith (FilePath, FilePath) -> SpecWith ()
+withVariousWaves m =
+  forM_ waveFiles $ \(path, desc) ->
+    context ("when given " ++ desc) (around (withSandbox path) m)
+
+-- | 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, FilePath) -> IO ()
+withSandbox path action =
+  withSystemTempDirectory "lame-test" $ \dir -> do
+    let ipath = dir </> "файл" -- testing Unicode
+        opath = dir </> "результат"
+    copyFile path ipath
+    action (ipath, opath)
+
+waveFiles :: [(FilePath, String)]
+waveFiles =
+  [ ( "audio-samples/16bit-int.wav"
+    , "2 channels 44100 Hz 16 bit PCM" )
+  , ( "audio-samples/32bit-float.wav"
+    , "2 channels 44100 Hz 32 bit float PCM" )
+  , ( "audio-samples/64bit-float.wav"
+    , "2 channels 44100 Hz 64 bit float PCM" )
+  ]
+
+tagTitle, tagArtist, tagAlbum, tagYear, tagComment, tagGenre :: Text
+tagTitle   = "Название"
+tagArtist  = "Исполнитель"
+tagAlbum   = "Альбом"
+tagYear    = "2017"
+tagComment = "Комментарий тут…"
+tagGenre   = "Жанр"
+
+tagTrack :: (Word8, Maybe Word8)
+tagTrack = (1, Just 10)