{-# LANGUAGE ForeignFunctionInterface #-}
module Foreign.Libcdio.Disc
(
DiscMode ( .. )
, discModeString
, isCdRom, isDvd
, 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
invalidDiscMode :: CDiscMode -> Maybe DiscMode
invalidDiscMode :: CDiscMode -> Maybe DiscMode
invalidDiscMode = (CDiscMode -> DiscMode) -> Maybe CDiscMode -> Maybe DiscMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> DiscMode
forall a. Enum a => Int -> a
toEnum (Int -> DiscMode) -> (CDiscMode -> Int) -> CDiscMode -> DiscMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDiscMode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Maybe CDiscMode -> Maybe DiscMode)
-> (CDiscMode -> Maybe CDiscMode) -> CDiscMode -> Maybe DiscMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CDiscMode] -> CDiscMode -> Maybe CDiscMode
forall a. Eq a => [a] -> a -> Maybe a
maybeError [CDiscMode
invalidDiscMode']
foreign import ccall safe "cdio/compat/disc.h discmode_error"
invalidDiscMode' :: CDiscMode
discModeString :: DiscMode -> String
discModeString :: DiscMode -> String
discModeString = IO String -> String
forall a. IO a -> a
IO.Unsafe.unsafePerformIO (IO String -> String)
-> (DiscMode -> IO String) -> DiscMode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CString -> IO String
C.peekCString (CString -> IO String)
-> (DiscMode -> CString) -> DiscMode -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDiscMode -> CString
discModeString' (CDiscMode -> CString)
-> (DiscMode -> CDiscMode) -> DiscMode -> CString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CDiscMode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDiscMode) -> (DiscMode -> Int) -> DiscMode -> CDiscMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscMode -> Int
forall a. Enum a => a -> Int
fromEnum
foreign import ccall safe "cdio/compat/disc.h discmode_string"
discModeString' :: CDiscMode -> C.CString
cdTextRaw :: Cdio -> IO (Maybe BS.ByteString)
Cdio
c = Cdio
-> (Ptr Cdio -> Ptr CString -> Ptr CDiscMode -> IO ())
-> IO (Maybe ByteString)
withCdTextBlob Cdio
c Ptr Cdio -> Ptr CString -> Ptr CDiscMode -> IO ()
cdTextRaw' IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ByteString)
-> (ByteString -> IO (Maybe ByteString))
-> Maybe ByteString
-> IO (Maybe ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Cdio -> IO (Maybe ByteString)
serialize Cdio
c) (Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> IO (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just)
foreign import ccall safe "cdio/compat/disc.h get_cdtext_raw_len"
:: C.Ptr Cdio -> C.Ptr (C.Ptr C.CChar) -> C.Ptr C.CInt -> IO ()
withCdTextBlob :: Cdio -> (C.Ptr Cdio -> C.Ptr (C.Ptr C.CChar) -> C.Ptr C.CInt -> IO ()) -> IO (Maybe BS.ByteString)
withCdTextBlob :: Cdio
-> (Ptr Cdio -> Ptr CString -> Ptr CDiscMode -> IO ())
-> IO (Maybe ByteString)
withCdTextBlob Cdio
c Ptr Cdio -> Ptr CString -> Ptr CDiscMode -> IO ()
f = (Ptr CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
p' -> (Ptr CDiscMode -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CDiscMode -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CDiscMode -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CDiscMode
i' -> do
Maybe ()
y <- Cdio -> (Ptr Cdio -> IO ()) -> IO (Maybe ())
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c ((Ptr Cdio -> IO ()) -> IO (Maybe ()))
-> (Ptr Cdio -> IO ()) -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ \Ptr Cdio
c' -> Ptr Cdio -> Ptr CString -> Ptr CDiscMode -> IO ()
f Ptr Cdio
c' Ptr CString
p' Ptr CDiscMode
i'
if Maybe () -> Bool
forall a. Maybe a -> Bool
Y.isNothing Maybe ()
y
then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
else do
CString
p <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CString
p'
CDiscMode
i <- Ptr CDiscMode -> IO CDiscMode
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CDiscMode
i'
if CString
p CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
C.nullPtr
then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
else do
ByteString
bs <- CStringLen -> IO ByteString
BS.packCStringLen (CString -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
C.plusPtr CString
p Int
4, CDiscMode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CDiscMode
i)
CString -> IO ()
forall a. Ptr a -> IO ()
M.free CString
p
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
serialize :: Cdio -> IO (Maybe BS.ByteString)
serialize :: Cdio -> IO (Maybe ByteString)
serialize Cdio
x = do
[Maybe Language]
ls <- Cdio -> IO [Maybe Language]
listAllLanguages Cdio
x
[(Word8, [ByteString])]
ps <- [Word]
-> (Word -> IO (Word8, [ByteString])) -> IO [(Word8, [ByteString])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
N.forM [Word
0 .. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Maybe Language] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe Language]
ls) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1] ((Word -> IO (Word8, [ByteString])) -> IO [(Word8, [ByteString])])
-> (Word -> IO (Word8, [ByteString])) -> IO [(Word8, [ByteString])]
forall a b. (a -> b) -> a -> b
$ \Word
i -> do
Bool
b <- Cdio -> Word -> IO Bool
selectLanguageIndex Cdio
x Word
i
if Bool
b then Cdio -> Word -> IO (Word8, [ByteString])
serializeLanguage Cdio
x Word
i else (Word8, [ByteString]) -> IO (Word8, [ByteString])
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
0, [])
let ([Word8]
ss, [[ByteString]]
bss) = [(Word8, [ByteString])] -> ([Word8], [[ByteString]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Word8, [ByteString])]
ps
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ case (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
checksum ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ([ByteString] -> [ByteString]) -> [[ByteString]] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Maybe Language] -> [Word8] -> [ByteString] -> [ByteString]
joinBlockInfo [Maybe Language]
ls [Word8]
ss) [[ByteString]]
bss of
[] -> Maybe ByteString
forall a. Maybe a
Nothing
[ByteString]
bs -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat [ByteString]
bs
serializeLanguage :: Cdio -> Word -> IO (W.Word8, [BS.ByteString])
serializeLanguage :: Cdio -> Word -> IO (Word8, [ByteString])
serializeLanguage Cdio
x Word
i = do
Track
t1 <- Track -> Maybe Track -> Track
forall a. a -> Maybe a -> a
Y.fromMaybe Track
1 (Maybe Track -> Track) -> IO (Maybe Track) -> IO Track
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> IO (Maybe Track)
firstTrack Cdio
x
Track
tl <- Track -> Maybe Track -> Track
forall a. a -> Maybe a -> a
Y.fromMaybe Track
0 (Maybe Track -> Track) -> IO (Maybe Track) -> IO Track
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> IO (Maybe Track)
lastTrack Cdio
x
Info
di <- Cdio -> Maybe Track -> IO Info
serializeInfo Cdio
x Maybe Track
forall a. Maybe a
Nothing
[Info]
tis <- (Track -> IO Info) -> [Track] -> IO [Info]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Cdio -> Maybe Track -> IO Info
serializeInfo Cdio
x (Maybe Track -> IO Info)
-> (Track -> Maybe Track) -> Track -> IO Info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Track -> Maybe Track
forall a. a -> Maybe a
Just) [Track
t1..Track
tl]
Maybe String
c <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x Field
DiscId Maybe Track
forall a. Maybe a
Nothing
Maybe Genre
g <- Cdio -> IO (Maybe Genre)
genre Cdio
x
Maybe String
gs <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x Field
GenreName Maybe Track
forall a. Maybe a
Nothing
let ps :: [ByteString]
ps = Word
-> Maybe String
-> Track
-> Maybe Genre
-> Maybe String
-> Info
-> [Info]
-> [ByteString]
packCdTextBlock Word
i Maybe String
c Track
t1 Maybe Genre
g Maybe String
gs Info
di [Info]
tis
(Word8, [ByteString]) -> IO (Word8, [ByteString])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Int -> Int) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, [ByteString]
ps)
serializeInfo :: Cdio -> Maybe Track -> IO Info
serializeInfo :: Cdio -> Maybe Track -> IO Info
serializeInfo Cdio
x Maybe Track
t = do
Maybe String
n <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x Field
Title Maybe Track
t
Maybe String
p <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x Field
Performer Maybe Track
t
Maybe String
s <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x Field
Songwriter Maybe Track
t
Maybe String
c <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x Field
Composer Maybe Track
t
Maybe String
a <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x Field
Arranger Maybe Track
t
Maybe String
m <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x Field
Message Maybe Track
t
Maybe String
o <- Cdio -> Field -> Maybe Track -> IO (Maybe String)
cdTextGet Cdio
x (if Maybe Track -> Bool
forall a. Maybe a -> Bool
Y.isNothing Maybe Track
t then Field
UpcEan else Field
Isrc) Maybe Track
t
Info -> IO Info
forall (m :: * -> *) a. Monad m => a -> m a
return (Info -> IO Info) -> Info -> IO Info
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Info
Info Maybe String
n Maybe String
p Maybe String
s Maybe String
c Maybe String
a Maybe String
m Maybe String
o
discMode :: Cdio -> IO (Maybe DiscMode)
discMode :: Cdio -> IO (Maybe DiscMode)
discMode Cdio
c = (Maybe CDiscMode -> (CDiscMode -> Maybe DiscMode) -> Maybe DiscMode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CDiscMode -> Maybe DiscMode
invalidDiscMode) (Maybe CDiscMode -> Maybe DiscMode)
-> IO (Maybe CDiscMode) -> IO (Maybe DiscMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> (Ptr Cdio -> IO CDiscMode) -> IO (Maybe CDiscMode)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c Ptr Cdio -> IO CDiscMode
discMode'
foreign import ccall safe "cdio/compat/disc.h cdio_get_discmode"
discMode' :: C.Ptr Cdio -> IO CDiscMode
lastLsn :: Cdio -> IO (Maybe Lsn)
lastLsn :: Cdio -> IO (Maybe Lsn)
lastLsn Cdio
c = (Maybe CDiscMode -> (CDiscMode -> Maybe Lsn) -> Maybe Lsn
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CDiscMode -> Maybe Lsn
invalidZeroLsn) (Maybe CDiscMode -> Maybe Lsn)
-> IO (Maybe CDiscMode) -> IO (Maybe Lsn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> (Ptr Cdio -> IO CDiscMode) -> IO (Maybe CDiscMode)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c Ptr Cdio -> IO CDiscMode
lastLsn'
foreign import ccall safe "cdio/compat/disc.h cdio_get_disc_last_lsn"
lastLsn' :: C.Ptr Cdio -> IO C.CInt
discJolietLevel :: Cdio -> IO (Maybe Word)
discJolietLevel :: Cdio -> IO (Maybe Word)
discJolietLevel Cdio
c = (Maybe CUChar -> (CUChar -> Maybe Word) -> Maybe Word
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Word] -> Word -> Maybe Word
forall a. Eq a => [a] -> a -> Maybe a
maybeError [Word
0] (Word -> Maybe Word) -> (CUChar -> Word) -> CUChar -> Maybe Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Maybe CUChar -> Maybe Word)
-> IO (Maybe CUChar) -> IO (Maybe Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> (Ptr Cdio -> IO CUChar) -> IO (Maybe CUChar)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c Ptr Cdio -> IO CUChar
discJolietLevel'
foreign import ccall safe "cdio/compat/disc.h cdio_get_joliet_level"
discJolietLevel' :: C.Ptr Cdio -> IO C.CUChar
cdMcn :: Cdio -> IO (Maybe String)
cdMcn :: Cdio -> IO (Maybe String)
cdMcn Cdio
c = Cdio -> (Ptr Cdio -> IO CString) -> IO (Maybe CString)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c Ptr Cdio -> IO CString
cdMcn' IO (Maybe CString)
-> (Maybe CString -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe String)
-> (CString -> IO (Maybe String))
-> Maybe CString
-> IO (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing) ((CString -> IO String) -> CString -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek CString -> IO String
peekFString)
foreign import ccall safe "cdio/compat/disc.h cdio_get_mcn"
cdMcn' :: C.Ptr Cdio -> IO C.CString
numTracks :: Cdio -> IO (Maybe Track)
numTracks :: Cdio -> IO (Maybe Track)
numTracks Cdio
c = (Maybe CUChar -> (CUChar -> Maybe Track) -> Maybe Track
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CUChar -> Maybe Track
invalidTrack) (Maybe CUChar -> Maybe Track)
-> IO (Maybe CUChar) -> IO (Maybe Track)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio -> (Ptr Cdio -> IO CUChar) -> IO (Maybe CUChar)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c Ptr Cdio -> IO CUChar
numTracks'
foreign import ccall safe "cdio/compat/disc.h cdio_get_num_tracks"
numTracks' :: C.Ptr Cdio -> IO C.CUChar
isCdRom :: DiscMode -> Bool
isCdRom :: DiscMode -> Bool
isCdRom = CUChar -> Bool
forall a. (Eq a, Num a) => a -> Bool
M.toBool (CUChar -> Bool) -> (DiscMode -> CUChar) -> DiscMode -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDiscMode -> CUChar
isCdRom' (CDiscMode -> CUChar)
-> (DiscMode -> CDiscMode) -> DiscMode -> CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CDiscMode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDiscMode) -> (DiscMode -> Int) -> DiscMode -> CDiscMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscMode -> Int
forall a. Enum a => a -> Int
fromEnum
foreign import ccall safe "cdio/compat/disc.h cdio_is_discmode_cdrom"
isCdRom' :: CDiscMode -> C.CUChar
isDvd :: DiscMode -> Bool
isDvd :: DiscMode -> Bool
isDvd = CUChar -> Bool
forall a. (Eq a, Num a) => a -> Bool
M.toBool (CUChar -> Bool) -> (DiscMode -> CUChar) -> DiscMode -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDiscMode -> CUChar
isDvd' (CDiscMode -> CUChar)
-> (DiscMode -> CDiscMode) -> DiscMode -> CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CDiscMode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDiscMode) -> (DiscMode -> Int) -> DiscMode -> CDiscMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiscMode -> Int
forall a. Enum a => a -> Int
fromEnum
foreign import ccall safe "cdio/compat/disc.h cdio_is_discmode_dvd"
isDvd' :: CDiscMode -> C.CUChar