-----------------------------------------------------------------------------
--
-- Module      :  Sound.MusicBrainz.DiscId
-- Copyright   :  2013 André Twupack
-- License     :  GNU LESSER GENERAL PUBLIC LICENSE Version 3
--
-- This library is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public License
-- along with this library.  If not, see <http://www.gnu.org/licenses/>.

-- Maintainer  :  André Twupack
-- Stability   :
-- Portability :
--
-- |
-----------------------------------------------------------------------------

{-# LANGUAGE ForeignFunctionInterface #-}

module Sound.MusicBrainz.DiscId (
    getVersionString,
    getDefaultDevice,
    readFromDefaultCd,
    readFromCd,
    hasFeature,
    getFeatureList,
    DiscIdFeature(..),
    DiscId(..),
    TOC(..),
    Track(..)
) where

import Foreign.C
import Foreign.Ptr (Ptr, nullPtr)
import Data.Map (Map, fromList)
import Control.Monad (mapM)
import Control.Applicative ((<$>))
import qualified Data.Vector.Storable.Mutable as M
import System.IO.Unsafe (unsafePerformIO)

-- | The information for a disc
data DiscId = DiscId {
    -- | MusicBrainz DiscID
    mbId :: String,
    -- | FreeDB DiscID
    freedbId :: String,
    -- | URL for submitting the DiscID to MusicBrainz
    submissionUrl :: String,
    -- | URL for retrieving CD information from MusicBrainz' web service
    webserviceUrl :: String,
    -- | The length of the disc in sectors
    sectors :: Int,
    -- | The TOC of the disc
    toc :: TOC,
    -- | The Media Catalogue Number for the disc
    mcn :: String} deriving Show

-- | The TOC of a disc
data TOC = TOC {
    -- | The number of the first track on this disc
    firstTrackNum :: Int,
    -- | The number of the last track on this disc
    lastTrackNum :: Int,
    -- | The tracks on the disc
    tracks :: Map Int Track} deriving Show

-- | The information for a track
data Track = Track {
    -- | The track number
    num :: Int,
    -- | The sector offset of a track
    offset :: Int,
    -- | The length of a track in sectors
    length :: Int,
    -- | The ISRC for a track
    isrc :: String} deriving Show

type DiscIdHandle = Ptr ()

foreign import ccall unsafe discid_get_version_string :: IO CString
foreign import ccall unsafe discid_get_default_device :: IO CString
foreign import ccall unsafe discid_new :: IO DiscIdHandle
foreign import ccall unsafe discid_free :: DiscIdHandle -> IO ()
foreign import ccall unsafe discid_get_error_msg :: DiscIdHandle -> IO CString
foreign import ccall unsafe discid_get_freedb_id :: DiscIdHandle -> IO CString
foreign import ccall unsafe discid_get_id :: DiscIdHandle -> IO CString
foreign import ccall unsafe discid_read :: DiscIdHandle -> CString -> IO CInt
foreign import ccall unsafe discid_get_first_track_num :: DiscIdHandle -> IO CInt
foreign import ccall unsafe discid_get_last_track_num :: DiscIdHandle -> IO CInt
foreign import ccall unsafe discid_get_submission_url :: DiscIdHandle -> IO CString
foreign import ccall unsafe discid_get_webservice_url :: DiscIdHandle -> IO CString
foreign import ccall unsafe discid_get_sectors :: DiscIdHandle -> IO CInt
foreign import ccall unsafe discid_get_track_length :: DiscIdHandle -> CInt -> IO CInt
foreign import ccall unsafe discid_get_track_offset :: DiscIdHandle -> CInt -> IO CInt
foreign import ccall unsafe discid_get_mcn :: DiscIdHandle -> IO CString
foreign import ccall unsafe discid_get_track_isrc :: DiscIdHandle -> CInt -> IO CString
foreign import ccall unsafe discid_has_feature :: CInt -> CInt
foreign import ccall unsafe discid_get_feature_list :: Ptr CString -> IO ()

-- | Features procided by libdiscid
data DiscIdFeature
    -- | Read disc TOC and calculate IDs
    = Read
    -- | Get Media Catalogue Number
    | MCN
    -- | Get ISRC
    | ISRC
    -- | Unknown feature
    | Unknown deriving Show

-- | A list of features supported by the current platform
getFeatureList :: [DiscIdFeature]
getFeatureList = unsafePerformIO $ do
    arr <- M.new 32
    M.unsafeWith arr discid_get_feature_list
    cp <- mapM (M.read arr) [0..31]
    fs <- mapM peekCString (takeWhile (/=nullPtr) cp)
    return $ toFeature <$> fs

toFeature :: String -> DiscIdFeature
toFeature s
    | s == "read" = Read
    | s == "isrc" = ISRC
    | s == "mcn" = MCN
    | otherwise = Unknown

toBool :: CInt -> Bool
toBool ib
    | ib == 0 = False
    | otherwise = True

-- | Check if a certain feature is implemented on the current platform
hasFeature :: DiscIdFeature -> Bool
hasFeature Read =  toBool $ discid_has_feature 1
hasFeature MCN =  toBool $ discid_has_feature 2
hasFeature ISRC =  toBool $ discid_has_feature 4

-- | Return the full version string of this library, including the name.
getVersionString :: String -- ^ a string containing the version of libdiscid.
getVersionString = unsafePerformIO $ discid_get_version_string >>= peekCString

-- | Return the name of the default disc drive for this operating system.
getDefaultDevice :: String -- ^ a string containing an operating system dependent device identifier
getDefaultDevice = unsafePerformIO $ discid_get_default_device >>= peekCString

-- | Read the disc in the default CD-ROM/DVD-ROM drive.
readFromDefaultCd :: IO (Either String DiscId)
readFromDefaultCd = readFromCd getDefaultDevice

-- | Read the disc in the given CD-ROM/DVD-ROM drive.
readFromCd :: String -> IO (Either String DiscId)
readFromCd dev = do
    handle <- discid_new
    result <- withCString dev $ \devC -> discid_read handle devC
    discId <- createDiscId handle result
    discid_free handle
    return discId

createDiscId :: DiscIdHandle -> CInt -> IO (Either String DiscId)
createDiscId handle result
    | result == 0 = do
        error <- discid_get_error_msg handle >>= peekCString
        return $ Left error
    | otherwise = do
        mbId <- discid_get_id handle >>= peekCString
        freedbId <- discid_get_freedb_id handle >>= peekCString
        submUrl <- discid_get_submission_url handle >>= peekCString
        websUrl <- discid_get_webservice_url handle >>= peekCString
        sectors <- fromIntegral <$> discid_get_sectors handle
        toc <- createTOC handle
        mcn <- discid_get_mcn handle >>= peekCString
        return $ Right (DiscId mbId freedbId submUrl websUrl sectors toc mcn)


createTrack :: DiscIdHandle -> CInt -> IO (Int, Track)
createTrack handle num = do
    length <- fromIntegral <$> discid_get_track_length handle num
    offset <- fromIntegral <$> discid_get_track_offset handle num
    isrc <- discid_get_track_isrc handle num >>= peekCString
    return (fromIntegral num, Track (fromIntegral num) offset length isrc)

createTOC :: DiscIdHandle -> IO TOC
createTOC handle = do
    first <- discid_get_first_track_num handle
    last <- discid_get_last_track_num handle
    tracks <- mapM (createTrack handle) [first..last]
    return $ TOC (fromIntegral first) (fromIntegral last) (fromList tracks)