Disc.hs

{-# LANGUAGE ForeignFunctionInterface #-}

{-|
Description:    The top-level header for disc-related libcdio calls.

Copyright:      (c) 2018-2021 Sam May
License:        GPL-3.0-or-later
Maintainer:     ag@eitilt.life

Stability:      stable
Portability:    non-portable (requires libcdio)

This module provides informational and metadata functions primarily related to
the layout of data on a physical disc.  While both "Foreign.Libcdio.Read" and
"Foreign.Libcdio.CdText" provide more exciting access to the actual data, this
still provides a critical intermediate step between those and the physical
hardware of "Foreign.Libcdio.Device".


= @disc.h@

== Types
* @discmode_t@                      -> 'DiscMode'

    - @CDIO_DISC_MODE_CD_DA@        -> 'AudioCdMode'
    - @CDIO_DISC_MODE_CD_DATA@      -> 'DataCdMode'
    - @CDIO_DISC_MODE_CD_XA@        -> 'XaCdMode'
    - @CDIO_DISC_MODE_CD_MIXED@     -> 'MixedCdMode'
    - @CDIO_DISC_MODE_DVD_ROM@      -> 'DvdRomMode'
    - @CDIO_DISC_MODE_DVD_RAM@      -> 'DvdRamMode'
    - @CDIO_DISC_MODE_DVD_R@        -> 'DvdRecordableMode'
    - @CDIO_DISC_MODE_DVD_RW@       -> 'DvdReWritableMode'
    - @CDIO_DISC_MODE_HD_DVD_ROM@   -> 'HighDefinitionDvdRomMode'
    - @CDIO_DISC_MODE_HD_DVD_RAM@   -> 'HighDefinitionDvdRamMode'
    - @CDIO_DISC_MODE_HD_DVD_R@     -> 'HighDefinitionDvdRecordableMode'
    - @CDIO_DISC_MODE_DVD_PR@       -> 'DvdPlusRecordableMode'
    - @CDIO_DISC_MODE_DVD_PRW@      -> 'DvdPlusReWritableMode'
    - @CDIO_DISC_MODE_DVD_PR_DL@    -> 'DoubleLayerDvdPlusRecordableMode'
    - @CDIO_DISC_MODE_DVD_PRW_DL@   -> 'DoubleLayerDvdPlusReWritableMode'
    - @CDIO_DISC_MODE_DVD_OTHER@    -> 'OtherDvdMode'
    - @CDIO_DISC_MODE_NO_INFO@      -> 'NoModeInfo'
    - @CDIO_DISC_MODE_CD_I@         -> 'CdIMode'
    - @CDIO_DISC_MODE_ERROR@        (removed; handled via 'Nothing')

== Symbols
* @cdio_get_cdtext@                 (removed; merged into 'Cdio' objects due to pointer lifespan issues)
* @cdio_get_cdtext_raw@             -> 'cdTextRaw'
* @cdio_get_disc_last_lsn@          -> 'lastLsn'
* @cdio_get_discmode@               -> 'discMode'
* @cdio_get_joliet_level@           -> 'discJolietLevel'
* @cdio_get_mcn@                    -> 'cdMcn'
* @cdio_get_num_tracks@             -> 'numTracks'
* @cdio_is_discmode_cdrom@          -> 'isCdRom'
* @cdio_is_discmode_dvd@            -> 'isDvd'
* @discmode2str@                    -> 'discModeString'


= "Sound.Libcdio.Read.Data"

* @cdio_get_cdtext@                 -> @"Sound.Libcdio.Read.CdText".'Sound.Libcdio.Read.Data.cdText'@
* 'cdMcn'                           -> 'Sound.Libcdio.Read.Data.catalogue'
* 'cdTextRaw'                       -> @"Sound.Libcdio.Read.CdText".'Sound.Libcdio.Read.Data.cdTextRaw'@
* 'lastLsn'                         -> 'Sound.Libcdio.Read.Data.lastAddress'
* 'mcnLength'                       (removed; unnecessary low-level detail)
* 'numTracks'                       -> @"Sound.Libcdio.Track".'Sound.Libcdio.Track.tracks'@
-}
module Foreign.Libcdio.Disc
    ( -- * Types
      DiscMode ( .. )
    , discModeString
    , isCdRom, isDvd
      -- * Data
    , discMode
    , numTracks
    , lastLsn
    , discJolietLevel
    , hasCdText
    , cdTextRaw
    , cdMcn
    , mcnLength
    ) where


import qualified Control.Monad as N

import qualified Data.ByteString as BS
import qualified Data.Maybe as Y
import qualified Data.Word as W

import qualified Foreign.C.String as C
import qualified Foreign.C.Types as C
import qualified Foreign.Ptr as C

import qualified Foreign.Marshal.Alloc as M
import qualified Foreign.Marshal.Utils as M
import qualified Foreign.Storable as S

import qualified System.IO.Unsafe as IO.Unsafe

import Foreign.Libcdio.CdText
import Foreign.Libcdio.CdText.Binary
import Foreign.Libcdio.Marshal
import Foreign.Libcdio.Track
import Foreign.Libcdio.Types.Enums
import Foreign.Libcdio.Types.Internal


-- | Filter out @CDIO_DISC_MODE_ERROR@ values to fit the 'Enum'.
invalidDiscMode :: CDiscMode -> Maybe DiscMode
invalidDiscMode = fmap (toEnum . fromIntegral) . maybeError [invalidDiscMode']

foreign import ccall safe "cdio/compat/disc.h discmode_error"
  invalidDiscMode' :: CDiscMode


-- | Describe a type a disc according to its official name, as opposed to the
-- machine representation returned by the 'Show' instance.
discModeString :: DiscMode -> String
discModeString = IO.Unsafe.unsafePerformIO .
    C.peekCString . discModeString' . fromIntegral . fromEnum

foreign import ccall safe "cdio/compat/disc.h discmode_string"
  discModeString' :: CDiscMode -> C.CString


-- | Get the raw CD-Text binary data contained on a disc.
cdTextRaw :: Cdio -> IO (Maybe BS.ByteString)
cdTextRaw c = withCdTextBlob c cdTextRaw' >>= maybe (serialize c) (return . Just)

foreign import ccall safe "cdio/compat/disc.h get_cdtext_raw_len"
  cdTextRaw' :: C.Ptr Cdio -> C.Ptr (C.Ptr C.CChar) -> C.Ptr C.CInt -> IO ()

-- | Allocate a dummy pointer to have somewhere to store the return value.
withCdTextBlob :: Cdio -> (C.Ptr Cdio -> C.Ptr (C.Ptr C.CChar) -> C.Ptr C.CInt -> IO ()) -> IO (Maybe BS.ByteString)
withCdTextBlob c f = M.alloca $ \p' -> M.alloca $ \i' -> do
    y <- withCdio c $ \c' -> f c' p' i'
    if Y.isNothing y
    then return Nothing
    else do
        p <- S.peek p'
        i <- S.peek i'
        if p == C.nullPtr
        then return Nothing
        else do
            bs <- BS.packCStringLen (C.plusPtr p 4, fromIntegral i)
            M.free p
            return $ Just bs

-- | If the @cdio_get_cdtext_raw@ call fails to provide a valid
-- 'BS.ByteString', but we can access the stringified CDTEXT, generate one
-- ourselves.  This is necessary as, if the CDTEXT wasn't binary to begin with
-- (i.e. in an image file), libcdio is a bit lazy and doesn't return anything.
serialize :: Cdio -> IO (Maybe BS.ByteString)
serialize x = do
    ls <- listAllLanguages x
    ps <- N.forM [0 .. fromIntegral (length ls) - 1] $ \i -> do
        b <- selectLanguageIndex x i
        if b then serializeLanguage x i else return (0, [])
    let (ss, bss) = unzip ps
    return $ case map checksum $ concatMap (joinBlockInfo ls ss) bss of
        [] -> Nothing
        bs -> Just $ BS.concat bs

-- | Retrieve all data from the current CDTEXT block and render it to the pack
-- format used by the binary representation.  For convenience, the highest
-- sequence number used by this block is also returned.
serializeLanguage :: Cdio -> Word -> IO (W.Word8, [BS.ByteString])
serializeLanguage x i = do
    t1 <- Y.fromMaybe 1 <$> firstTrack x
    tl <- Y.fromMaybe 0 <$> lastTrack x
    di <- serializeInfo x Nothing
    tis <- mapM (serializeInfo x . Just) [t1..tl]
    c <- cdTextGet x DiscId Nothing
    g <- genre x
    gs <- cdTextGet x GenreName Nothing
    let ps = packCdTextBlock i c t1 g gs di tis
    return (fromIntegral . max 0 $ length ps - 1, ps)

-- | Retrieve all text packs defined in the current block for the given track,
-- and pack them into an easy-to-pass-around datatype.
serializeInfo :: Cdio -> Maybe Track -> IO Info
serializeInfo x t = do
    n <- cdTextGet x Title t
    p <- cdTextGet x Performer t
    s <- cdTextGet x Songwriter t
    c <- cdTextGet x Composer t
    a <- cdTextGet x Arranger t
    m <- cdTextGet x Message t
    o <- cdTextGet x (if Y.isNothing t then UpcEan else Isrc) t
    return $ Info n p s c a m o


-- | Determine which type of disc is being accessed.  Note that while this
-- provides a general direction, it shouldn't be relied upon for actual reading
-- of data; use 'Foreign.Libcdio.Track.trackFormat' for more granular info.
discMode :: Cdio -> IO (Maybe DiscMode)
discMode c = (>>= invalidDiscMode) <$> withCdio c discMode'

foreign import ccall safe "cdio/compat/disc.h cdio_get_discmode"
  discMode' :: C.Ptr Cdio -> IO CDiscMode


-- | Get the size of a disc in blocks, or equivalently the address of the end
-- of the readable data.
lastLsn :: Cdio -> IO (Maybe Lsn)
lastLsn c = (>>= invalidZeroLsn) <$> withCdio c lastLsn'

foreign import ccall safe "cdio/compat/disc.h cdio_get_disc_last_lsn"
  lastLsn' :: C.Ptr Cdio -> IO C.CInt


-- | The original ISO 9660 (data) filesystem specification was rather
-- restrictive in what files could be named; the Joliet extensions allow such
-- exciting features as lowercase letters, not to mention full Unicode support.
discJolietLevel :: Cdio -> IO (Maybe Word)
discJolietLevel c = (>>= maybeError [0] . fromIntegral) <$> withCdio c discJolietLevel'

foreign import ccall safe "cdio/compat/disc.h cdio_get_joliet_level"
  discJolietLevel' :: C.Ptr Cdio -> IO C.CUChar


-- | Get the media catalog number from a disc.  This may also be retrieved
-- by @'Foreign.Libcdio.CdText.getField' 'Foreign.Libcdio.CdText.UpcEan'
-- 'Nothing'@, though that references a different source and thus may not have
-- the same return value.
cdMcn :: Cdio -> IO (Maybe String)
cdMcn c = withCdio c cdMcn' >>= maybe (return Nothing) (M.maybePeek peekFString)

foreign import ccall safe "cdio/compat/disc.h cdio_get_mcn"
  cdMcn' :: C.Ptr Cdio -> IO C.CString


-- | Get the number of tracks on a CD.
-- 
-- Returns 'Nothing' if the 'Cdio' object has already been closed, or if the
-- disc table of contents can't be read.
numTracks :: Cdio -> IO (Maybe Track)
numTracks c = (>>= invalidTrack) <$> withCdio c numTracks'

foreign import ccall safe "cdio/compat/disc.h cdio_get_num_tracks"
  numTracks' :: C.Ptr Cdio -> IO C.CUChar


-- | Return true if a 'DiscMode' refers to some sort of CD.
isCdRom :: DiscMode -> Bool
isCdRom = M.toBool . isCdRom' . fromIntegral . fromEnum

foreign import ccall safe "cdio/compat/disc.h cdio_is_discmode_cdrom"
  isCdRom' :: CDiscMode -> C.CUChar

-- | Return true if a 'DiscMode' refers to some sort of DVD.
isDvd :: DiscMode -> Bool
isDvd = M.toBool . isDvd' . fromIntegral . fromEnum

foreign import ccall safe "cdio/compat/disc.h cdio_is_discmode_dvd"
  isDvd' :: CDiscMode -> C.CUChar