{-|
Description:    Methods of retreaving the actual stored data.

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

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

This module is likely what most usage of the library revolves around:
retrieving the data stored on a CD.  For more discussion of the layout, see
"Foreign.Libcdio.Sector".
-}
module Sound.Libcdio.Read.Data
    ( -- * Types
      Foreign.Lsn
    , Foreign.Whence ( .. )
    , Foreign.DiscMode ( .. )
    , Foreign.isCdRom
    , Foreign.isDvd
      -- * Info
    , discMode
    , discJolietLevel
    , lastAddress
    , lastSessionAddress
    , audioTimestamp
    , catalogue
    , isrc
      -- * Read
      -- $read-design
    , seek
    , readRaw
    , readAudio
    , readData
    , readXa
      -- * Basic counts
    , Foreign.framesPerSec
    , maxCdSectors
    , maxCdMinutes
    , defaultPregapSectors
    , defaultPostgapSectors
    ) where


import qualified Data.ByteString as BS
import qualified Data.Text as T

import qualified Foreign.Libcdio.Device as Foreign
import qualified Foreign.Libcdio.Disc as Foreign
import qualified Foreign.Libcdio.Read as Foreign
import qualified Foreign.Libcdio.Sector as Foreign
import qualified Foreign.Libcdio.Track as Foreign

import Sound.Libcdio.Device
import Sound.Libcdio.Types.Cdio


-- | Determine which type of disc is being accessed.
discMode :: Cdio (Maybe Foreign.DiscMode)
discMode :: Cdio (Maybe DiscMode)
discMode = (Cdio -> IO (Maybe DiscMode)) -> Cdio (Maybe DiscMode)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO (Maybe DiscMode)
Foreign.discMode

-- | 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 (Maybe Word)
discJolietLevel :: Cdio (Maybe Word)
discJolietLevel = (Cdio -> IO (Maybe Word)) -> Cdio (Maybe Word)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO (Maybe Word)
Foreign.discJolietLevel


-- | Get the size of a disc in blocks, or equivalently the address of the end
-- of the readable data.
lastAddress :: Cdio (Maybe Foreign.Lsn)
lastAddress :: Cdio (Maybe Lsn)
lastAddress = (Cdio -> IO (Maybe Lsn)) -> Cdio (Maybe Lsn)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO (Maybe Lsn)
Foreign.lastLsn

-- | Get the starting address of the last write session of a disc.
lastSessionAddress :: Cdio (Either DriverReturnCode Foreign.Lsn)
lastSessionAddress :: Cdio (Either DriverReturnCode Lsn)
lastSessionAddress = (Cdio -> IO (Either DriverReturnCode Lsn))
-> Cdio (Either DriverReturnCode Lsn)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO (Either DriverReturnCode Lsn)
Foreign.lastSession


-- | The number of sectors spanned by a track pre-gap by default.
defaultPregapSectors :: Word
defaultPregapSectors :: Word
defaultPregapSectors = Word
Foreign.pregapSectors

-- | The number of sectors spanned by a track post-gap by default.
defaultPostgapSectors :: Word
defaultPostgapSectors :: Word
defaultPostgapSectors = Word
Foreign.postgapSectors


-- | Print a disc timestamp in the standard "MM:SS:FF" format, assuming the
-- address refers to audio data.
audioTimestamp :: Foreign.Lsn -> T.Text
audioTimestamp :: Lsn -> Text
audioTimestamp = String -> Text
T.pack (String -> Text) -> (Lsn -> String) -> Lsn -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msf -> String
Foreign.msfToStr (Msf -> String) -> (Lsn -> Msf) -> Lsn -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lsn -> Msf
Foreign.lsnToMsf

-- | The maximum number of sectors allowed to be stored on a disc.
maxCdSectors :: Word
maxCdSectors :: Word
maxCdSectors = Word
Foreign.maxSectors

-- | The typical maximum length of a disc, though it's not a strict limit.
maxCdMinutes :: Word
maxCdMinutes :: Word
maxCdMinutes = Word
Foreign.cdMins


-- | Get the media catalog number from a disc.  This may also be retrieved
-- by @'Sound.Libcdio.Read.CdText.code' $ 'Sound.Libcdio.Read.CdText.info'
-- 'Nothing'@, though that references a different source and thus may not have
-- the same return value.
catalogue :: Cdio (Maybe T.Text)
catalogue :: Cdio (Maybe Text)
catalogue = (Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio ((Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text))
-> (Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> IO (Maybe String)
Foreign.cdMcn Cdio
c

-- | The International Standard Recording Code the given track.  This may also
-- be retrieved by @'Sound.Libcdio.Read.CdText.code' .
-- 'Sound.Libcdio.Read.CdText.info' $ 'Just' t@, though that references a
-- different source and thus may not have the same return value.
isrc :: Foreign.Track -> Cdio (Maybe T.Text)
isrc :: Track -> Cdio (Maybe Text)
isrc Track
t = (Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio ((Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text))
-> (Cdio -> IO (Maybe Text)) -> Cdio (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> IO (Maybe String) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> Track -> IO (Maybe String)
Foreign.trackIsrc Cdio
c Track
t


-- $read-design
-- For now, the library isn't able to automatically determine which @read*@
-- function should be used; refer to 'Sound.Libcdio.Track.format', and switch
-- on its return value.  For more info on the various data layouts, see the
-- intro to "Foreign.Libcdio.Sector".
--
-- Compared to the C and @Foreign@ interfaces, /all/ read functions have been
-- tweaked for better internal consistency.  Where a @cdio_read@ or
-- 'Foreign.readBytes' call would ask for the number of bytes to read, here it
-- asks for the number of /sectors/.  On the other hand, the formerly
-- sector-oriented commands operate from the current 'seek' position rather
-- than, effectively, hiding a 'seek' behind the scenes.


-- | Reposition the read pointer in the 'Cdio' session for a future call to
-- one of the @read*@ functions.
seek :: Int -> Foreign.Whence -> Cdio Foreign.Lsn
seek :: Int -> Whence -> Cdio Lsn
seek Int
o Whence
w = (Cdio -> IO (Either CdioError Lsn)) -> Cdio Lsn
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
liftCdioError ((Cdio -> IO (Either CdioError Lsn)) -> Cdio Lsn)
-> (Cdio -> IO (Either CdioError Lsn)) -> Cdio Lsn
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> do 
    Either DriverReturnCode Word
o' <- Cdio -> Int -> Whence -> IO (Either DriverReturnCode Word)
Foreign.seek Cdio
c (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
Foreign.sectorSize) Whence
w
    Either DriverReturnCode Word
pos <- case (Word -> Word -> Word) -> Word -> Word -> Word
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word -> Word -> Word
forall a. Integral a => a -> a -> a
mod Word
Foreign.sectorSize (Word -> Word)
-> Either DriverReturnCode Word -> Either DriverReturnCode Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DriverReturnCode Word
o' of
        Right Word
drift | Word
drift Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 -> Cdio -> Int -> Whence -> IO (Either DriverReturnCode Word)
Foreign.seek Cdio
c (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ Word -> Word
forall a. Num a => a -> a
negate Word
drift) Whence
Foreign.SeekCurrent
        Either DriverReturnCode Word
_ -> Either DriverReturnCode Word -> IO (Either DriverReturnCode Word)
forall (m :: * -> *) a. Monad m => a -> m a
return Either DriverReturnCode Word
o'
    Either CdioError Lsn -> IO (Either CdioError Lsn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError Lsn -> IO (Either CdioError Lsn))
-> (Either DriverReturnCode Lsn -> Either CdioError Lsn)
-> Either DriverReturnCode Lsn
-> IO (Either CdioError Lsn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either DriverReturnCode Lsn -> Either CdioError Lsn
forall a. String -> Either DriverReturnCode a -> Either CdioError a
packCdioError' String
"seek" (Either DriverReturnCode Lsn -> IO (Either CdioError Lsn))
-> Either DriverReturnCode Lsn -> IO (Either CdioError Lsn)
forall a b. (a -> b) -> a -> b
$ Word -> Lsn
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Lsn) -> (Word -> Word) -> Word -> Lsn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Word -> Word) -> Word -> Word -> Word
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word -> Word -> Word
forall a. Integral a => a -> a -> a
div Word
Foreign.sectorSize (Word -> Lsn)
-> Either DriverReturnCode Word -> Either DriverReturnCode Lsn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either DriverReturnCode Word
pos


-- | Read a given number of sectors from the disc.  With data of a known
-- structure, use 'readAudio', 'readData', or 'readXa', which /don't/ include
-- the headers and footers described in "Foreign.Libcdio.Sector".
readRaw :: Word -> Cdio BS.ByteString
readRaw :: Word -> Cdio ByteString
readRaw Word
l = (Cdio -> IO (Either CdioError ByteString)) -> Cdio ByteString
forall a. (Cdio -> IO (Either CdioError a)) -> Cdio a
liftCdioError ((Cdio -> IO (Either CdioError ByteString)) -> Cdio ByteString)
-> (Cdio -> IO (Either CdioError ByteString)) -> Cdio ByteString
forall a b. (a -> b) -> a -> b
$ \Cdio
c -> do
    Maybe ByteString
bs <- Cdio -> Word -> IO (Maybe ByteString)
Foreign.readBytes Cdio
c (Word
l Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
Foreign.sectorSize)
    Either CdioError ByteString -> IO (Either CdioError ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CdioError ByteString -> IO (Either CdioError ByteString))
-> (Either DriverReturnCode ByteString
    -> Either CdioError ByteString)
-> Either DriverReturnCode ByteString
-> IO (Either CdioError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Either DriverReturnCode ByteString
-> Either CdioError ByteString
forall a. String -> Either DriverReturnCode a -> Either CdioError a
packCdioError' String
"readAudio" (Either DriverReturnCode ByteString
 -> IO (Either CdioError ByteString))
-> Either DriverReturnCode ByteString
-> IO (Either CdioError ByteString)
forall a b. (a -> b) -> a -> b
$ Either DriverReturnCode ByteString
-> (ByteString -> Either DriverReturnCode ByteString)
-> Maybe ByteString
-> Either DriverReturnCode ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DriverReturnCode -> Either DriverReturnCode ByteString
forall a b. a -> Either a b
Left DriverReturnCode
Foreign.DriverError) ByteString -> Either DriverReturnCode ByteString
forall a b. b -> Either a b
Right Maybe ByteString
bs

-- | Read a given number of sectors stored as CD-DA from the disc.
readAudio :: Word -> Cdio BS.ByteString
readAudio :: Word -> Cdio ByteString
readAudio Word
l = Int -> Whence -> Cdio Lsn
seek Int
0 Whence
Foreign.SeekCurrent Cdio Lsn -> (Lsn -> Cdio ByteString) -> Cdio ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Cdio -> Lsn -> IO (Either CdioError ByteString))
-> Lsn -> Cdio ByteString
forall a b. (Cdio -> a -> IO (Either CdioError b)) -> a -> Cdio b
liftCdioError' (\Cdio
c Lsn
o ->
    String
-> Either DriverReturnCode ByteString
-> Either CdioError ByteString
forall a. String -> Either DriverReturnCode a -> Either CdioError a
packCdioError' String
"readAudio" (Either DriverReturnCode ByteString -> Either CdioError ByteString)
-> IO (Either DriverReturnCode ByteString)
-> IO (Either CdioError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> Lsn -> Word -> IO (Either DriverReturnCode ByteString)
Foreign.readAudioSectors Cdio
c Lsn
o Word
l)

-- | Read a given number of sectors stored as Mode 1 data from the disc.
readData
    :: Bool
        -- ^ If 'True' Form 2, otherwise Form 1 (see "Foreign.Libcdio.Sector").
    -> Word
    -> Cdio BS.ByteString
readData :: Bool -> Word -> Cdio ByteString
readData Bool
m Word
l = Int -> Whence -> Cdio Lsn
seek Int
0 Whence
Foreign.SeekCurrent Cdio Lsn -> (Lsn -> Cdio ByteString) -> Cdio ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Cdio -> Lsn -> IO (Either CdioError ByteString))
-> Lsn -> Cdio ByteString
forall a b. (Cdio -> a -> IO (Either CdioError b)) -> a -> Cdio b
liftCdioError' (\Cdio
c Lsn
o ->
    String
-> Either DriverReturnCode ByteString
-> Either CdioError ByteString
forall a. String -> Either DriverReturnCode a -> Either CdioError a
packCdioError' String
"readData" (Either DriverReturnCode ByteString -> Either CdioError ByteString)
-> IO (Either DriverReturnCode ByteString)
-> IO (Either CdioError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio
-> Lsn -> Bool -> Word -> IO (Either DriverReturnCode ByteString)
Foreign.readDataModeSectors Cdio
c Lsn
o Bool
m Word
l)

-- | Read a given number of sectors stored according to the Mode 2 extension
-- from the disc.
readXa
    :: Bool
        -- ^ If 'True' Form 2, otherwise Form 1 (see "Foreign.Libcdio.Sector").
    -> Word
    -> Cdio BS.ByteString
readXa :: Bool -> Word -> Cdio ByteString
readXa Bool
f Word
l = Int -> Whence -> Cdio Lsn
seek Int
0 Whence
Foreign.SeekCurrent Cdio Lsn -> (Lsn -> Cdio ByteString) -> Cdio ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Cdio -> Lsn -> IO (Either CdioError ByteString))
-> Lsn -> Cdio ByteString
forall a b. (Cdio -> a -> IO (Either CdioError b)) -> a -> Cdio b
liftCdioError' (\Cdio
c Lsn
o ->
    String
-> Either DriverReturnCode ByteString
-> Either CdioError ByteString
forall a. String -> Either DriverReturnCode a -> Either CdioError a
packCdioError' String
"readXA" (Either DriverReturnCode ByteString -> Either CdioError ByteString)
-> IO (Either DriverReturnCode ByteString)
-> IO (Either CdioError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio
-> Lsn -> Bool -> Word -> IO (Either DriverReturnCode ByteString)
Foreign.readXaModeSectors Cdio
c Lsn
o Bool
f Word
l)