packages feed

htaglib (empty) → 0.1.0

raw patch · 13 files changed

+1386/−0 lines, 13 filesdep +HUnitdep +basedep +directorysetup-changed

Dependencies added: HUnit, base, directory, filepath, htaglib, test-framework, test-framework-hunit

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## HTagLib 0.1.0++* Initial release.
+ LICENSE.md view
@@ -0,0 +1,28 @@+Copyright © 2015 Mark Karpov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the distribution.++* Neither the name Mark Karpov nor the names of contributors may be used to+  endorse or promote products derived from this software without specific+  prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ Sound/HTagLib.hs view
@@ -0,0 +1,85 @@+-- |+-- Module      :  Sound.HTagLib+-- Copyright   :  © 2015 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov@opmbx.org>+-- Stability   :  experimental+-- Portability :  portable+--+-- This module includes complete high-level interface to TagLib. This is the+-- module you should import to use in your projects.++module Sound.HTagLib+  ( -- * Data types+    Title+  , mkTitle+  , getTitle+  , Artist+  , mkArtist+  , getArtist+  , Album+  , mkAlbum+  , getAlbum+  , Comment+  , mkComment+  , getComment+  , Genre+  , mkGenre+  , getGenre+  , Year+  , mkYear+  , getYear+  , TrackNumber+  , mkTrackNumber+  , getTrackNumber+  , Duration+  , mkDuration+  , getDuration+  , BitRate+  , mkBitRate+  , getBitRate+  , SampleRate+  , mkSampleRate+  , getSampleRate+  , Channels+  , mkChannels+  , getChannels+  , FileType (..)+  , ID3v2Encoding (..)+  , HTagLibException (..)+    -- * Getters+  , TagGetter+  , getTags+  , getTags'+  , titleGetter+  , artistGetter+  , albumGetter+  , commentGetter+  , genreGetter+  , yearGetter+  , trackNumberGetter+  , durationGetter+  , bitRateGetter+  , sampleRateGetter+  , channelsGetter+    -- * Setters+  , TagSetter+  , setTags+  , setTags'+  , titleSetter+  , artistSetter+  , albumSetter+  , commentSetter+  , genreSetter+  , yearSetter+  , trackNumberSetter )+where++import Sound.HTagLib.Getter+import Sound.HTagLib.Internal+  ( FileType (..)+  , ID3v2Encoding (..)+  , HTagLibException (..) )+import Sound.HTagLib.Setter+import Sound.HTagLib.Type
+ Sound/HTagLib/Getter.hs view
@@ -0,0 +1,140 @@+-- |+-- Module      :  Sound.HTagLib.Getter+-- Copyright   :  © 2015 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov@opmbx.org>+-- Stability   :  experimental+-- Portability :  portable+--+-- High-level applicative interface for reading of audio meta data. You+-- don't need to import this module directly, import "Sound.HTagLib"+-- instead.++{-# LANGUAGE CPP #-}++module Sound.HTagLib.Getter+  ( TagGetter+  , getTags+  , getTags'+    -- * Built-in getters+  , titleGetter+  , artistGetter+  , albumGetter+  , commentGetter+  , genreGetter+  , yearGetter+  , trackNumberGetter+  , durationGetter+  , bitRateGetter+  , sampleRateGetter+  , channelsGetter )+where++import Sound.HTagLib.Type+import qualified Sound.HTagLib.Internal as I++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (Applicative, (<$>), (<*>), pure)+#endif++-- | This type represents composable entity that can be used with 'getTags'+-- or 'getTags'' functions to read batch of meta parameters.++newtype TagGetter a = TagGetter { runGetter :: I.FileId -> IO a }++instance Functor TagGetter where+  fmap f x = TagGetter $ \fid -> f <$> runGetter x fid++instance Applicative TagGetter where+  pure    = TagGetter . const . return+  x <*> y = TagGetter $ \fid ->+              do f <- runGetter x fid+                 f <$> runGetter y fid++-- | @getTags path g@ will try to read file located at @path@ and read meta+-- data of the file using getter @g@. Type of file will be guessed from its+-- extension. If this is not satisfactory and you want to explicitly specify+-- file type, see 'getTags'' variation of this function.+--+-- In case of trouble 'I.HTagLibException' will be thrown.++getTags :: FilePath    -- ^ Path to audio file+        -> TagGetter a -- ^ Getter+        -> IO a        -- ^ Extracted data+getTags path = execGetter path Nothing++-- | This is essentially the same as 'getTags', but allows to explicitly+-- choose file type (see 'I.FileType').++getTags' :: FilePath    -- ^ Path to audio file+         -> I.FileType  -- ^ Type of audio file+         -> TagGetter a -- ^ Getter+         -> IO a        -- ^ Extracted data+getTags' path t = execGetter path (Just t)++-- | This is the most general way to read meta data from file. 'getTags' and+-- 'getTags'' are just wrappers around the function.++execGetter :: FilePath         -- ^ Path to audio file+           -> Maybe I.FileType -- ^ Type of audio file (if known)+           -> TagGetter a      -- ^ Getter+           -> IO a             -- ^ Extracted data+execGetter path t = I.withFile path t . runGetter++-- | Getter to retrieve track title.++titleGetter :: TagGetter Title+titleGetter = TagGetter I.getTitle++-- | Getter to retrieve track artist.++artistGetter :: TagGetter Artist+artistGetter = TagGetter I.getArtist++-- | Getter to retrieve track album.++albumGetter :: TagGetter Album+albumGetter = TagGetter I.getAlbum++-- | Getter to retrieve track comment.++commentGetter :: TagGetter Comment+commentGetter = TagGetter I.getComment++-- | Getter to retrieve genre of the track.++genreGetter :: TagGetter Genre+genreGetter = TagGetter I.getGenre++-- | Getter to retrieve year to the track (returns 'Nothing' if the data is+-- missing).++yearGetter :: TagGetter (Maybe Year)+yearGetter = TagGetter I.getYear++-- | Getter to retrieve track number (returns 'Nothing' if the data is+-- missing).++trackNumberGetter :: TagGetter (Maybe TrackNumber)+trackNumberGetter = TagGetter I.getTrackNumber++-- | Getter to retrieve duration in seconds.++durationGetter :: TagGetter Duration+durationGetter = TagGetter I.getDuration++-- | Getter to retrieve bit rate.++bitRateGetter :: TagGetter BitRate+bitRateGetter = TagGetter I.getBitRate++-- | Getter to retrieve sample rate.++sampleRateGetter :: TagGetter SampleRate+sampleRateGetter = TagGetter I.getSampleRate++-- | Getter to retrieve number of channels in audio data.++channelsGetter :: TagGetter Channels+channelsGetter = TagGetter I.getChannels
+ Sound/HTagLib/Internal.hs view
@@ -0,0 +1,416 @@+-- |+-- Module      :  Sound.HTagLib.Internal+-- Copyright   :  © 2015 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov@opmbx.org>+-- Stability   :  experimental+-- Portability :  portable+--+-- Low-level interaction with underlying C API. You don't want to use this,+-- see "Sound.HTagLib" instead.++{-# LANGUAGE CPP                      #-}+{-# LANGUAGE DeriveDataTypeable       #-}+{-# LANGUAGE EmptyDataDecls           #-}+{-# LANGUAGE ForeignFunctionInterface #-}++module Sound.HTagLib.Internal+  ( -- * Data types+    FileId+  , FileType (..)+  , ID3v2Encoding (..)+  , HTagLibException (..)+    -- * File API+  , withFile+  , saveFile+    -- * Tag API+  , getTitle+  , getArtist+  , getAlbum+  , getComment+  , getGenre+  , getYear+  , getTrackNumber+  , setTitle+  , setArtist+  , setAlbum+  , setComment+  , setGenre+  , setYear+  , setTrackNumber+    -- * Audio properties API+  , getDuration+  , getBitRate+  , getSampleRate+  , getChannels+    -- * Special convenience ID3v2 functions+  , id3v2SetEncoding )+where++import Control.Exception+import Control.Monad (when, unless)+import Data.Maybe (fromJust)+import Data.Typeable (Typeable)+import Foreign+import Foreign.C.String+import Foreign.C.Types++import qualified Sound.HTagLib.Type as T++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif++data TagLibFile+data TagLibTag+data TagLibProperties++-- | This is an abstraction representing opened file. Other modules can+-- pass it around and treat it like a black box.++newtype FileId = FileId (Ptr TagLibFile)++-- | Types of files TagLib can work with. This may be used to explicitly+-- specify type of file rather than relying on TagLib ability to guess type+-- of file from its extension.++data FileType+  = MPEG+  | OggVorbis+  | FLAC+  | MPC+  | OggFlac+  | WavPack+  | Speex+  | TrueAudio+  | MP4+  | ASF+    deriving (Show, Eq, Enum)++-- | Encoding for ID3v2 frames that are written to tags.++data ID3v2Encoding+  = ID3v2Latin1+  | ID3v2UTF16+  | ID3v2UTF16BE+  | ID3v2UTF8+    deriving (Show, Eq, Enum)++-- | The data type represents exceptions specific to the library. The+-- following constructors are defined:+--+--     * @OpeningFailed@ means that attempt to open audio file to read its+--     tags failed.+--     * @InvalidFile@ means that file can be opened, but it doesn't contain+--     any information that can be interpreted by the library.+--     * @SavingFailed@ is thrown when well… saving failed.++data HTagLibException+  = OpeningFailed FilePath+  | InvalidFile   FilePath+  | SavingFailed  FilePath+    deriving (Eq, Show, Typeable)++instance Exception HTagLibException++-- Misc++foreign import ccall unsafe "taglib/tag_c.h taglib_set_string_management_enabled"+  c_taglib_set_string_management_enabled :: CInt -> IO ()++-- File API++foreign import ccall unsafe "taglib/tag_c.h taglib_file_new"+  c_taglib_file_new :: CString -> IO (Ptr TagLibFile)++foreign import ccall unsafe "taglib/tag_c.h taglib_file_new_type"+  c_taglib_file_new_type :: CString -> CInt -> IO (Ptr TagLibFile)++foreign import ccall unsafe "taglib/tag_c.h taglib_file_free"+  c_taglib_file_free :: Ptr TagLibFile -> IO ()++foreign import ccall unsafe "taglib/tag_c.h taglib_file_is_valid"+  c_taglib_file_is_valid :: Ptr TagLibFile -> IO CInt++foreign import ccall unsafe "taglib/tag_c.h taglib_file_tag"+  c_taglib_file_tag :: Ptr TagLibFile -> IO (Ptr TagLibTag)++foreign import ccall unsafe "taglib/tag_c.h taglib_file_audioproperties"+  c_taglib_file_properties :: Ptr TagLibFile -> IO (Ptr TagLibProperties)++foreign import ccall unsafe "taglib/tag_c.h taglib_file_save"+  c_taglib_file_save :: Ptr TagLibFile -> IO CInt++-- Tag API++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_title"+  c_taglib_tag_title :: Ptr TagLibTag -> IO CString++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_artist"+  c_taglib_tag_artist :: Ptr TagLibTag -> IO CString++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_album"+  c_taglib_tag_album :: Ptr TagLibTag -> IO CString++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_comment"+  c_taglib_tag_comment :: Ptr TagLibTag -> IO CString++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_genre"+  c_taglib_tag_genre :: Ptr TagLibTag -> IO CString++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_year"+  c_taglib_tag_year :: Ptr TagLibTag -> IO CUInt++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_track"+  c_taglib_tag_track :: Ptr TagLibTag -> IO CUInt++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_set_title"+  c_taglib_tag_set_title :: Ptr TagLibTag -> CString -> IO ()++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_set_artist"+  c_taglib_tag_set_artist :: Ptr TagLibTag -> CString -> IO ()++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_set_album"+  c_taglib_tag_set_album :: Ptr TagLibTag -> CString -> IO ()++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_set_comment"+  c_taglib_tag_set_comment :: Ptr TagLibTag -> CString -> IO ()++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_set_genre"+  c_taglib_tag_set_genre :: Ptr TagLibTag -> CString -> IO ()++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_set_year"+  c_taglib_tag_set_year :: Ptr TagLibTag -> CUInt -> IO ()++foreign import ccall unsafe "taglib/tag_c.h taglib_tag_set_track"+  c_taglib_tag_set_track :: Ptr TagLibTag -> CUInt -> IO ()++-- Audio properties API++foreign import ccall unsafe "taglib/tag_c.h taglib_audioproperties_length"+  c_taglib_properties_length :: Ptr TagLibProperties -> IO CInt++foreign import ccall unsafe "taglib/tag_c.h taglib_audioproperties_bitrate"+  c_taglib_properties_bitrate :: Ptr TagLibProperties -> IO CInt++foreign import ccall unsafe "taglib/tag_c.h taglib_audioproperties_samplerate"+  c_taglib_properties_samplerate :: Ptr TagLibProperties -> IO CInt++foreign import ccall unsafe "taglib/tag_c.h taglib_audioproperties_channels"+  c_taglib_properties_channels :: Ptr TagLibProperties -> IO CInt++-- Special convenience ID3v2 functions++foreign import ccall unsafe "taglib/tag_c.h taglib_id3v2_set_default_text_encoding"+  c_taglib_id3v2_set_default_text_encoding :: CInt -> IO ()++-- Wrappers. Here we prepare a little higher-level interface that will be+-- used by the rest of the library.++-- File API++-- | Open audio file and return its ID (abstraction that rest of library can+-- pass around). In case of trouble 'IOException' is thrown.++newFile :: FilePath       -- ^ Path to audio file+        -> Maybe FileType -- ^ Type of file (or it will be guessed)+        -> IO FileId      -- ^ Id to pass around+newFile path ftype = do+  c_taglib_set_string_management_enabled $ fromBool False+  ptr <- withCString path $ \cstr ->+           case ftype of+             Nothing -> c_taglib_file_new cstr+             Just t  -> c_taglib_file_new_type cstr (enumToCInt t)+  when (ptr == nullPtr) $ throw (OpeningFailed path)+  valid <- toBool <$> c_taglib_file_is_valid ptr+  unless valid $ throw (InvalidFile path)+  return $ FileId ptr++-- | Free file given its ID. Every time you open a file, free it.++freeFile :: FileId -> IO ()+freeFile (FileId ptr) = c_taglib_file_free ptr++-- | Open audio file located at specified path, execute some actions given+-- its 'FileId' and then free the file.++withFile :: FilePath         -- ^ Path to audio file+         -> Maybe FileType   -- ^ Type of file (or it will be guessed)+         -> (FileId -> IO a) -- ^ Computation depending of 'FileId'+         -> IO a             -- ^ Result value+withFile path t = bracket (newFile path t) freeFile++-- | Save file given its ID. Given 'FilePath' just tells what to put into+-- exception if the action fails, it doesn't specify where to save the file+-- (it's determined by 'FileId').++saveFile :: FilePath -- ^ File name to use in exceptions+         -> FileId   -- ^ File identifier+         -> IO ()+saveFile path (FileId ptr) = do+  success <- toBool <$> c_taglib_file_save ptr+  unless success $ throw (SavingFailed path)++-- Tag API++-- | Get title tag associated with file.++getTitle :: FileId -> IO T.Title+getTitle = fmap T.mkTitle . getStrValue c_taglib_tag_title++-- | Get artist tag associated with file.++getArtist :: FileId -> IO T.Artist+getArtist = fmap T.mkArtist . getStrValue c_taglib_tag_artist++-- | Get album tag associated with file.++getAlbum :: FileId -> IO T.Album+getAlbum = fmap T.mkAlbum . getStrValue c_taglib_tag_album++-- | Get comment tag associated with file.++getComment :: FileId -> IO T.Comment+getComment = fmap T.mkComment . getStrValue c_taglib_tag_comment++-- | Get genre tag associated with file.++getGenre :: FileId -> IO T.Genre+getGenre = fmap T.mkGenre . getStrValue c_taglib_tag_genre++-- | Get year tag associated with file.++getYear :: FileId -> IO (Maybe T.Year)+getYear = fmap T.mkYear . getIntValue c_taglib_tag_year++-- | Get track number associated with file.++getTrackNumber :: FileId -> IO (Maybe T.TrackNumber)+getTrackNumber = fmap T.mkTrackNumber . getIntValue c_taglib_tag_track++-- | Set title of track associated with file.++setTitle :: T.Title -> FileId -> IO ()+setTitle v = setStrValue c_taglib_tag_set_title (T.getTitle v)++-- | Set artist of track associated with file.++setArtist :: T.Artist -> FileId -> IO ()+setArtist v = setStrValue c_taglib_tag_set_artist (T.getArtist v)++-- | Set album of track associated with file.++setAlbum :: T.Album -> FileId -> IO ()+setAlbum v = setStrValue c_taglib_tag_set_album (T.getAlbum v)++-- | Set comment of track associated with file.++setComment :: T.Comment -> FileId -> IO ()+setComment v = setStrValue c_taglib_tag_set_comment (T.getComment v)++-- | Set genre of track associated with file.++setGenre :: T.Genre -> FileId -> IO ()+setGenre v = setStrValue c_taglib_tag_set_genre (T.getGenre v)++-- | Set year of track associated with file.++setYear :: Maybe T.Year -> FileId -> IO ()+setYear v = setIntValue c_taglib_tag_set_year (T.getYear <$> v)++-- | Set track number of track associated with file.++setTrackNumber :: Maybe T.TrackNumber -> FileId -> IO ()+setTrackNumber v = setIntValue c_taglib_tag_set_track (T.getTrackNumber <$> v)++-- Audio properties API++-- | Get duration of track associated with file.++getDuration :: FileId -> IO T.Duration+getDuration = fmap (fromJust . T.mkDuration)+            . getIntProperty c_taglib_properties_length++-- | Get bit rate of track associated with file.++getBitRate :: FileId -> IO T.BitRate+getBitRate = fmap (fromJust . T.mkBitRate)+           . getIntProperty c_taglib_properties_bitrate++-- | Get sample rate of track associated with file.++getSampleRate :: FileId -> IO T.SampleRate+getSampleRate = fmap (fromJust . T.mkSampleRate)+              . getIntProperty c_taglib_properties_samplerate++-- | Get number of channels in track associated with file.++getChannels :: FileId -> IO T.Channels+getChannels = fmap (fromJust . T.mkChannels)+            . getIntProperty c_taglib_properties_channels++-- Special convenience ID3v2 functions++-- | Set the default encoding for ID3v2 frames that are written to tags.++id3v2SetEncoding :: ID3v2Encoding -> IO ()+id3v2SetEncoding = c_taglib_id3v2_set_default_text_encoding . enumToCInt++-- Helpers++getStrValue+  :: (Ptr TagLibTag -> IO CString) -- ^ How to get string from the resource+  -> FileId                        -- ^ File ID+  -> IO String                     -- ^ String result+getStrValue getStr (FileId ptr) = do+  tag    <- c_taglib_file_tag ptr+  cstr   <- getStr tag+  result <- peekCString cstr+  free cstr+  return result++getIntValue+  :: Integral a+  => (Ptr TagLibTag -> IO a) -- ^ How to get value from the resource+  -> FileId                  -- ^ File ID+  -> IO Int                  -- ^ Result value+getIntValue getInt (FileId ptr) = do+  tag  <- c_taglib_file_tag ptr+  cint <- getInt tag+  return $ fromIntegral cint++setStrValue+  :: (Ptr TagLibTag -> CString -> IO ()) -- ^ Setting routine+  -> String                              -- ^ New string value+  -> FileId                              -- ^ File ID+  -> IO ()+setStrValue setStr str (FileId ptr) = do+  tag <- c_taglib_file_tag ptr+  withCString str $ \cstr ->+    setStr tag cstr++setIntValue+  :: Integral a+  => (Ptr TagLibTag -> a -> IO ()) -- ^ Setting routine+  -> Maybe Int                     -- ^ New value+  -> FileId                        -- ^ File ID+  -> IO ()+setIntValue setUInt int (FileId ptr) = do+  tag <- c_taglib_file_tag ptr+  setUInt tag $ maybe 0 fromIntegral int++getIntProperty+  :: Integral a+  => (Ptr TagLibProperties -> IO a) -- ^ How to get value from the resource+  -> FileId                         -- ^ File ID+  -> IO Int                         -- ^ Result+getIntProperty getInt (FileId ptr) = do+  properties <- c_taglib_file_properties ptr+  value      <- getInt properties+  return $ fromIntegral value++-- | Convert Haskell enumeration to C enumeration (an integer).++enumToCInt :: Enum a => a -> CInt+enumToCInt = fromIntegral . fromEnum
+ Sound/HTagLib/Setter.hs view
@@ -0,0 +1,114 @@+-- |+-- Module      :  Sound.HTagLib.Setter+-- Copyright   :  © 2015 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov@opmbx.org>+-- Stability   :  experimental+-- Portability :  portable+--+-- High-level interface for writing audio meta data. You don't need to+-- import this module directly, import "Sound.HTagLib" instead.++{-# LANGUAGE CPP #-}++module Sound.HTagLib.Setter+  ( TagSetter+  , setTags+  , setTags'+  , titleSetter+  , artistSetter+  , albumSetter+  , commentSetter+  , genreSetter+  , yearSetter+  , trackNumberSetter )+where++import Sound.HTagLib.Type+import qualified Sound.HTagLib.Internal as I++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif++-- | Composable entity that can be used together with 'setTags' or+-- 'setTags'' to write meta data to audio file.++newtype TagSetter = TagSetter { runSetter :: I.FileId -> IO () }++instance Monoid TagSetter where+  mempty  = TagSetter $ const (return ())+  x `mappend` y = TagSetter $ \fid ->+                    do runSetter x fid+                       runSetter y fid++-- | Set tags in specified file using given setter.+--+-- In case of trouble 'I.HTagLibException' will be thrown.++setTags :: FilePath              -- ^ Path to audio file+        -> Maybe I.ID3v2Encoding -- ^ Encoding for ID3v2 frames+        -> TagSetter             -- ^ Setter+        -> IO ()+setTags path enc = execSetter path enc Nothing++-- | Similar to 'setTags', but you can also specify type of audio file+-- explicitly (otherwise it's guessed from file extension).++setTags' :: FilePath              -- ^ Path to audio file+         -> Maybe I.ID3v2Encoding -- ^ Encoding for ID3v2 frames+         -> I.FileType            -- ^ Type of audio file+         -> TagSetter             -- ^ Setter+         -> IO ()+setTags' path enc t = execSetter path enc (Just t)++-- | The most general way to set meta data. 'setTags' and 'setTags'' are+-- just wrappers around this function.++execSetter :: FilePath               -- ^ Path to audio file+           -> Maybe I.ID3v2Encoding  -- ^ Encoding for ID3v2 frames+           -> Maybe I.FileType       -- ^ Type of audio file (if known)+           -> TagSetter              -- ^ Setter+           -> IO ()+execSetter path enc t s = I.withFile path t $ \fid -> do+  case enc of+    Nothing -> return ()+    Just e  -> I.id3v2SetEncoding e+  runSetter s fid+  I.saveFile path fid++-- | Setter for track title.++titleSetter :: Title -> TagSetter+titleSetter = TagSetter . I.setTitle++-- | Setter for track artist.++artistSetter :: Artist -> TagSetter+artistSetter = TagSetter . I.setArtist++-- | Setter for track album.++albumSetter :: Album -> TagSetter+albumSetter = TagSetter . I.setAlbum++-- | Setter for track comment.++commentSetter :: Comment -> TagSetter+commentSetter = TagSetter . I.setComment++-- | Setter for track genre.++genreSetter :: Genre -> TagSetter+genreSetter = TagSetter . I.setGenre++-- | Setter for year tag, use 'Nothing' to clear the field.++yearSetter :: Maybe Year -> TagSetter+yearSetter = TagSetter . I.setYear++-- | Setter for track number, use 'Nothing' to clear the field.++trackNumberSetter :: Maybe TrackNumber -> TagSetter+trackNumberSetter = TagSetter . I.setTrackNumber
+ Sound/HTagLib/Type.hs view
@@ -0,0 +1,210 @@+-- |+-- Module      :  Sound.HTagLib.Type+-- Copyright   :  © 2015 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov@opmbx.org>+-- Stability   :  experimental+-- Portability :  portable+--+-- Definitions of types used to represent various tags and audio properties.++module Sound.HTagLib.Type+  ( Title+  , mkTitle+  , getTitle+  , Artist+  , mkArtist+  , getArtist+  , Album+  , mkAlbum+  , getAlbum+  , Comment+  , mkComment+  , getComment+  , Genre+  , mkGenre+  , getGenre+  , Year+  , mkYear+  , getYear+  , TrackNumber+  , mkTrackNumber+  , getTrackNumber+  , Duration+  , mkDuration+  , getDuration+  , BitRate+  , mkBitRate+  , getBitRate+  , SampleRate+  , mkSampleRate+  , getSampleRate+  , Channels+  , mkChannels+  , getChannels )+where++import Data.String++-- | Title tag.++newtype Title = Title+  { -- | Convert 'Title' to 'String'.+    getTitle :: String }+  deriving (Show, Eq, Ord)++instance IsString Title where+  fromString = mkTitle++-- | Construction of 'Title' type, null bytes are converted to spaces.++mkTitle :: String -> Title+mkTitle = Title . avoidNulls++-- | Artist tag.++newtype Artist = Artist+  { -- | Convert 'Artist' to 'String'.+    getArtist :: String }+  deriving (Show, Eq, Ord)++instance IsString Artist where+  fromString = mkArtist++-- | Construction of 'Artist' type, null bytes are converted to spaces.++mkArtist :: String -> Artist+mkArtist = Artist . avoidNulls++-- | Album tag.++newtype Album = Album+  { -- | Convert 'Album' to 'String'.+    getAlbum :: String }+  deriving (Show, Eq, Ord)++instance IsString Album where+  fromString = mkAlbum++-- | Construction of 'Album' type, null bytes are converted to spaces.++mkAlbum :: String -> Album+mkAlbum = Album . avoidNulls++-- | Comment tag.++newtype Comment = Comment+  { -- | Convert 'Comment' to 'String'.+    getComment :: String }+  deriving (Show, Eq, Ord)++instance IsString Comment where+  fromString = mkComment++-- | Construction of 'Comment' type, null bytes are converted to spaces.++mkComment :: String -> Comment+mkComment = Comment . avoidNulls++-- | Genre tag.++newtype Genre = Genre+  { -- | Convert 'Genre' to 'String'.+    getGenre :: String }+  deriving (Show, Eq, Ord)++instance IsString Genre where+  fromString = mkGenre++-- | Construction of 'Genre' type, null bytes are converted to spaces.++mkGenre :: String -> Genre+mkGenre = Genre . avoidNulls++-- | Year tag.++newtype Year = Year+  { -- | Convert 'Year' to 'Int'.+    getYear :: Int }+  deriving (Show, Eq, Ord)++-- | Construction of 'Year' type, non-positive values result in 'Nothing'.++mkYear :: Int -> Maybe Year+mkYear = fmap Year . atLeast 1++-- | Track number tag.++newtype TrackNumber = TrackNumber+  { -- | Convert 'TrackNumber' to 'Int'.+    getTrackNumber :: Int }+  deriving (Show, Eq, Ord)++-- | Construction of 'TrackNumber' type, non-positive values result in+-- 'Nothing'.++mkTrackNumber :: Int -> Maybe TrackNumber+mkTrackNumber = fmap TrackNumber . atLeast 1++-- | Duration in seconds.++newtype Duration = Duration+  { -- | Convert 'Duration' to 'Int'.+    getDuration :: Int }+  deriving (Show, Eq, Ord)++-- | Construction of 'Duration' values, negative values result in 'Nothing'.++mkDuration :: Int -> Maybe Duration+mkDuration = fmap Duration . atLeast 0++-- | Bit rate in kb/s.++newtype BitRate = BitRate+  { -- | Convert 'BitRate' to 'Int'.+    getBitRate :: Int }+  deriving (Show, Eq, Ord)++-- | Construction of 'BitRate' values, negative values result in+-- 'Nothing'.++mkBitRate :: Int -> Maybe BitRate+mkBitRate = fmap BitRate . atLeast 0++-- | Sample rate in Hz.++newtype SampleRate = SampleRate+  { -- | Convert 'SampleRate' to 'Int'.+    getSampleRate :: Int }+  deriving (Show, Eq, Ord)++-- | Construction of 'SampleRate' values, non-positive values result in+-- 'Nothing'.++mkSampleRate :: Int -> Maybe SampleRate+mkSampleRate = fmap SampleRate . atLeast 1++-- | Number of channels in the audio stream.++newtype Channels = Channels+  { -- | Convert 'Channels' to 'Int'.+    getChannels :: Int }+  deriving (Show, Eq, Ord)++-- | Construction of 'Channels' values, non-positive values result in+-- 'Nothing'.++mkChannels :: Int -> Maybe Channels+mkChannels = fmap Channels . atLeast 1++-- | Replace null bytes with spaces.++avoidNulls :: String -> String+avoidNulls = let f x = if x == '\0' then ' ' else x in fmap f++-- | @atLeast a b@ returns @Just b@ is @b@ is greater or equal to @a@,+-- otherwise result is @Nothing@.++atLeast :: Int -> Int -> Maybe Int+atLeast a b = if b >= a then Just b else Nothing
+ htaglib.cabal view
@@ -0,0 +1,81 @@+-- -*- Mode: Haskell-Cabal; -*-+--+-- Cabal config for HTagLib.+--+-- Copyright © 2015 Mark Karpov+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+--   this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+--   notice, this list of conditions and the following disclaimer in the+--   documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+--   to endorse or promote products derived from this software without+--   specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++name:                htaglib+version:             0.1.0+cabal-version:       >= 1.10+license:             BSD3+license-file:        LICENSE.md+author:              Mark Karpov <markkarpov@opmbx.org>+maintainer:          Mark Karpov <markkarpov@opmbx.org>+homepage:            https://github.com/mrkkrp/htaglib+bug-reports:         https://github.com/mrkkrp/htaglib/issues+category:            Sound+synopsis:            Bindings to TagLib, audio meta-data library+build-type:          Simple+description:         Bindings to TagLib, audio meta-data library.+extra-source-files:  CHANGELOG.md++library+  build-depends:     base >= 4.6 && < 5+  extra-libraries:   tag_c+  exposed-modules:   Sound.HTagLib+                   , Sound.HTagLib.Type+                   , Sound.HTagLib.Getter+                   , Sound.HTagLib.Setter+                   , Sound.HTagLib.Internal+  ghc-options:       -O2 -Wall+  default-language:  Haskell2010++test-suite tests+  main-is:           Main.hs+  hs-source-dirs:    tests+  type:              exitcode-stdio-1.0+  ghc-options:       -O2 -Wall+  other-modules:     Getter+                   , Setter+                   , Util+  build-depends:     base                 >= 4.6 && < 5+                   , HUnit                >= 1.2 && < 1.4+                   , directory            >= 1.2+                   , filepath             >= 1.4 && < 2+                   , htaglib              >= 0.1.0+                   , test-framework       >= 0.6 && < 1+                   , test-framework-hunit >= 0.2 && < 0.4+  default-extensions:+                     CPP+  default-language:  Haskell2010++source-repository head+  type:              git+  location:          https://github.com/mrkkrp/htaglib
+ tests/Getter.hs view
@@ -0,0 +1,59 @@+-- -*- Mode: Haskell; -*-+--+-- HTagLib tests, testing of getters.+--+-- Copyright © 2015 Mark Karpov+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+--   this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+--   notice, this list of conditions and the following disclaimer in the+--   documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+--   to endorse or promote products derived from this software without+--   specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++module Getter (tests) where++import Test.Framework+import Test.HUnit hiding (Test, path)++import Sound.HTagLib+import Util++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (Applicative, (<$>))+#endif++tests :: Test+tests = testGroup "Getters" $+        fmap (caseWithFile simpleGetter . fst) fileList +++        fmap (caseWithFile specializedGetter) fileList++simpleGetter :: FilePath -> Assertion+simpleGetter path = do+  tags <- getTags path (id <$> sampleGetter path)+  tags @?= sampleTags path++specializedGetter :: (FilePath, FileType) -> Assertion+specializedGetter (path, t) = do+  tags <- getTags' path t (id <$> sampleGetter path)+  tags @?= sampleTags path
+ tests/Main.hs view
@@ -0,0 +1,44 @@+-- -*- Mode: Haskell; -*-+--+-- HTagLib tests, main module.+--+-- Copyright © 2015 Mark Karpov+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+--   this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+--   notice, this list of conditions and the following disclaimer in the+--   documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+--   to endorse or promote products derived from this software without+--   specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++module Main (main) where++import Test.Framework (defaultMain)++import qualified Getter+import qualified Setter++main :: IO ()+main = defaultMain+       [ Getter.tests+       , Setter.tests ]
+ tests/Setter.hs view
@@ -0,0 +1,94 @@+-- -*- Mode: Haskell; -*-+--+-- HTagLib tests, testing of Setters.+--+-- Copyright © 2015 Mark Karpov+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+--   this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+--   notice, this list of conditions and the following disclaimer in the+--   documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+--   to endorse or promote products derived from this software without+--   specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++module Setter (tests) where++import Data.Monoid+import System.Directory (getTemporaryDirectory, copyFile)+import System.FilePath ((</>), takeFileName)++import Test.Framework+import Test.HUnit hiding (Test, path)++import Sound.HTagLib+import Util++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif++tests :: Test+tests = testGroup "Setters" $+        fmap (caseWithFile simpleSetter . fst) fileList +++        fmap (caseWithFile specializedGetter) fileList++dupeFile :: FilePath -> IO FilePath+dupeFile path = do+  newPath <- (</> takeFileName path) <$> getTemporaryDirectory+  copyFile path newPath+  return newPath++sampleSetter :: TagSetter+sampleSetter =+  mempty <>+  titleSetter (mkTitle "title'") <>+  artistSetter (mkArtist "artist'") <>+  albumSetter (mkAlbum "album'") <>+  commentSetter (mkComment "comment'") <>+  genreSetter (mkGenre "genre'") <>+  yearSetter (mkYear 2056) <>+  trackNumberSetter (mkTrackNumber 8)++updateSampleTags :: AudioTags -> AudioTags+updateSampleTags tags = tags+  { atTitle = mkTitle "title'"+  , atArtist = mkArtist "artist'"+  , atAlbum = mkAlbum "album'"+  , atComment = mkComment "comment'"+  , atGenre = mkGenre "genre'"+  , atYear = mkYear 2056+  , atTrackNumber = mkTrackNumber 8 }++simpleSetter :: FilePath -> Assertion+simpleSetter path = do+  dupe <- dupeFile path+  setTags dupe Nothing $ sampleSetter+  tags <- getTags dupe (sampleGetter dupe)+  tags @?= updateSampleTags (sampleTags dupe)++specializedGetter :: (FilePath, FileType) -> Assertion+specializedGetter (path, t) = do+  dupe <- dupeFile path+  setTags' dupe Nothing t $ sampleSetter+  tags <- getTags dupe (sampleGetter dupe)+  tags @?= updateSampleTags (sampleTags dupe)
+ tests/Util.hs view
@@ -0,0 +1,106 @@+-- -*- Mode: Haskell; -*-+--+-- HTagLib tests, utility definitions.+--+-- Copyright © 2015 Mark Karpov+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are+-- met:+--+-- * Redistributions of source code must retain the above copyright notice,+--   this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+--   notice, this list of conditions and the following disclaimer in the+--   documentation and/or other materials provided with the distribution.+--+-- * Neither the name Mark Karpov nor the names of contributors may be used+--   to endorse or promote products derived from this software without+--   specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.++{-# LANGUAGE OverloadedStrings #-}++module Util+  ( AudioTags (..)+  , sampleGetter+  , sampleTags+  , fileList+  , caseWithFile )+where++import Data.Maybe (fromJust)+import Sound.HTagLib++import Test.Framework+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit hiding (Test, path)++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (<*>), pure)+#endif++data AudioTags = AudioTags+  { atFileName    :: FilePath+  , atTitle       :: Title+  , atArtist      :: Artist+  , atAlbum       :: Album+  , atComment     :: Comment+  , atGenre       :: Genre+  , atYear        :: Maybe Year+  , atTrackNumber :: Maybe TrackNumber+  , atDuration    :: Duration+  , atBitRate     :: BitRate+  , atSampleRate  :: SampleRate+  , atChannels    :: Channels }+  deriving (Show, Eq)++sampleGetter :: FilePath -> TagGetter AudioTags+sampleGetter path = AudioTags+  <$> pure path+  <*> titleGetter+  <*> artistGetter+  <*> albumGetter+  <*> commentGetter+  <*> genreGetter+  <*> yearGetter+  <*> trackNumberGetter+  <*> durationGetter+  <*> bitRateGetter+  <*> sampleRateGetter+  <*> channelsGetter++sampleTags :: FilePath -> AudioTags+sampleTags path = AudioTags+  { atFileName    = path+  , atTitle       = "title"+  , atArtist      = "artist"+  , atAlbum       = "album"+  , atComment     = "comment"+  , atGenre       = "genre"+  , atYear        = mkYear 2055+  , atTrackNumber = mkTrackNumber 7+  , atDuration    = fromJust $ mkDuration 0+  , atBitRate     = fromJust $ mkBitRate 0+  , atSampleRate  = fromJust $ mkSampleRate 44100+  , atChannels    = fromJust $ mkChannels 2 }++fileList :: [(String, FileType)]+fileList =+  [ ("audio-samples/sample.flac", FLAC)+  , ("audio-samples/sample.mp3",  MPEG) ]++caseWithFile :: Show a => (a -> Assertion) -> a -> Test+caseWithFile f param = testCase ("checking file: " ++ show param) (f param)