module Audio.TagLib.Internal where
import Control.Monad.State
import Control.Applicative
import Data.Typeable (Typeable())
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..),CChar(..))
import Foreign.Ptr (Ptr)
import qualified Control.Exception as E
import qualified Data.Map as M
newtype TagLib a = TagLib { unTagLib :: StateT TagLibEnv IO a }
instance Functor TagLib where
fmap f (TagLib m) = TagLib $ fmap f m
instance Monad TagLib where
return = TagLib . return
(TagLib m) >>= f = TagLib $ m >>= unTagLib . f
instance Applicative TagLib where
pure = return
(<*>) = ap
data TagLibFile = TagLibFile
{ filePtr :: Ptr File
, tagPtr :: Ptr Tag
, audioPropPtr :: Ptr AudioProperties
}
newtype FileId = FileId Integer deriving (Eq,Ord)
data File
data Tag
data AudioProperties
data TagLibEnv = TagLibEnv
{ taglibFilesOpen :: M.Map FileId TagLibFile
, taglibNextId :: Integer
}
initialEnv :: TagLibEnv
initialEnv = TagLibEnv M.empty 0
onFilesOpen :: (M.Map FileId TagLibFile -> M.Map FileId TagLibFile)
-> TagLibEnv -> TagLibEnv
onFilesOpen f e = e { taglibFilesOpen = f $ taglibFilesOpen e }
onNextId :: (Integer -> Integer)
-> TagLibEnv -> TagLibEnv
onNextId f e = e { taglibNextId = f $ taglibNextId e }
data TagLibException
= NoSuchFileId
| InvalidFile FilePath
| UnableToOpen FilePath
| FileClosed
deriving (Show, Typeable)
instance E.Exception TagLibException
addNewFile :: FileId -> TagLibFile -> TagLib ()
addNewFile fid f = TagLib $ modify $ onFilesOpen $ M.insert fid f
nextId :: TagLib FileId
nextId = do
i <- fromEnv taglibNextId
TagLib $ modify $ onNextId (+1)
return $ FileId i
openFilePtrs :: TagLib [Ptr File]
openFilePtrs = fromEnv $ map filePtr . M.elems . taglibFilesOpen
fromEnv :: (TagLibEnv -> a) -> TagLib a
fromEnv f = TagLib $ gets f
fromFile :: (TagLibFile -> a) -> FileId -> TagLib a
fromFile acc fid = do
mf <- M.lookup fid <$> fromEnv taglibFilesOpen
case mf of
Just f -> return (acc f)
Nothing -> io $ E.throw NoSuchFileId
io :: IO a -> TagLib a
io m = TagLib $ StateT $ \e -> (,) <$> m <*> pure e
foreign import ccall "taglib_file_new"
c_taglib_file_new :: CString -> IO (Ptr File)
foreign import ccall "taglib_file_free"
c_taglib_file_free :: Ptr File -> IO ()
foreign import ccall "taglib_file_save"
c_taglib_file_save :: Ptr File -> IO ()
foreign import ccall "taglib_file_is_valid"
c_taglib_file_is_valid :: Ptr File -> IO CInt
foreign import ccall "taglib_file_tag"
c_taglib_file_tag :: Ptr File -> IO (Ptr Tag)
foreign import ccall "taglib_file_audioproperties"
c_taglib_file_audioproperties :: Ptr File -> IO (Ptr AudioProperties)
foreign import ccall "taglib_tag_free_strings"
c_taglib_free_strings :: IO ()
freeTagLibStrings :: IO ()
freeTagLibStrings = c_taglib_free_strings
removeFile :: FileId -> TagLib ()
removeFile fid = TagLib $ modify $ onFilesOpen $ M.delete fid
runTagLib :: TagLibEnv -> TagLib a -> IO (a,TagLibEnv)
runTagLib env m = runStateT (unTagLib m) env
evalTagLib :: TagLibEnv -> TagLib a -> IO a
evalTagLib env = fmap fst . runTagLib env
closeFile :: FileId -> TagLib ()
closeFile fid = do
fptr <- fromFile filePtr fid
removeFile fid
io $ cleanupFile fptr
cleanupFile :: Ptr File -> IO ()
cleanupFile f = do
c_taglib_file_save f
c_taglib_file_free f