{-# LANGUAGE ForeignFunctionInterface #-}

{-|
Description:    Various device-management functions, including session initialization.

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

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

The entire library architecture revolves around the concept of a device—not the
disc, but the drive containing it.  A function to read a segment of data is not
just a lookup from memory, but an instruction to the device to move the read
arm into position and begin interpreting the pits and ridges.  With that
understanding, it makes sense that this module provides not just the means to
determine what any particular drive is capable of, but also the only means to
obtain the 'Cdio' object the everything else revolves around.


= @device.h@

== Types
* @cdio_drive_cap_misc_t@           -> 'DriveCapabilityMisc'

    - @CDIO_DRIVE_CAP_ERROR@        (removed; handled via 'Nothing')
    - @CDIO_DRIVE_CAP_UNKNOWN@      (removed; handled via 'Nothing')

* @cdio_drive_cap_read_t@           -> 'DriveCapabilityRead'

    - @CDIO_DRIVE_CAP_READ_AUDIO@   -> 'ReadAnalogAudio'
    - @CDIO_DRIVE_CAP_READ_CD_DA@   -> 'ReadDigitalAudio'
    - @CDIO_DRIVE_CAP_READ_CD_R@    -> 'ReadCdRecordable'
    - @CDIO_DRIVE_CAP_READ_CD_RW@   -> 'ReadCdReWritable'
    - @CDIO_DRIVE_CAP_READ_DVD_R@   -> 'ReadDvdRecordable'
    - @CDIO_DRIVE_CAP_READ_DVD_PR@  -> 'ReadDvdPlusRecordable'
    - @CDIO_DRIVE_CAP_READ_DVD_RW@   -> 'ReadDvdReWritable'
    - @CDIO_DRIVE_CAP_READ_DVD_PRW@  -> 'ReadDvdPlusReWritable'
    - @CDIO_DRIVE_CAP_READ_C2_ERRS@ -> 'ReadC2ErrorCorrection'

* @cdio_drive_cap_write_t@          -> 'DriveCapabilityWrite'

    Note that some values are not included in the Haskell type, as the indexing
    implementation is stricter than the equivalent bit operations in C.

    - @CDIO_DRIVE_CAP_WRITE_CD_R@    -> 'WriteCdRecordable'
    - @CDIO_DRIVE_CAP_WRITE_CD_RW@   -> 'WriteCdReWritable'
    - @CDIO_DRIVE_CAP_WRITE_DVD_R@   -> 'WriteDvdRecordable'
    - @CDIO_DRIVE_CAP_WRITE_DVD_PR@  -> 'WriteDvdPlusRecordable'
    - @CDIO_DRIVE_CAP_WRITE_DVD_RW@   -> 'WriteDvdReWritable'
    - @CDIO_DRIVE_CAP_WRITE_DVD_PRW@  -> 'WriteDvdPlusReWritable'
    - @CDIO_DRIVE_CAP_WRITE_CD@     -> 'capsWriteCd'
    - @CDIO_DRIVE_CAP_WRITE_DVD@    -> 'capsWriteDvd'
    - @CDIO_DRIVE_CAP_WRITE@        -> 'capsWrite'

* @cdio_drive_misc_cap_t@           -> 'DriveMiscCaps'
* @cdio_drive_read_cap_t@           -> 'DriveReadCaps'
* @cdio_drive_write_cap_t@          -> 'DriveWriteCaps'
* @cdio_hwinfo_t@                   -> 'HardwareInfo'

    - @psz_vendor@                  -> 'vendor'
    - @psz_model@                   -> 'model'
    - @psz_revision@                -> 'revision'

* @cdio_mmc_hw_len_t@               (type removed; values are structural constants rather than an actual enum)

    - @CDIO_MMC_HW_VENDOR_LEN@      -> 'vendorLength'
    - @CDIO_MMC_HW_MODEL_LEN@       -> 'modelLength'
    - @CDIO_MMC_HW_REVISION_LEN@    -> 'revisionLength'

* @cdio_src_category_mask_t@        (removed; never used in the public interface)
* @driver_id_t@                     -> 'DriverId'
* @driver_return_code_t@            -> 'DriverReturnCode'

== Symbols
* @cdio_close_tray@                 -> 'closeTray'
* @cdio_destroy@                    (removed; handled via garbage collector)
* @cdio_device_drivers@             -> 'deviceDrivers'
* @cdio_driver_describe@            -> 'driverDescribe'
* @cdio_driver_errmsg@              -> 'driverErrmsg'
* @cdio_drivers@                    -> 'drivers'
* @cdio_eject_media@                -> 'ejectMedia'
* @cdio_eject_media_drive@          -> 'ejectDrive'
* @cdio_free_device_list@           (removed; handled via garbage collector)
* @cdio_get_arg@                    -> 'getArg' and 'getAccessMode'
* @cdio_get_default_device@         -> 'defaultDevice' (@CdIo_t*@ argument dropped as no non-redundant path to get one exists)
* @cdio_get_default_device_*@       (removed; 'defaultDeviceDriver' provides the same functionality)
* @cdio_get_devices@                -> 'devices'
* @cdio_get_devices_*@              (removed; 'devices' provides the same functionality)
* @cdio_get_devices_with_cap@       -> 'devicesWithFilesystem'
* @cdio_get_devices_with_cap_ret@   -> 'devicesWithFilesystemRet'
* @cdio_get_drive_cap@              -> 'driveCap'
* @cdio_get_drive_cap_dev@          -> 'driveCapDevice'
* @cdio_get_driver_id@              -> 'driverId'
* @cdio_get_driver_name@            -> 'driverName'
* @cdio_get_hwinfo@                 -> 'hwinfo'
* @cdio_get_last_session@           -> 'lastSession'
* @cdio_get_media_changed@          -> 'isMediaChanged'
* @cdio_have_atapi@                 -> 'haveAtapi'
* @cdio_have_driver@                -> 'haveDriver'
* @cdio_init@                       (removed; internal function without much external occasion for use)
* @cdio_is_binfile@                 -> 'cueFromBin'
* @cdio_is_cuefile@                 -> 'binFromCue'
* @cdio_is_device@                  -> 'isDevice'
* @cdio_is_nrg@                     -> 'isNrg'
* @cdio_is_tocfile@                 -> 'isToc'
* @cdio_open@                       -> 'cdioOpen'
* @cdio_open_*@                     (removed; 'cdioOpen' provides the same functionality)
* @cdio_open_am@                    -> 'cdioOpenAm'
* @cdio_open_am_*@                  (removed; 'cdioOpenAm' provides the same functionality)
* @cdio_os_driver@                  -> 'osDriver'
* @cdio_set_arg@                    (removed; primarily intended for internal use, and is more limited than would be expected)
* @cdio_set_blocksize@              -> 'setBlocksize'
* @cdio_set_speed@                  -> 'setSpeed'


= "Sound.Libcdio.Device"

* 'Cdio'                            -> @"Sound.Libcdio".'Sound.Libcdio.Cdio'@ (note, however, that the latter is a more abstracted 'Monad')

* 'binFromCue'                      -> 'Sound.Libcdio.Device.isCue'
* 'cdioOpen'                        -> @"Sound.Libcdio".'Sound.Libcdio.open'@ and 'Sound.Libcdio.openDefault'
* 'cdioOpenAm'                      -> @"Sound.Libcdio".'Sound.Libcdio.openMode'@ and 'Sound.Libcdio.openModeDefault'
* @cdioOpen*@                       (removed; @"Sound.Libcdio".'Sound.Libcdio.open'@ handles the auto-detection)
* 'closeTray'                       -> 'Sound.Libcdio.Device.closeDeviceTray' and 'Sound.Libcdio.Device.closeDeviceTray''
* 'cueFromBin'                      (removed; this and 'Foreign.binFromCue' just replace the file extension after validation, they don't go searching)
* @defaultDevice*@                  (removed; driver type isn't a public part of device opening)
* 'deviceDrivers'                   -> @'not' 'Sound.Libcdio.Device.isImageDriver'@
* 'devicesRet'                      (removed; @"Sound.Libcdio".'Sound.Libcdio.open'@ doesn't require a specific 'Foreign.DriverId' to be passed)
* 'devicesWithFilesystem'           (removed; can't think of a use case for searching for discs of a specific data layout)
* 'devicesWithFilesystemRet'        (removed; can't think of a use case for searching for discs of a specific data layout)
* @devices*@                        (removed; 'Sound.Libcdio.Device.devices' delegates via the 'Foreign.DriverId' parameter)
* 'driveCap'                        -> 'Sound.Libcdio.Device.capabilities'
* 'driveCapDevice'                  -> 'Sound.Libcdio.Device.deviceCapabilities'
* 'driverId'                        -> 'Sound.Libcdio.Device.driver'
* 'ejectDrive'                      -> 'Sound.Libcdio.Device.ejectDevice'
* 'ejectMedia'                      (removed; argument to e.g. @"Sound.Libcdio".'Sound.Libcdio.open'@)
* 'getArg'                          -> @"Sound.Libcdio".'Sound.Libcdio.getArg'@
* 'getAccessMode'                   -> @"Sound.Libcdio".'Sound.Libcdio.getAccessMode'@
* 'haveDriver'                      (removed; use @`'elem'` 'Sound.Libcdio.Device.drivers'@)
* 'hwinfo'                          -> 'Sound.Libcdio.Device.hardware'
* 'lastSession'                     -> @"Sound.Libcdio.Read.Data".'Sound.Libcdio.Read.Data.lastSessionOffset'@
* 'modelLength'                     (removed; unnecessary low-level detail)
* 'revisionLength'                  (removed; unnecessary low-level detail)
* 'vendorLength'                    (removed; unnecessary low-level detail)
-}
module Foreign.Libcdio.Device
    ( -- * Types
      Cdio
    , HardwareInfo ( .. )
    , vendorLength
    , modelLength
    , revisionLength
    , emptyHardwareInfo
    , DriverId ( .. )
    , DriverReturnCode ( .. )
    , SessionArg ( .. )
    , AccessMode ( .. )
      -- ** Capabilities
    , DriveCapabilityRead ( .. )
    , DriveReadCaps
    , DriveCapabilityWrite ( .. )
    , DriveWriteCaps
    , capsWriteCd
    , capsWriteDvd
    , capsWrite
    , DriveCapabilityMisc ( .. )
    , DriveMiscCaps
    , DriveCaps
      -- * Drivers
    , drivers
    , deviceDrivers
    , osDriver
    , driverName
    , driverId
    , driverDescribe
    , driverErrmsg
    , haveDriver
      -- * Devices
    , devices
    , devicesRet
    , devicesWithFilesystem
    , devicesWithFilesystemRet
    , defaultDevice
    , defaultDeviceDriver
    , hwinfo
    , driveCap
    , driveCapDevice
    , haveAtapi
    , ejectMedia
    , ejectDrive
    , closeTray
      -- * Session
    , getArg
    , getAccessMode
    , isMediaChanged
    , setBlocksize
    , setSpeed
    , lastSession
      -- * Device paths
    , cdioOpen
    , cdioOpenAm
      -- ** Hardware
    , isDevice
    , cdioOpenCd
    , cdioOpenAmCd
      -- ** Images
    , cueFromBin
    , binFromCue
    , isNrg
    , isToc
    {-
      -- *** BIN/CUE
    , cdioOpenBinCue
    , cdioOpenCue
    , cdioOpenAmBinCue
    , defaultDeviceBinCue
    , devicesBinCue
      -- *** cdrdao
    , cdioOpenCdrDao
    , cdioOpenAmCdrDao
    , defaultDeviceCdrDao
    , devicesCdrDao
      -- *** Nero
    , cdioOpenNero
    , cdioOpenAmNero
    , defaultDeviceNero
    , devicesNero
      -- ** Hardware
      -- *** BSDI
    , cdioOpenBsdi
    , cdioOpenAmBsdi
    , defaultDeviceBsdi
    , devicesBsdi
      -- *** FreeBSD
    , cdioOpenFreeBsd
    , cdioOpenAmFreeBsd
    , defaultDeviceFreeBsd
    , devicesFreeBsd
      -- *** Linux
    , cdioOpenLinux
    , cdioOpenAmLinux
    , defaultDeviceLinux
    , devicesLinux
      -- *** OS/2
    , cdioOpenOs2
    , cdioOpenAmOs2
    , defaultDeviceOs2
    , devicesOs2
      -- *** Solaris
    , cdioOpenSolaris
    , cdioOpenAmSolaris
    , defaultDeviceSolaris
    , devicesSolaris
      -- *** Windows
    , cdioOpenWin32
    , cdioOpenAmWin32
    , defaultDeviceWin32
    , devicesWin32
    -}
    ) where


import qualified Control.Monad as N

import qualified Data.Array.BitArray as A
import qualified Data.Maybe as Y

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.Array as M
import qualified Foreign.Marshal.Utils as M
import qualified Foreign.Storable as S

import qualified System.IO.Unsafe as IO.Unsafe

import Data.Ix ( Ix )
import Data.Bits ( (.&.) )

import Foreign.Libcdio.CdTypes
import Foreign.Libcdio.Marshal
import Foreign.Libcdio.Types.Enums
import Foreign.Libcdio.Types.Internal
import Foreign.Libcdio.Types.Offsets

import Sound.Libcdio.Common


toDriverReturnCode :: Maybe CDriverReturnCode -> DriverReturnCode
toDriverReturnCode :: Maybe CDriverReturnCode -> DriverReturnCode
toDriverReturnCode = DriverReturnCode
-> (CDriverReturnCode -> DriverReturnCode)
-> Maybe CDriverReturnCode
-> DriverReturnCode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DriverReturnCode
Uninitialized ((CDriverReturnCode -> DriverReturnCode)
 -> Maybe CDriverReturnCode -> DriverReturnCode)
-> (CDriverReturnCode -> DriverReturnCode)
-> Maybe CDriverReturnCode
-> DriverReturnCode
forall a b. (a -> b) -> a -> b
$ Int -> DriverReturnCode
forall a. Enum a => Int -> a
toEnum (Int -> DriverReturnCode)
-> (CDriverReturnCode -> Int)
-> CDriverReturnCode
-> DriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral


-- | The collection of features for reading discs a device provides.
type DriveReadCaps = A.BitArray DriveCapabilityRead
-- | The collection of features for writing discs a device provides.
type DriveWriteCaps = A.BitArray DriveCapabilityWrite
-- | The collection of hardware features a device was built with.
type DriveMiscCaps = A.BitArray DriveCapabilityMisc

-- | The three types are usually passed around together, so we can simplify the
-- type signatures using them.
type DriveCaps = (DriveReadCaps, DriveWriteCaps, DriveMiscCaps)


-- | Capabilites indicating a device has some sort of CD-writing ability.
capsWriteCd :: DriveWriteCaps
capsWriteCd :: DriveWriteCaps
capsWriteCd = [DriveCapabilityWrite] -> DriveWriteCaps
forall a. (Bounded a, Ix a) => [a] -> BitArray a
genBitArray
    [ DriveCapabilityWrite
WriteCdRecordable
    , DriveCapabilityWrite
WriteCdReWritable
    ]

-- | Capabilites indicating a device has some sort of DVD-writing ability.
capsWriteDvd :: DriveWriteCaps
capsWriteDvd :: DriveWriteCaps
capsWriteDvd = [DriveCapabilityWrite] -> DriveWriteCaps
forall a. (Bounded a, Ix a) => [a] -> BitArray a
genBitArray
    [ DriveCapabilityWrite
WriteDvdRecordable
    , DriveCapabilityWrite
WriteDvdPlusRecordable
    , DriveCapabilityWrite
WriteDvdRam
    , DriveCapabilityWrite
WriteDvdReWritable
    , DriveCapabilityWrite
WriteDvdPlusReWritable
    ]

-- | Capabilites indicating a device has some sort of disc-writing ability.
capsWrite :: DriveWriteCaps
capsWrite :: DriveWriteCaps
capsWrite = (Bool -> Bool -> Bool)
-> DriveWriteCaps -> DriveWriteCaps -> DriveWriteCaps
forall i.
Ix i =>
(Bool -> Bool -> Bool) -> BitArray i -> BitArray i -> BitArray i
A.zipWith Bool -> Bool -> Bool
(||) DriveWriteCaps
capsWriteCd DriveWriteCaps
capsWriteDvd


-- | Length of the drive vendor name in returned in a 'HardwareInfo' query.
vendorLength :: Word
vendorLength :: Word
vendorLength = CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
vendorLength'

foreign import ccall safe "cdio/compat/device.h vendor_len"
  vendorLength' :: C.CUInt


-- | Length of the drive model name in returned in a 'HardwareInfo' query.
modelLength :: Word
modelLength :: Word
modelLength = CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
modelLength'

foreign import ccall safe "cdio/compat/device.h model_len"
  modelLength' :: C.CUInt

-- | Length of the drive revision number in returned in a 'HardwareInfo' query.
revisionLength :: Word
revisionLength :: Word
revisionLength = CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
revisionLength'

foreign import ccall safe "cdio/compat/device.h revision_len"
  revisionLength' :: C.CUInt


-- | Information defining the make and model of a (typically physical) device.
data HardwareInfo = HardwareInfo
    { HardwareInfo -> String
vendor    :: String
        -- ^ The company who designed and/or built the drive.
    , HardwareInfo -> String
model     :: String
        -- ^ The name of the specific drive design.
    , HardwareInfo -> String
revision  :: String
        -- ^ The version number for hardware/firmware following a series.
    }
  deriving ( HardwareInfo -> HardwareInfo -> Bool
(HardwareInfo -> HardwareInfo -> Bool)
-> (HardwareInfo -> HardwareInfo -> Bool) -> Eq HardwareInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HardwareInfo -> HardwareInfo -> Bool
$c/= :: HardwareInfo -> HardwareInfo -> Bool
== :: HardwareInfo -> HardwareInfo -> Bool
$c== :: HardwareInfo -> HardwareInfo -> Bool
Eq, Int -> HardwareInfo -> ShowS
[HardwareInfo] -> ShowS
HardwareInfo -> String
(Int -> HardwareInfo -> ShowS)
-> (HardwareInfo -> String)
-> ([HardwareInfo] -> ShowS)
-> Show HardwareInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HardwareInfo] -> ShowS
$cshowList :: [HardwareInfo] -> ShowS
show :: HardwareInfo -> String
$cshow :: HardwareInfo -> String
showsPrec :: Int -> HardwareInfo -> ShowS
$cshowsPrec :: Int -> HardwareInfo -> ShowS
Show, ReadPrec [HardwareInfo]
ReadPrec HardwareInfo
Int -> ReadS HardwareInfo
ReadS [HardwareInfo]
(Int -> ReadS HardwareInfo)
-> ReadS [HardwareInfo]
-> ReadPrec HardwareInfo
-> ReadPrec [HardwareInfo]
-> Read HardwareInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HardwareInfo]
$creadListPrec :: ReadPrec [HardwareInfo]
readPrec :: ReadPrec HardwareInfo
$creadPrec :: ReadPrec HardwareInfo
readList :: ReadS [HardwareInfo]
$creadList :: ReadS [HardwareInfo]
readsPrec :: Int -> ReadS HardwareInfo
$creadsPrec :: Int -> ReadS HardwareInfo
Read )
instance S.Storable HardwareInfo where
    sizeOf :: HardwareInfo -> Int
sizeOf HardwareInfo
_    = Int
hiSizeOf
    alignment :: HardwareInfo -> Int
alignment HardwareInfo
_ = Int
hiAlign
    peek :: Ptr HardwareInfo -> IO HardwareInfo
peek Ptr HardwareInfo
c = do
        String
v <- Word -> Int -> IO String
forall a. Integral a => a -> Int -> IO String
decode Word
vendorLength Int
hiVendor
        String
m <- Word -> Int -> IO String
forall a. Integral a => a -> Int -> IO String
decode Word
modelLength Int
hiModel
        String
r <- Word -> Int -> IO String
forall a. Integral a => a -> Int -> IO String
decode Word
revisionLength Int
hiRevision
        HardwareInfo -> IO HardwareInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (HardwareInfo -> IO HardwareInfo)
-> HardwareInfo -> IO HardwareInfo
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> HardwareInfo
HardwareInfo String
v String
m String
r
      where decode :: a -> Int -> IO String
decode a
l Int
o = CStringLen -> IO String
C.peekCStringLen (Ptr HardwareInfo -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
C.plusPtr Ptr HardwareInfo
c Int
o, a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
l)
    poke :: Ptr HardwareInfo -> HardwareInfo -> IO ()
poke Ptr HardwareInfo
c HardwareInfo
hs = do
        String -> Int -> Ptr CChar -> IO ()
pokeCString (HardwareInfo -> String
vendor HardwareInfo
hs) (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
vendorLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr HardwareInfo -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
C.plusPtr Ptr HardwareInfo
c Int
hiVendor)
        String -> Int -> Ptr CChar -> IO ()
pokeCString (HardwareInfo -> String
model HardwareInfo
hs) (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
modelLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr HardwareInfo -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
C.plusPtr Ptr HardwareInfo
c Int
hiModel)
        String -> Int -> Ptr CChar -> IO ()
pokeCString (HardwareInfo -> String
revision HardwareInfo
hs) (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
revisionLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr HardwareInfo -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
C.plusPtr Ptr HardwareInfo
c Int
hiRevision)

-- | A 'HardwareInfo' object with values suitable as defaults.
emptyHardwareInfo :: HardwareInfo
emptyHardwareInfo :: HardwareInfo
emptyHardwareInfo = HardwareInfo :: String -> String -> String -> HardwareInfo
HardwareInfo
    { vendor :: String
vendor = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
vendorLength) Char
'\NUL'
    , model :: String
model = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
modelLength) Char
'\NUL'
    , revision :: String
revision = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
revisionLength) Char
'\NUL'
    }


{- Barely even used internally.
-- | Which type(s) of device describe a particular drive.
type SrcCategories = A.BitArray SrcCategoryMask
-}


-- | Unmarshall a C-style list of drivers.
peekDriverIdArray :: (Integral a, S.Storable a) => C.Ptr a -> IO [DriverId]
peekDriverIdArray :: Ptr a -> IO [DriverId]
peekDriverIdArray Ptr a
is' = do
    [a]
is <- a -> Ptr a -> IO [a]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
M.peekArray0 (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ DriverId -> Int
forall a. Enum a => a -> Int
fromEnum DriverId
DriverUnknown) Ptr a
is'
    [DriverId] -> IO [DriverId]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DriverId] -> IO [DriverId]) -> [DriverId] -> IO [DriverId]
forall a b. (a -> b) -> a -> b
$ (a -> DriverId) -> [a] -> [DriverId]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> DriverId
forall a. Enum a => Int -> a
toEnum (Int -> DriverId) -> (a -> Int) -> a -> DriverId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [a]
is


-- | All supported drivers, listed in order of preference.
drivers :: [DriverId]
drivers :: [DriverId]
drivers = (DriverId -> Bool) -> [DriverId] -> [DriverId]
forall a. (a -> Bool) -> [a] -> [a]
filter DriverId -> Bool
haveDriver ([DriverId] -> [DriverId])
-> (IO [DriverId] -> [DriverId]) -> IO [DriverId] -> [DriverId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [DriverId] -> [DriverId]
forall a. IO a -> a
IO.Unsafe.unsafePerformIO (IO [DriverId] -> [DriverId]) -> IO [DriverId] -> [DriverId]
forall a b. (a -> b) -> a -> b
$ Ptr CDriverReturnCode -> IO [DriverId]
forall a. (Integral a, Storable a) => Ptr a -> IO [DriverId]
peekDriverIdArray Ptr CDriverReturnCode
drivers'

foreign import ccall safe "cdio/compat/device.h get_drivers"
  drivers' :: C.Ptr CDriverId

-- | All supported drivers for physical devices, listed in order of preference.
deviceDrivers :: [DriverId]
deviceDrivers :: [DriverId]
deviceDrivers = IO [DriverId] -> [DriverId]
forall a. IO a -> a
IO.Unsafe.unsafePerformIO (IO [DriverId] -> [DriverId]) -> IO [DriverId] -> [DriverId]
forall a b. (a -> b) -> a -> b
$ Ptr CDriverReturnCode -> IO [DriverId]
forall a. (Integral a, Storable a) => Ptr a -> IO [DriverId]
peekDriverIdArray Ptr CDriverReturnCode
deviceDrivers'

foreign import ccall safe "cdio/compat/device.h get_device_drivers"
  deviceDrivers' :: C.Ptr CDriverId

-- | The particular driver for the current operating system, or 'DriverUnknown'
-- if no device driver exists.
osDriver :: DriverId
osDriver :: DriverId
osDriver = Int -> DriverId
forall a. Enum a => Int -> a
toEnum (Int -> DriverId) -> Int -> DriverId
forall a b. (a -> b) -> a -> b
$ CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CDriverReturnCode
osDriver'

foreign import ccall safe "cdio/compat/device.h get_os_driver"
  osDriver' :: CDriverId


-- | Close a CD drive, if the device supports doing so.
closeTray
    :: Maybe FilePath
        -- ^ The name of the drive to use, or 'Nothing' to use 'defaultDeviceDriver'.
    -> DriverId
    -> IO (DriverReturnCode, DriverId)
        -- ^ Any errors, along with the actual driver used if passed
        -- 'DriverUnknown' or 'DriverDevice'.
closeTray :: Maybe String -> DriverId -> IO (DriverReturnCode, DriverId)
closeTray Maybe String
f DriverId
d = (String
 -> (Ptr CChar -> IO (DriverReturnCode, DriverId))
 -> IO (DriverReturnCode, DriverId))
-> Maybe String
-> (Ptr CChar -> IO (DriverReturnCode, DriverId))
-> IO (DriverReturnCode, DriverId)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
M.maybeWith String
-> (Ptr CChar -> IO (DriverReturnCode, DriverId))
-> IO (DriverReturnCode, DriverId)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString Maybe String
f ((Ptr CChar -> IO (DriverReturnCode, DriverId))
 -> IO (DriverReturnCode, DriverId))
-> (Ptr CChar -> IO (DriverReturnCode, DriverId))
-> IO (DriverReturnCode, DriverId)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
f' -> CDriverReturnCode
-> (Ptr CDriverReturnCode -> IO (DriverReturnCode, DriverId))
-> IO (DriverReturnCode, DriverId)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
M.with (Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode) -> Int -> CDriverReturnCode
forall a b. (a -> b) -> a -> b
$ DriverId -> Int
forall a. Enum a => a -> Int
fromEnum DriverId
d) ((Ptr CDriverReturnCode -> IO (DriverReturnCode, DriverId))
 -> IO (DriverReturnCode, DriverId))
-> (Ptr CDriverReturnCode -> IO (DriverReturnCode, DriverId))
-> IO (DriverReturnCode, DriverId)
forall a b. (a -> b) -> a -> b
$ \Ptr CDriverReturnCode
d' -> do
    CDriverReturnCode
r <- Ptr CChar -> Ptr CDriverReturnCode -> IO CDriverReturnCode
closeTray' Ptr CChar
f' Ptr CDriverReturnCode
d'
    CDriverReturnCode
d'' <- Ptr CDriverReturnCode -> IO CDriverReturnCode
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CDriverReturnCode
d'
    (DriverReturnCode, DriverId) -> IO (DriverReturnCode, DriverId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> DriverReturnCode
forall a. Enum a => Int -> a
toEnum (Int -> DriverReturnCode) -> Int -> DriverReturnCode
forall a b. (a -> b) -> a -> b
$ CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CDriverReturnCode
r, Int -> DriverId
forall a. Enum a => Int -> a
toEnum (Int -> DriverId) -> Int -> DriverId
forall a b. (a -> b) -> a -> b
$ CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CDriverReturnCode
d'')

foreign import ccall safe "cdio/compat/device.h cdio_close_tray"
  closeTray' :: C.CString -> C.Ptr CDriverId -> IO CDriverReturnCode


-- | Describe the driver-level error in a human-readable manner, as opposed to
-- the machine representation returned by the 'Show' instance.
driverErrmsg :: DriverReturnCode -> String
driverErrmsg :: DriverReturnCode -> String
driverErrmsg = IO String -> String
forall a. IO a -> a
IO.Unsafe.unsafePerformIO (IO String -> String)
-> (DriverReturnCode -> IO String) -> DriverReturnCode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Ptr CChar -> IO String
C.peekCString (Ptr CChar -> IO String)
-> (DriverReturnCode -> Ptr CChar) -> DriverReturnCode -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDriverReturnCode -> Ptr CChar
driverErrmsg' (CDriverReturnCode -> Ptr CChar)
-> (DriverReturnCode -> CDriverReturnCode)
-> DriverReturnCode
-> Ptr CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode)
-> (DriverReturnCode -> Int)
-> DriverReturnCode
-> CDriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DriverReturnCode -> Int
forall a. Enum a => a -> Int
fromEnum

foreign import ccall safe "cdio/compat/device.h cdio_driver_errmsg"
  driverErrmsg' :: CDriverReturnCode -> C.CString


-- | Eject the media represented by the session identifier, if the device
-- supports doing so.
-- 
-- __Warning:__  Assuming this succeeds, the 'Cdio' object is destroyed and any
-- further operations on it will fail!
ejectMedia :: Cdio -> IO DriverReturnCode
ejectMedia :: Cdio -> IO DriverReturnCode
ejectMedia = (Maybe CDriverReturnCode -> DriverReturnCode)
-> IO (Maybe CDriverReturnCode) -> IO DriverReturnCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe CDriverReturnCode -> DriverReturnCode
toDriverReturnCode (IO (Maybe CDriverReturnCode) -> IO DriverReturnCode)
-> (Cdio -> IO (Maybe CDriverReturnCode))
-> Cdio
-> IO DriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cdio
 -> (Ptr (Ptr Cdio) -> IO CDriverReturnCode)
 -> IO (Maybe CDriverReturnCode))
-> (Ptr (Ptr Cdio) -> IO CDriverReturnCode)
-> Cdio
-> IO (Maybe CDriverReturnCode)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cdio
-> (Ptr (Ptr Cdio) -> IO CDriverReturnCode)
-> IO (Maybe CDriverReturnCode)
forall b. Cdio -> (Ptr (Ptr Cdio) -> IO b) -> IO (Maybe b)
withCdioPtr Ptr (Ptr Cdio) -> IO CDriverReturnCode
ejectMedia'

foreign import ccall safe "cdio/compat/device.h cdio_eject_media"
  ejectMedia' :: C.Ptr (C.Ptr Cdio) -> IO CDriverReturnCode

-- | Eject media in a CD drive, if the device supports doing so.  If a 'Cdio'
-- session has already been opened on the drive, 'ejectMedia' is strongly
-- recommended instead.
ejectDrive
    :: Maybe FilePath
        -- ^ The name of the device to eject, or 'Nothing' to use the default
        -- drive for the machine.
    -> IO DriverReturnCode
ejectDrive :: Maybe String -> IO DriverReturnCode
ejectDrive = (CDriverReturnCode -> DriverReturnCode)
-> IO CDriverReturnCode -> IO DriverReturnCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> DriverReturnCode
forall a. Enum a => Int -> a
toEnum (Int -> DriverReturnCode)
-> (CDriverReturnCode -> Int)
-> CDriverReturnCode
-> DriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CDriverReturnCode -> IO DriverReturnCode)
-> (Maybe String -> IO CDriverReturnCode)
-> Maybe String
-> IO DriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String
 -> (Ptr CChar -> IO CDriverReturnCode) -> IO CDriverReturnCode)
-> (Ptr CChar -> IO CDriverReturnCode)
-> Maybe String
-> IO CDriverReturnCode
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String
 -> (Ptr CChar -> IO CDriverReturnCode) -> IO CDriverReturnCode)
-> Maybe String
-> (Ptr CChar -> IO CDriverReturnCode)
-> IO CDriverReturnCode
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
M.maybeWith String
-> (Ptr CChar -> IO CDriverReturnCode) -> IO CDriverReturnCode
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString) Ptr CChar -> IO CDriverReturnCode
ejectDrive'

foreign import ccall safe "cdio/compat/device.h cdio_eject_media_drive"
  ejectDrive' :: C.CString -> IO CDriverReturnCode


-- | Find the default disc device for the system, if one exists.
-- 
-- The C library allows getting the default device from a 'Cdio' object, but
-- since that seems to only be initialized from either the default device
-- itself or with an explicit path, doing so seems rather redundant.
defaultDevice :: IO (Maybe FilePath)
defaultDevice :: IO (Maybe String)
defaultDevice = Ptr Cdio -> IO (Ptr CChar)
defaultDevice' Ptr Cdio
forall a. Ptr a
C.nullPtr IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr CChar -> IO String
C.peekCString

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device"
  defaultDevice' :: C.Ptr Cdio -> IO C.CString

-- | Find the default disc device for a given driver, if one exists.
defaultDeviceDriver
    :: DriverId
    -> IO (Maybe FilePath, DriverId)
        -- ^ The name of the device, along with the associated driver if
        -- passed 'DriverUnknown' or 'DriverDevice'.
defaultDeviceDriver :: DriverId -> IO (Maybe String, DriverId)
defaultDeviceDriver DriverId
d = CDriverReturnCode
-> (Ptr CDriverReturnCode -> IO (Maybe String, DriverId))
-> IO (Maybe String, DriverId)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
M.with (Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode) -> Int -> CDriverReturnCode
forall a b. (a -> b) -> a -> b
$ DriverId -> Int
forall a. Enum a => a -> Int
fromEnum DriverId
d) ((Ptr CDriverReturnCode -> IO (Maybe String, DriverId))
 -> IO (Maybe String, DriverId))
-> (Ptr CDriverReturnCode -> IO (Maybe String, DriverId))
-> IO (Maybe String, DriverId)
forall a b. (a -> b) -> a -> b
$ \Ptr CDriverReturnCode
d' -> do
    Maybe String
f <- Ptr CDriverReturnCode -> IO (Ptr CChar)
defaultDeviceDriver' Ptr CDriverReturnCode
d' IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr CChar -> IO String
C.peekCString
    CDriverReturnCode
d'' <- Ptr CDriverReturnCode -> IO CDriverReturnCode
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CDriverReturnCode
d'
    (Maybe String, DriverId) -> IO (Maybe String, DriverId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
f, Int -> DriverId
forall a. Enum a => Int -> a
toEnum (Int -> DriverId) -> Int -> DriverId
forall a b. (a -> b) -> a -> b
$ CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CDriverReturnCode
d'')

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_driver"
  defaultDeviceDriver' :: C.Ptr CDriverId -> IO C.CString


-- | List (static) available devices on the system which can be accessed with a
-- particular driver; some file devices (e.g.  with 'DriverBinCue') might be
-- returned, but an exhaustive list should not be expected in that case.
-- 
-- If passed 'DriverDevice', the returned value will list any type of hardware
-- device, but no image files.  Likewise, if passed 'DriverUnknown', all
-- hardware devices will be returned along with any already-known images.
devices :: DriverId -> IO [FilePath]
devices :: DriverId -> IO [String]
devices DriverId
d = CDriverReturnCode -> IO (Ptr (Ptr CChar))
devices' (Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode) -> Int -> CDriverReturnCode
forall a b. (a -> b) -> a -> b
$ DriverId -> Int
forall a. Enum a => a -> Int
fromEnum DriverId
d) IO (Ptr (Ptr CChar))
-> (Ptr (Ptr CChar) -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (Ptr CChar) -> IO [String]
peekFStringArray

foreign import ccall safe "cdio/compat/device.h cdio_get_devices"
  devices' :: CDriverId -> IO (C.Ptr C.CString)

-- | Like 'devices', but if 'DriverDevice' or 'DriverUnknown' is passed, the
-- second return value reflects the driver the library would use by default.
-- If any other 'DriverId' is passed, that value is returned unchanged.
devicesRet :: DriverId -> IO ([FilePath], DriverId)
devicesRet :: DriverId -> IO ([String], DriverId)
devicesRet DriverId
d = CDriverReturnCode
-> (Ptr CDriverReturnCode -> IO ([String], DriverId))
-> IO ([String], DriverId)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
M.with (Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode) -> Int -> CDriverReturnCode
forall a b. (a -> b) -> a -> b
$ DriverId -> Int
forall a. Enum a => a -> Int
fromEnum DriverId
d) ((Ptr CDriverReturnCode -> IO ([String], DriverId))
 -> IO ([String], DriverId))
-> (Ptr CDriverReturnCode -> IO ([String], DriverId))
-> IO ([String], DriverId)
forall a b. (a -> b) -> a -> b
$ \Ptr CDriverReturnCode
d' -> do
    [String]
fs <- Ptr CDriverReturnCode -> IO (Ptr (Ptr CChar))
devicesRet' Ptr CDriverReturnCode
d' IO (Ptr (Ptr CChar))
-> (Ptr (Ptr CChar) -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (Ptr CChar) -> IO [String]
peekFStringArray
    CDriverReturnCode
d'' <- Ptr CDriverReturnCode -> IO CDriverReturnCode
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CDriverReturnCode
d'
    ([String], DriverId) -> IO ([String], DriverId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
fs, Int -> DriverId
forall a. Enum a => Int -> a
toEnum (Int -> DriverId) -> Int -> DriverId
forall a b. (a -> b) -> a -> b
$ CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CDriverReturnCode
d'')

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_ret"
  devicesRet' :: C.Ptr CDriverId -> IO (C.Ptr C.CString)

-- | Determine which of the devices may read discs fitting the given
-- description.
devicesWithFilesystem
    :: [FilePath]
        -- ^ If empty, then search all possible drives.
    -> Maybe Filesystem
    -> FilesystemClasses
    -> Bool
        -- ^ If 'True', then a device matching any of the capabilities
        -- succeeds; if 'False' then it must match every capability given
        -- (empty capabilities always match).
    -> IO [FilePath]
devicesWithFilesystem :: [String]
-> Maybe Filesystem -> FilesystemClasses -> Bool -> IO [String]
devicesWithFilesystem [String]
ps Maybe Filesystem
fs FilesystemClasses
fc Bool
b = [String] -> (Ptr (Ptr CChar) -> IO [String]) -> IO [String]
forall a. [String] -> (Ptr (Ptr CChar) -> IO a) -> IO a
allocaStringArray [String]
ps ((Ptr (Ptr CChar) -> IO [String]) -> IO [String])
-> (Ptr (Ptr CChar) -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
ps' ->
    Ptr (Ptr CChar)
-> CDriverReturnCode -> CBool -> IO (Ptr (Ptr CChar))
devicesWithFilesystem' Ptr (Ptr CChar)
ps' (Int -> FilesystemClasses -> CDriverReturnCode
forall a b c.
(Enum a, Enum b, Bounded b, Ix b, Integral c, Bits c) =>
a -> BitArray b -> c
joinEnumFlags Int
fs' FilesystemClasses
fc) (Bool -> CBool
forall a. Num a => Bool -> a
M.fromBool Bool
b) IO (Ptr (Ptr CChar))
-> (Ptr (Ptr CChar) -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (Ptr CChar) -> IO [String]
peekFStringArray
  where fs' :: Int
fs' = Int -> (Filesystem -> Int) -> Maybe Filesystem -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Filesystem -> Int
forall a. Enum a => a -> Int
fromEnum Maybe Filesystem
fs

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_with_cap"
  devicesWithFilesystem' :: C.Ptr C.CString -> C.CInt -> CBool -> IO (C.Ptr C.CString)

-- | Like 'devicesWithFilesystem', but returning the type of driver found as with
-- 'devicesRet'.  This is only helpful if the device list is empty; otherwise
-- it simply returns 'DriverDevice'.
devicesWithFilesystemRet
    :: [FilePath]
        -- ^ If empty, then search all possible drives.
    -> Maybe Filesystem
    -> FilesystemClasses
    -> Bool
        -- ^ If 'True', then a device matching any of the capabilities
        -- succeeds; if 'False' then it must match every capability given
        -- (empty capabilities always match).
    -> IO ([FilePath], DriverId)
devicesWithFilesystemRet :: [String]
-> Maybe Filesystem
-> FilesystemClasses
-> Bool
-> IO ([String], DriverId)
devicesWithFilesystemRet [String]
ps Maybe Filesystem
fs FilesystemClasses
fc Bool
b = (Ptr CDriverReturnCode -> IO ([String], DriverId))
-> IO ([String], DriverId)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CDriverReturnCode -> IO ([String], DriverId))
 -> IO ([String], DriverId))
-> (Ptr CDriverReturnCode -> IO ([String], DriverId))
-> IO ([String], DriverId)
forall a b. (a -> b) -> a -> b
$ \Ptr CDriverReturnCode
d -> [String]
-> (Ptr (Ptr CChar) -> IO ([String], DriverId))
-> IO ([String], DriverId)
forall a. [String] -> (Ptr (Ptr CChar) -> IO a) -> IO a
allocaStringArray [String]
ps ((Ptr (Ptr CChar) -> IO ([String], DriverId))
 -> IO ([String], DriverId))
-> (Ptr (Ptr CChar) -> IO ([String], DriverId))
-> IO ([String], DriverId)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
ps' -> do
    Ptr (Ptr CChar)
ds <- Ptr (Ptr CChar)
-> CDriverReturnCode
-> CBool
-> Ptr CDriverReturnCode
-> IO (Ptr (Ptr CChar))
devicesWithFilesystemRet' Ptr (Ptr CChar)
ps' (Int -> FilesystemClasses -> CDriverReturnCode
forall a b c.
(Enum a, Enum b, Bounded b, Ix b, Integral c, Bits c) =>
a -> BitArray b -> c
joinEnumFlags Int
fs' FilesystemClasses
fc) (Bool -> CBool
forall a. Num a => Bool -> a
M.fromBool Bool
b) Ptr CDriverReturnCode
d
    [String]
ds' <- Ptr (Ptr CChar) -> IO [String]
peekFStringArray Ptr (Ptr CChar)
ds
    CDriverReturnCode
d' <- Ptr CDriverReturnCode -> IO CDriverReturnCode
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CDriverReturnCode
d
    ([String], DriverId) -> IO ([String], DriverId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
ds', Int -> DriverId
forall a. Enum a => Int -> a
toEnum (Int -> DriverId) -> Int -> DriverId
forall a b. (a -> b) -> a -> b
$ CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CDriverReturnCode
d')
  where fs' :: Int
fs' = Int -> (Filesystem -> Int) -> Maybe Filesystem -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Filesystem -> Int
forall a. Enum a => a -> Int
fromEnum Maybe Filesystem
fs

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_with_cap_ret"
  devicesWithFilesystemRet' :: C.Ptr C.CString -> C.CInt -> CBool -> C.Ptr CDriverId -> IO (C.Ptr C.CString)


-- | Get the drive capabilities for the default device.
driveCap :: Cdio -> IO DriveCaps
driveCap :: Cdio -> IO DriveCaps
driveCap Cdio
c = (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CUInt -> IO DriveCaps) -> IO DriveCaps)
-> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
x -> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CUInt -> IO DriveCaps) -> IO DriveCaps)
-> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
y -> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CUInt -> IO DriveCaps) -> IO DriveCaps)
-> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
z -> do
    Cdio -> (Ptr Cdio -> IO ()) -> IO ()
withCdio_ Cdio
c ((Ptr Cdio -> IO ()) -> IO ()) -> (Ptr Cdio -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cdio
c' -> Ptr Cdio -> Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO ()
driveCap' Ptr Cdio
c' Ptr CUInt
x Ptr CUInt
y Ptr CUInt
z
    Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO DriveCaps
peekDriveCaps Ptr CUInt
x Ptr CUInt
y Ptr CUInt
z

foreign import ccall safe "cdio/compat/device.h cdio_get_drive_cap"
  driveCap' :: C.Ptr Cdio -> C.Ptr CBitfield -> C.Ptr CBitfield -> C.Ptr CBitfield -> IO ()

-- | Get the drive capabilities for a specified device.
driveCapDevice :: FilePath -> IO DriveCaps
driveCapDevice :: String -> IO DriveCaps
driveCapDevice String
f = String -> (Ptr CChar -> IO DriveCaps) -> IO DriveCaps
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString String
f ((Ptr CChar -> IO DriveCaps) -> IO DriveCaps)
-> (Ptr CChar -> IO DriveCaps) -> IO DriveCaps
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
f' -> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CUInt -> IO DriveCaps) -> IO DriveCaps)
-> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
x -> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CUInt -> IO DriveCaps) -> IO DriveCaps)
-> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
y -> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr CUInt -> IO DriveCaps) -> IO DriveCaps)
-> (Ptr CUInt -> IO DriveCaps) -> IO DriveCaps
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
z -> do
    Ptr CChar -> Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO ()
driveCapDevice' Ptr CChar
f' Ptr CUInt
x Ptr CUInt
y Ptr CUInt
z
    Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO DriveCaps
peekDriveCaps Ptr CUInt
x Ptr CUInt
y Ptr CUInt
z

foreign import ccall safe "cdio/compat/device.h cdio_get_drive_cap_dev"
  driveCapDevice' :: C.CString -> C.Ptr CBitfield -> C.Ptr CBitfield -> C.Ptr CBitfield -> IO ()

-- | The value indicating an error occurring during the retrieval of drive
-- capabilities.
foreign import ccall safe "cdio/compat/device.h drive_cap_error"
  capError :: CBitfield

-- | The value used for initializing drive capabilities.
foreign import ccall safe "cdio/compat/device.h drive_cap_unknown"
  capUnknown :: CBitfield

peekDriveCaps :: C.Ptr CBitfield -> C.Ptr CBitfield -> C.Ptr CBitfield -> IO DriveCaps
peekDriveCaps :: Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO DriveCaps
peekDriveCaps Ptr CUInt
x Ptr CUInt
y Ptr CUInt
z = do
    CUInt
x' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CUInt
x
    CUInt
y' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CUInt
y
    CUInt
z' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
S.peek Ptr CUInt
z
    DriveCaps -> IO DriveCaps
forall (m :: * -> *) a. Monad m => a -> m a
return (DriveCaps -> IO DriveCaps) -> DriveCaps -> IO DriveCaps
forall a b. (a -> b) -> a -> b
$ CUInt -> CUInt -> CUInt -> DriveCaps
extractCapError CUInt
x' CUInt
y' CUInt
z'

-- | Process each capability collection, and if all are
-- @CDIO_DRIVE_CAP_UNKNOWN@ (uninitialized) or @CDIO_DRIVE_CAP_ERROR@, then
-- collapse them.
extractCapError :: CBitfield -> CBitfield -> CBitfield -> DriveCaps
extractCapError :: CUInt -> CUInt -> CUInt -> DriveCaps
extractCapError CUInt
rs CUInt
ws CUInt
ms = case (CUInt -> Maybe (BitArray DriveCapabilityRead)
forall i. (Ix i, Bounded i, Enum i) => CUInt -> Maybe (BitArray i)
packMay CUInt
rs, CUInt -> Maybe DriveWriteCaps
forall i. (Ix i, Bounded i, Enum i) => CUInt -> Maybe (BitArray i)
packMay CUInt
ws, CUInt -> Maybe (BitArray DriveCapabilityMisc)
forall i. (Ix i, Bounded i, Enum i) => CUInt -> Maybe (BitArray i)
packMay CUInt
ms) of
    (Maybe (BitArray DriveCapabilityRead)
Nothing, Maybe DriveWriteCaps
Nothing, Maybe (BitArray DriveCapabilityMisc)
Nothing) -> (CUInt -> BitArray DriveCapabilityRead
forall i c.
(Ix i, Bounded i, Integral c, Enum i) =>
c -> BitArray i
pack CUInt
empty, CUInt -> DriveWriteCaps
forall i c.
(Ix i, Bounded i, Integral c, Enum i) =>
c -> BitArray i
pack CUInt
empty, CUInt -> BitArray DriveCapabilityMisc
forall i c.
(Ix i, Bounded i, Integral c, Enum i) =>
c -> BitArray i
pack CUInt
empty)
    (Maybe (BitArray DriveCapabilityRead)
rs', Maybe DriveWriteCaps
ws', Maybe (BitArray DriveCapabilityMisc)
ms') -> (Maybe (BitArray DriveCapabilityRead)
-> BitArray DriveCapabilityRead
forall a.
(Bounded a, Enum a, Ix a) =>
Maybe (BitArray a) -> BitArray a
orEmpty Maybe (BitArray DriveCapabilityRead)
rs', Maybe DriveWriteCaps -> DriveWriteCaps
forall a.
(Bounded a, Enum a, Ix a) =>
Maybe (BitArray a) -> BitArray a
orEmpty Maybe DriveWriteCaps
ws', Maybe (BitArray DriveCapabilityMisc)
-> BitArray DriveCapabilityMisc
forall a.
(Bounded a, Enum a, Ix a) =>
Maybe (BitArray a) -> BitArray a
orEmpty Maybe (BitArray DriveCapabilityMisc)
ms')
  where testEnumBit :: (Integral c, Enum i) => c -> i -> (i, Bool)
        testEnumBit :: c -> i -> (i, Bool)
testEnumBit c
c i
i = (i
i, (c -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral c
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. i -> Int
forall a. Enum a => a -> Int
fromEnum i
i) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
        pack :: c -> BitArray i
pack c
bs = (i, i) -> [(i, Bool)] -> BitArray i
forall i. Ix i => (i, i) -> [(i, Bool)] -> BitArray i
A.array (i
forall a. Bounded a => a
minBound, i
forall a. Bounded a => a
maxBound) ([(i, Bool)] -> BitArray i) -> [(i, Bool)] -> BitArray i
forall a b. (a -> b) -> a -> b
$ (i -> (i, Bool)) -> [i] -> [(i, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (c -> i -> (i, Bool)
forall c i. (Integral c, Enum i) => c -> i -> (i, Bool)
testEnumBit c
bs) [i
forall a. Bounded a => a
minBound .. i
forall a. Bounded a => a
maxBound]
        packMay :: CUInt -> Maybe (BitArray i)
packMay CUInt
bs
            | CUInt
bs CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
capError CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0 = Maybe (BitArray i)
forall a. Maybe a
Nothing
            | CUInt
bs CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
capUnknown CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0 = Maybe (BitArray i)
forall a. Maybe a
Nothing
            | Bool
otherwise = BitArray i -> Maybe (BitArray i)
forall a. a -> Maybe a
Just (BitArray i -> Maybe (BitArray i))
-> BitArray i -> Maybe (BitArray i)
forall a b. (a -> b) -> a -> b
$ CUInt -> BitArray i
forall i c.
(Ix i, Bounded i, Integral c, Enum i) =>
c -> BitArray i
pack CUInt
bs
        orEmpty :: (Bounded a, Enum a, Ix a) => Maybe (A.BitArray a) -> A.BitArray a
        orEmpty :: Maybe (BitArray a) -> BitArray a
orEmpty = BitArray a -> Maybe (BitArray a) -> BitArray a
forall a. a -> Maybe a -> a
Y.fromMaybe (BitArray a -> Maybe (BitArray a) -> BitArray a)
-> BitArray a -> Maybe (BitArray a) -> BitArray a
forall a b. (a -> b) -> a -> b
$ CUInt -> BitArray a
forall i c.
(Ix i, Bounded i, Integral c, Enum i) =>
c -> BitArray i
pack CUInt
empty
        empty :: CUInt
empty = CUInt
0x0 :: CBitfield


-- | Describe the driver used by the session in a human-readable (English)
-- manner.  See also 'driverId'.
driverName :: Cdio -> IO (Maybe String)
driverName :: Cdio -> IO (Maybe String)
driverName Cdio
c = Cdio -> (Ptr Cdio -> IO (Ptr CChar)) -> IO (Maybe (Ptr CChar))
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c Ptr Cdio -> IO (Ptr CChar)
driverName' IO (Maybe (Ptr CChar))
-> (Maybe (Ptr CChar) -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe String)
-> (Ptr CChar -> IO (Maybe String))
-> Maybe (Ptr CChar)
-> 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) ((Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr CChar -> IO String
C.peekCString)

foreign import ccall safe "cdio/compat/device.h cdio_get_driver_name"
  driverName' :: C.Ptr Cdio -> IO C.CString

{- Not exported
-- | Describe the IO driver in a human-readable manner, as opposed to the
-- machine representation returned by the 'Show' instance.
driverNameFromId :: DriverId -> String
driverNameFromId d = IO.Unsafe.unsafePerformIO $ driverNameFromId d >>= C.peekCString

foreign import ccall safe "cdio/compat/device.h cdio_get_driver_name_from_id"
  driverNameFromId' :: DriverId -> C.CString
-}

-- | The machine-readable identifier of the driver used by the session.  This
-- should be preferred to 'driverName' wherever possible.
-- 
-- Returns 'Nothing' if the 'Cdio' object has already been closed.
driverId :: Cdio -> IO (Maybe DriverId)
driverId :: Cdio -> IO (Maybe DriverId)
driverId Cdio
c = (CDriverReturnCode -> DriverId)
-> Maybe CDriverReturnCode -> Maybe DriverId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> DriverId
forall a. Enum a => Int -> a
toEnum (Int -> DriverId)
-> (CDriverReturnCode -> Int) -> CDriverReturnCode -> DriverId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Maybe CDriverReturnCode -> Maybe DriverId)
-> IO (Maybe CDriverReturnCode) -> IO (Maybe DriverId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio
-> (Ptr Cdio -> IO CDriverReturnCode)
-> IO (Maybe CDriverReturnCode)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c Ptr Cdio -> IO CDriverReturnCode
driverId'

foreign import ccall safe "cdio/compat/device.h cdio_get_driver_id"
  driverId' :: C.Ptr Cdio -> IO CDriverId

-- | Get a description of the hardware associated with a particular session.
-- 
-- Returns 'Nothing' if the 'Cdio' object has already been closed, or if an
-- error occurred in retrieval.
hwinfo :: Cdio -> IO (Maybe HardwareInfo)
hwinfo :: Cdio -> IO (Maybe HardwareInfo)
hwinfo Cdio
c = (Ptr HardwareInfo -> IO (Maybe HardwareInfo))
-> IO (Maybe HardwareInfo)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr HardwareInfo -> IO (Maybe HardwareInfo))
 -> IO (Maybe HardwareInfo))
-> (Ptr HardwareInfo -> IO (Maybe HardwareInfo))
-> IO (Maybe HardwareInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr HardwareInfo
h -> do
    Maybe CBool
b <- Cdio -> (Ptr Cdio -> IO CBool) -> IO (Maybe CBool)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c ((Ptr Cdio -> IO CBool) -> IO (Maybe CBool))
-> (Ptr Cdio -> IO CBool) -> IO (Maybe CBool)
forall a b. (a -> b) -> a -> b
$ (Ptr Cdio -> Ptr HardwareInfo -> IO CBool)
-> Ptr HardwareInfo -> Ptr Cdio -> IO CBool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Cdio -> Ptr HardwareInfo -> IO CBool
hwinfo' Ptr HardwareInfo
h
    case CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
M.toBool (CBool -> Bool) -> Maybe CBool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CBool
b of
        Just Bool
True -> (Ptr HardwareInfo -> IO HardwareInfo)
-> Ptr HardwareInfo -> IO (Maybe HardwareInfo)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr HardwareInfo -> IO HardwareInfo
forall a. Storable a => Ptr a -> IO a
S.peek Ptr HardwareInfo
h
        Maybe Bool
_ -> Maybe HardwareInfo -> IO (Maybe HardwareInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe HardwareInfo
forall a. Maybe a
Nothing

foreign import ccall safe "cdio/compat/device.h cdio_get_hwinfo"
  hwinfo' :: C.Ptr Cdio -> C.Ptr HardwareInfo -> IO CBool


-- | Get the starting address of the last write session of a disc.
lastSession :: Cdio -> IO (Either DriverReturnCode Lsn)
lastSession :: Cdio -> IO (Either DriverReturnCode Lsn)
lastSession Cdio
c = (Ptr Lsn -> IO (Either DriverReturnCode Lsn))
-> IO (Either DriverReturnCode Lsn)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
M.alloca ((Ptr Lsn -> IO (Either DriverReturnCode Lsn))
 -> IO (Either DriverReturnCode Lsn))
-> (Ptr Lsn -> IO (Either DriverReturnCode Lsn))
-> IO (Either DriverReturnCode Lsn)
forall a b. (a -> b) -> a -> b
$ \Ptr Lsn
l -> do
    Maybe CDriverReturnCode
r <- Cdio
-> (Ptr Cdio -> IO CDriverReturnCode)
-> IO (Maybe CDriverReturnCode)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c ((Ptr Cdio -> IO CDriverReturnCode)
 -> IO (Maybe CDriverReturnCode))
-> (Ptr Cdio -> IO CDriverReturnCode)
-> IO (Maybe CDriverReturnCode)
forall a b. (a -> b) -> a -> b
$ (Ptr Cdio -> Ptr Lsn -> IO CDriverReturnCode)
-> Ptr Lsn -> Ptr Cdio -> IO CDriverReturnCode
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Cdio -> Ptr Lsn -> IO CDriverReturnCode
lastSession' Ptr Lsn
l
    Lsn
l' <- Ptr Lsn -> IO Lsn
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Lsn
l
    Either DriverReturnCode Lsn -> IO (Either DriverReturnCode Lsn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DriverReturnCode Lsn -> IO (Either DriverReturnCode Lsn))
-> Either DriverReturnCode Lsn -> IO (Either DriverReturnCode Lsn)
forall a b. (a -> b) -> a -> b
$ case Int -> DriverReturnCode
forall a. Enum a => Int -> a
toEnum (Int -> DriverReturnCode)
-> (CDriverReturnCode -> Int)
-> CDriverReturnCode
-> DriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDriverReturnCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CDriverReturnCode -> DriverReturnCode)
-> Maybe CDriverReturnCode -> Maybe DriverReturnCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CDriverReturnCode
r of
        Just DriverReturnCode
Success -> Lsn -> Either DriverReturnCode Lsn
forall a b. b -> Either a b
Right Lsn
l'
        Just DriverReturnCode
e -> DriverReturnCode -> Either DriverReturnCode Lsn
forall a b. a -> Either a b
Left DriverReturnCode
e
        Maybe DriverReturnCode
Nothing -> DriverReturnCode -> Either DriverReturnCode Lsn
forall a b. a -> Either a b
Left DriverReturnCode
Uninitialized

foreign import ccall safe "cdio/compat/device.h cdio_get_last_session"
  lastSession' :: C.Ptr Cdio -> C.Ptr Lsn -> IO CDriverReturnCode


-- | Find out if the media has changed since the last call.
isMediaChanged :: Cdio -> IO (Either DriverReturnCode Bool)
isMediaChanged :: Cdio -> IO (Either DriverReturnCode Bool)
isMediaChanged Cdio
c = Either DriverReturnCode Bool
-> (CDriverReturnCode -> Either DriverReturnCode Bool)
-> Maybe CDriverReturnCode
-> Either DriverReturnCode Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DriverReturnCode -> Either DriverReturnCode Bool
forall a b. a -> Either a b
Left DriverReturnCode
Uninitialized) CDriverReturnCode -> Either DriverReturnCode Bool
forall a b. (Integral a, Enum b) => a -> Either b Bool
errorOrBool (Maybe CDriverReturnCode -> Either DriverReturnCode Bool)
-> IO (Maybe CDriverReturnCode)
-> IO (Either DriverReturnCode Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio
-> (Ptr Cdio -> IO CDriverReturnCode)
-> IO (Maybe CDriverReturnCode)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c Ptr Cdio -> IO CDriverReturnCode
isMediaChanged'

foreign import ccall safe "cdio/compat/device.h cdio_get_media_changed"
  isMediaChanged' :: C.Ptr Cdio -> IO CDriverReturnCode


-- | Determine if the device understands ATAPI commands.
-- 
-- Returns 'Nothing' if the 'Cdio' object has already been closed, or if the
-- capability can't be determined.
haveAtapi :: Cdio -> IO (Maybe Bool)
haveAtapi :: Cdio -> IO (Maybe Bool)
haveAtapi Cdio
c = (Maybe (Maybe Bool) -> Maybe Bool)
-> IO (Maybe (Maybe Bool)) -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a. Monad m => m (m a) -> m a
N.join (IO (Maybe (Maybe Bool)) -> IO (Maybe Bool))
-> ((Ptr Cdio -> IO (Maybe Bool)) -> IO (Maybe (Maybe Bool)))
-> (Ptr Cdio -> IO (Maybe Bool))
-> IO (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cdio -> (Ptr Cdio -> IO (Maybe Bool)) -> IO (Maybe (Maybe Bool))
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c ((Ptr Cdio -> IO (Maybe Bool)) -> IO (Maybe Bool))
-> (Ptr Cdio -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ (CDriverReturnCode -> Maybe Bool)
-> IO CDriverReturnCode -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CDriverReturnCode -> Maybe Bool
bool3 (IO CDriverReturnCode -> IO (Maybe Bool))
-> (Ptr Cdio -> IO CDriverReturnCode)
-> Ptr Cdio
-> IO (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Cdio -> IO CDriverReturnCode
haveAtapi'

foreign import ccall safe "cdio/compat/device.h cdio_have_atapi"
  haveAtapi' :: C.Ptr Cdio -> IO C.CInt


-- | Determine whether the system provides a particular driver.
haveDriver :: DriverId -> Bool
haveDriver :: DriverId -> Bool
haveDriver = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
M.toBool (CBool -> Bool) -> (DriverId -> CBool) -> DriverId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDriverReturnCode -> CBool
haveDriver' (CDriverReturnCode -> CBool)
-> (DriverId -> CDriverReturnCode) -> DriverId -> CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode)
-> (DriverId -> Int) -> DriverId -> CDriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DriverId -> Int
forall a. Enum a => a -> Int
fromEnum

foreign import ccall safe "cdio/compat/device.h cdio_have_driver"
  haveDriver' :: CDriverId -> CBool


{- Encapsulated into the 'ForeignPtr Cdio'.
-- | Free any resources associated with a reading session.
cdioDestroy :: Cdio -> IO ()
cdioDestroy = flip withCdio cdioDestroy'

foreign import ccall safe "cdio/compat/device.h cdio_destroy"
  cdioDestroy' :: C.Ptr Cdio -> IO ()
-}


-- | Describe the IO driver in a human-readable manner, as opposed to the
-- machine representation returned by the 'Show' instance.
driverDescribe :: DriverId -> String
driverDescribe :: DriverId -> String
driverDescribe = IO String -> String
forall a. IO a -> a
IO.Unsafe.unsafePerformIO (IO String -> String)
-> (DriverId -> IO String) -> DriverId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Ptr CChar -> IO String
C.peekCString (Ptr CChar -> IO String)
-> (DriverId -> Ptr CChar) -> DriverId -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDriverReturnCode -> Ptr CChar
driverDescribe' (CDriverReturnCode -> Ptr CChar)
-> (DriverId -> CDriverReturnCode) -> DriverId -> Ptr CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode)
-> (DriverId -> Int) -> DriverId -> CDriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DriverId -> Int
forall a. Enum a => a -> Int
fromEnum

foreign import ccall safe "cdio/compat/device.h cdio_driver_describe"
  driverDescribe' :: CDriverId -> C.CString


-- | Open a session referencing the given location, or the default device if
-- passed 'Nothing'.
cdioOpen :: Maybe FilePath -> DriverId -> IO (Maybe Cdio)
cdioOpen :: Maybe String -> DriverId -> IO (Maybe Cdio)
cdioOpen Maybe String
f DriverId
d = (String -> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio))
-> Maybe String
-> (Ptr CChar -> IO (Maybe Cdio))
-> IO (Maybe Cdio)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
M.maybeWith String -> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString Maybe String
f ((Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio))
-> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
f' -> do
    IO ()
setupLogger
    Ptr Cdio
c' <- Ptr CChar -> CDriverReturnCode -> IO (Ptr Cdio)
cdioOpen' Ptr CChar
f' (Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode) -> Int -> CDriverReturnCode
forall a b. (a -> b) -> a -> b
$ DriverId -> Int
forall a. Enum a => a -> Int
fromEnum DriverId
d)
    (Ptr Cdio -> IO Cdio) -> Ptr Cdio -> IO (Maybe Cdio)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr Cdio -> IO Cdio
peekCdio Ptr Cdio
c'

foreign import ccall safe "cdio/compat/device.h cdio_open"
  cdioOpen' :: C.CString -> CDriverId -> IO (C.Ptr Cdio)

-- | Open a session referencing the given location, or the default device if
-- passed 'Nothing', with the desired access mode.
cdioOpenAm :: Maybe FilePath -> DriverId -> AccessMode -> IO (Maybe Cdio)
cdioOpenAm :: Maybe String -> DriverId -> AccessMode -> IO (Maybe Cdio)
cdioOpenAm Maybe String
f DriverId
d AccessMode
m = (String -> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio))
-> Maybe String
-> (Ptr CChar -> IO (Maybe Cdio))
-> IO (Maybe Cdio)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
M.maybeWith String -> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString Maybe String
f ((Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio))
-> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
f' -> String -> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString (AccessMode -> String
serializeAccessMode AccessMode
m) ((Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio))
-> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
m' -> do
    IO ()
setupLogger
    Ptr Cdio
c' <- Ptr CChar -> CDriverReturnCode -> Ptr CChar -> IO (Ptr Cdio)
cdioOpenAm' Ptr CChar
f' (Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CDriverReturnCode) -> Int -> CDriverReturnCode
forall a b. (a -> b) -> a -> b
$ DriverId -> Int
forall a. Enum a => a -> Int
fromEnum DriverId
d) Ptr CChar
m'
    (Ptr Cdio -> IO Cdio) -> Ptr Cdio -> IO (Maybe Cdio)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr Cdio -> IO Cdio
peekCdio Ptr Cdio
c'

foreign import ccall safe "cdio/compat/device.h cdio_open_am"
  cdioOpenAm' :: C.CString -> CDriverId -> C.CString -> IO (C.Ptr Cdio)


open'
    :: (C.CString -> IO (C.Ptr Cdio))
    -> Maybe FilePath
    -> IO (Maybe Cdio)
open' :: (Ptr CChar -> IO (Ptr Cdio)) -> Maybe String -> IO (Maybe Cdio)
open' Ptr CChar -> IO (Ptr Cdio)
f Maybe String
p = Maybe String -> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a. Maybe String -> (Ptr CChar -> IO a) -> IO a
withCStringNull Maybe String
p ((Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio))
-> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
p' -> do
    IO ()
setupLogger
    Ptr CChar -> IO (Ptr Cdio)
f Ptr CChar
p' IO (Ptr Cdio) -> (Ptr Cdio -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr Cdio -> IO Cdio) -> Ptr Cdio -> IO (Maybe Cdio)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr Cdio -> IO Cdio
peekCdio

openAm'
    :: (C.CString -> C.CString -> IO (C.Ptr Cdio))
    -> Maybe FilePath
    -> AccessMode
    -> IO (Maybe Cdio)
openAm' :: (Ptr CChar -> Ptr CChar -> IO (Ptr Cdio))
-> Maybe String -> AccessMode -> IO (Maybe Cdio)
openAm' Ptr CChar -> Ptr CChar -> IO (Ptr Cdio)
f Maybe String
p AccessMode
m = Maybe String -> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a. Maybe String -> (Ptr CChar -> IO a) -> IO a
withCStringNull Maybe String
p ((Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio))
-> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
p' -> String -> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString (AccessMode -> String
serializeAccessMode AccessMode
m) ((Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio))
-> (Ptr CChar -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
m' -> do
    IO ()
setupLogger
    Ptr CChar -> Ptr CChar -> IO (Ptr Cdio)
f Ptr CChar
p' Ptr CChar
m' IO (Ptr Cdio) -> (Ptr Cdio -> IO (Maybe Cdio)) -> IO (Maybe Cdio)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr Cdio -> IO Cdio) -> Ptr Cdio -> IO (Maybe Cdio)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr Cdio -> IO Cdio
peekCdio

withCStringNull :: Maybe String -> (C.CString -> IO a) -> IO a
withCStringNull :: Maybe String -> (Ptr CChar -> IO a) -> IO a
withCStringNull Maybe String
Nothing Ptr CChar -> IO a
f = Ptr CChar -> IO a
f Ptr CChar
forall a. Ptr a
C.nullPtr
withCStringNull (Just String
str) Ptr CChar -> IO a
f = String -> (Ptr CChar -> IO a) -> IO a
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString String
str Ptr CChar -> IO a
f


-- | Set up the specified CD-ROM device for reading.
cdioOpenCd :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenCd :: Maybe String -> IO (Maybe Cdio)
cdioOpenCd = (Ptr CChar -> IO (Ptr Cdio)) -> Maybe String -> IO (Maybe Cdio)
open' Ptr CChar -> IO (Ptr Cdio)
cdioOpenCd'

foreign import ccall safe "cdio/compat/device.h cdio_open_cd"
  cdioOpenCd' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up the specified CD-ROM device for reading, with the desired access
-- mode.
cdioOpenAmCd :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmCd :: Maybe String -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmCd = (Ptr CChar -> Ptr CChar -> IO (Ptr Cdio))
-> Maybe String -> AccessMode -> IO (Maybe Cdio)
openAm' Ptr CChar -> Ptr CChar -> IO (Ptr Cdio)
cdioOpenAmCd'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_cd"
  cdioOpenAmCd' :: C.CString -> C.CString -> IO (C.Ptr Cdio)


{- All the official bindings hide these, which makes me think they're not as reliable.
defaultPath' :: IO C.CString -> IO (Maybe FilePath)
defaultPath' p = p >>= M.maybePeek C.peekCString

deviceList' :: IO (C.Ptr C.CString) -> IO [FilePath]
deviceList' ps = ps >>= peekFStringArray


-- | Set up a BIN/CUE disc image for reading.
cdioOpenBinCue
    :: Maybe FilePath
        -- ^ The path to either the @*.bin@ or the @*.cue@ file.
    -> IO (Maybe Cdio)
cdioOpenBinCue = open' cdioOpenBinCue'

foreign import ccall safe "cdio/compat/device.h cdio_open_bincue"
  cdioOpenBinCue' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a BIN/CUE disc image for reading, with the desired access mode.
cdioOpenAmBinCue
    :: Maybe FilePath
        -- ^ The path to either the @*.bin@ or the @*.cue@ file.
    -> AccessMode
    -> IO (Maybe Cdio)
cdioOpenAmBinCue = openAm' cdioOpenAmBinCue'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_bincue"
  cdioOpenAmBinCue' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default CUE file that would be used if none is specified.
defaultDeviceBinCue :: IO (Maybe FilePath)
defaultDeviceBinCue = defaultPath' defaultDeviceBinCue'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_bincue"
  defaultDeviceBinCue' :: IO C.CString

-- | The CUE files contained in the current directory.
devicesBinCue :: IO [FilePath]
devicesBinCue = deviceList' devicesBinCue'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_bincue"
  devicesBinCue' :: IO (C.Ptr C.CString)


-- | Set up a cdrdao disc image for reading.
cdioOpenCdrDao
    :: Maybe FilePath
        -- ^ The path to the @*.toc@ file.
    -> IO (Maybe Cdio)
cdioOpenCdrDao = open' cdioOpenCdrDao'

foreign import ccall safe "cdio/compat/device.h cdio_open_cdrdao"
  cdioOpenCdrDao' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a cdrdao disc image for reading, with the desired access mode.
cdioOpenAmCdrDao
    :: Maybe FilePath
        -- ^ The path to the @*.toc@ file.
    -> AccessMode
    -> IO (Maybe Cdio)
cdioOpenAmCdrDao = openAm' cdioOpenAmCdrDao'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_cdrdao"
  cdioOpenAmCdrDao' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default TOC file that would be used if none is specified.
defaultDeviceCdrDao :: IO (Maybe FilePath)
defaultDeviceCdrDao = defaultPath' defaultDeviceCdrDao'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_cdrdao"
  defaultDeviceCdrDao' :: IO C.CString

-- | Paths to potential TOC disc images.
devicesCdrDao :: IO [FilePath]
devicesCdrDao = deviceList' devicesCdrDao'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_cdrdao"
  devicesCdrDao' :: IO (C.Ptr C.CString)


-- | Set up a BIN/CUE disc image for reading.  Unlike 'cdioOpenBinCue' which
-- may reference either, this path /must/ point to the @*.cue@ file.
cdioOpenCue :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenCue = open' cdioOpenCue'

foreign import ccall safe "cdio/compat/device.h cdio_open_cue"
  cdioOpenCue' :: C.CString -> IO (C.Ptr Cdio)


-- | Set up a device for reading using the AIX driver.
cdioOpenAix :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenAix = open' cdioOpenAix'

foreign import ccall safe "cdio/compat/device.h cdio_open_aix"
  cdioOpenAix' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a device for reading using the AIX driver, with the desired access
-- mode.
cdioOpenAmAix :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmAix = openAm' cdioOpenAmAix'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_aix"
  cdioOpenAmAix' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default device name that the AIX driver would use if none is
-- specified.
defaultDeviceAix :: IO (Maybe FilePath)
defaultDeviceAix = defaultPath' defaultDeviceAix'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_aix"
  defaultDeviceAix' :: IO C.CString

-- | All of the devices that the AIX driver can find.  This may require a disc
-- to be inserted in order for the system to recognize the drive.
devicesAix :: IO [FilePath]
devicesAix = deviceList' devicesAix'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_aix"
  devicesAix' :: IO (C.Ptr C.CString)


-- | Set up a device for reading using the FreeBSD driver.
cdioOpenFreeBsd :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenFreeBsd = open' cdioOpenFreeBsd'

foreign import ccall safe "cdio/compat/device.h cdio_open_freebsd"
  cdioOpenFreeBsd' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a device for reading using the FreeBSD driver, with the desired
-- access mode.
cdioOpenAmFreeBsd :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmFreeBsd = openAm' cdioOpenAmFreeBsd'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_freebsd"
  cdioOpenAmFreeBsd' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default device name that the FreeBSD driver would use if none is
-- specified.
defaultDeviceFreeBsd :: IO (Maybe FilePath)
defaultDeviceFreeBsd = defaultPath' defaultDeviceFreeBsd'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_freebsd"
  defaultDeviceFreeBsd' :: IO C.CString

-- | All of the devices that the FreeBSD driver can find.  This may require a
-- disc to be inserted in order for the system to recognize the drive.
devicesFreeBsd :: IO [FilePath]
devicesFreeBsd = deviceList' devicesFreeBsd'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_freebsd"
  devicesFreeBsd' :: IO (C.Ptr C.CString)


-- | Set up a device for reading using the BSDI driver.
-- 
-- /Since libcdio 1.0:  Always returns 'Nothing'/
cdioOpenBsdi :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenBsdi = open' cdioOpenBsdi'

foreign import ccall safe "cdio/compat/device.h cdio_open_bsdi_safe"
  cdioOpenBsdi' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a device for reading using the BSDI driver, with the desired access
-- mode.
-- 
-- /Since libcdio 1.0:  Always returns 'Nothing'/
cdioOpenAmBsdi :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmBsdi = openAm' cdioOpenAmBsdi'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_bsdi_safe"
  cdioOpenAmBsdi' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default device name that the BSDI driver would use if none is
-- specified.
-- 
-- /Since libcdio 1.0:  Always returns 'Nothing'/
defaultDeviceBsdi :: IO (Maybe FilePath)
defaultDeviceBsdi = defaultPath' defaultDeviceBsdi'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_bsdi_safe"
  defaultDeviceBsdi' :: IO C.CString

-- | All of the devices that the BSDI driver can find.  This may require a disc
-- to be inserted in order for the system to recognize the drive.
-- 
-- /Since libcdio 1.0:  Always returns @[]@/
devicesBsdi :: IO [FilePath]
devicesBsdi = deviceList' devicesBsdi'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_bsdi_safe"
  devicesBsdi' :: IO (C.Ptr C.CString)


-- | Set up a device for reading using the GNU/Linux driver.  This may require
-- a disc to be inserted in order for the system to recognize the drive.
cdioOpenLinux :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenLinux = open' cdioOpenLinux'

foreign import ccall safe "cdio/compat/device.h cdio_open_linux"
  cdioOpenLinux' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a device for reading using the GNU/Linux driver, with the desired
-- access mode.
cdioOpenAmLinux :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmLinux = openAm' cdioOpenAmLinux'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_linux"
  cdioOpenAmLinux' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default device name that the GNU/Linux driver would use if none is
-- specified.  This may require a disc to be inserted in order for the system to
-- recognize the drive.
defaultDeviceLinux :: IO (Maybe FilePath)
defaultDeviceLinux = defaultPath' defaultDeviceLinux'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_linux"
  defaultDeviceLinux' :: IO C.CString

-- | All of the devices that the GNU/Linux driver can find.
devicesLinux :: IO [FilePath]
devicesLinux = deviceList' devicesLinux'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_linux"
  devicesLinux' :: IO (C.Ptr C.CString)


-- | Set up a device for reading using the Sun Solaris driver.  This may
-- require a disc to be inserted in order for the system to recognize the
-- drive.
cdioOpenSolaris :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenSolaris = open' cdioOpenSolaris'

foreign import ccall safe "cdio/compat/device.h cdio_open_solaris"
  cdioOpenSolaris' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a device for reading using the Sun Solaris driver, with the desired
-- access mode.
cdioOpenAmSolaris :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmSolaris = openAm' cdioOpenAmSolaris'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_solaris"
  cdioOpenAmSolaris' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default device name that the Solaris driver would use if none is
-- specified.  This may require a disc to be inserted in order for the system
-- to recognize the drive.
defaultDeviceSolaris :: IO (Maybe FilePath)
defaultDeviceSolaris = defaultPath' defaultDeviceSolaris'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_solaris"
  defaultDeviceSolaris' :: IO C.CString

-- | All of the devices that the Solaris driver can find.
devicesSolaris :: IO [FilePath]
devicesSolaris = deviceList' devicesSolaris'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_solaris"
  devicesSolaris' :: IO (C.Ptr C.CString)


-- | Set up a device for reading using the Apple OSX driver.  This may require
-- a disc to be inserted in order for the system to recognize the drive.
cdioOpenOsX :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenOsX = open' cdioOpenOsX'

foreign import ccall safe "cdio/compat/device.h cdio_open_osx"
  cdioOpenOsX' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a device for reading using the Apple OSX driver, with the desired
-- access mode.
cdioOpenAmOsX :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmOsX = openAm' cdioOpenAmOsX'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_osx"
  cdioOpenAmOsX' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default device name that the OSX driver would use if none is
-- specified.  This may require a disc to be inserted in order for the system
-- to recognize the drive.
defaultDeviceOsX :: IO (Maybe FilePath)
defaultDeviceOsX = defaultPath' defaultDeviceOsX'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_osx"
  defaultDeviceOsX' :: IO C.CString

-- | All of the devices that the OSX driver can find.
devicesOsX :: IO [FilePath]
devicesOsX = deviceList' devicesOsX'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_osx"
  devicesOsX' :: IO (C.Ptr C.CString)


-- | Set up a device for reading using the Microsoft Windows driver.  This may
-- require a disc to be inserted in order for the system to recognize the
-- drive.
cdioOpenWin32 :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenWin32 = open' cdioOpenWin32'

foreign import ccall safe "cdio/compat/device.h cdio_open_win32"
  cdioOpenWin32' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a device for reading using the Microsoft Windows driver, with the
-- desired access mode.
cdioOpenAmWin32 :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmWin32 = openAm' cdioOpenAmWin32'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_win32"
  cdioOpenAmWin32' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default device name that the Microsoft Windows driver would use if
-- none is specified.  This may require a disc to be inserted in order for the
-- system to recognize the drive.
defaultDeviceWin32 :: IO (Maybe FilePath)
defaultDeviceWin32 = defaultPath' defaultDeviceWin32'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_win32"
  defaultDeviceWin32' :: IO C.CString

-- | All of the devices that the Microsoft Windows driver can find.
devicesWin32 :: IO [FilePath]
devicesWin32 = deviceList' devicesWin32'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_win32"
  devicesWin32' :: IO (C.Ptr C.CString)


-- | Set up a device for reading using the IBM OS/2 driver.  This may require a
-- disc to be inserted in order for the system to recognize the drive.
-- 
-- /Since libcdio 1.0:  Always returns 'Nothing'/
cdioOpenOs2 :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenOs2 = open' cdioOpenOs2'

foreign import ccall safe "cdio/compat/device.h cdio_open_os2_safe"
  cdioOpenOs2' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a device for reading using the IBM OS/2 driver, with the desired
-- access mode.
-- 
-- /Since libcdio 1.0:  Always returns 'Nothing'/
cdioOpenAmOs2 :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmOs2 = openAm' cdioOpenAmOs2'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_os2_safe"
  cdioOpenAmOs2' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default device name that the OS/2 driver would use if none is
-- specified.  This may require a disc to be inserted in order for the system
-- to recognize the drive.
-- 
-- /Since libcdio 1.0:  Always returns 'Nothing'/
defaultDeviceOs2 :: IO (Maybe FilePath)
defaultDeviceOs2 = defaultPath' defaultDeviceOs2'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_os2_safe"
  defaultDeviceOs2' :: IO C.CString

-- | All of the devices that the OS/2 driver can find.
-- 
-- /Since libcdio 1.0:  Always returns @[]@/
devicesOs2 :: IO [FilePath]
devicesOs2 = deviceList' devicesOs2'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_os2_safe"
  devicesOs2' :: IO (C.Ptr C.CString)


-- | Set up a Nero disc image for reading.
cdioOpenNero :: Maybe FilePath -> IO (Maybe Cdio)
cdioOpenNero = open' cdioOpenNero'

foreign import ccall safe "cdio/compat/device.h cdio_open_nrg"
  cdioOpenNero' :: C.CString -> IO (C.Ptr Cdio)

-- | Set up a Nero disc image for reading, with the desired access mode.
cdioOpenAmNero :: Maybe FilePath -> AccessMode -> IO (Maybe Cdio)
cdioOpenAmNero = openAm' cdioOpenAmNero'

foreign import ccall safe "cdio/compat/device.h cdio_open_am_nrg"
  cdioOpenAmNero' :: C.CString -> C.CString -> IO (C.Ptr Cdio)

-- | The default image file that the Nero driver would use if none is
-- specified.
defaultDeviceNero :: IO (Maybe FilePath)
defaultDeviceNero = defaultPath' defaultDeviceNero'

foreign import ccall safe "cdio/compat/device.h cdio_get_default_device_nrg"
  defaultDeviceNero' :: IO C.CString

-- | Paths to potential Nero disc images.
devicesNero :: IO [FilePath]
devicesNero = deviceList' devicesNero'

foreign import ccall safe "cdio/compat/device.h cdio_get_devices_nrg"
  devicesNero' :: IO (C.Ptr C.CString)
-}


-- | If the given file is a BIN disc image (determined by file extension),
-- return the corresponding CUE file.  Note that this simply replaces the
-- extension to obtain the new file name.
cueFromBin :: FilePath -> IO (Maybe FilePath)
cueFromBin :: String -> IO (Maybe String)
cueFromBin String
f = String -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString String
f Ptr CChar -> IO (Ptr CChar)
cueFromBin' IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr CChar -> IO String
C.peekCString

foreign import ccall safe "cdio/compat/device.h cdio_is_binfile"
  cueFromBin' :: C.CString -> IO C.CString

-- | If the given file is a valid CUE disc description, return the
-- corresponding BIN file.  Note that this simply replaces the file extension
-- to obtain the new file name.
binFromCue :: FilePath -> IO (Maybe FilePath)
binFromCue :: String -> IO (Maybe String)
binFromCue String
f = String -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString String
f Ptr CChar -> IO (Ptr CChar)
binFromCue' IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr CChar -> IO String
C.peekCString

foreign import ccall safe "cdio/compat/device.h cdio_is_cuefile"
  binFromCue' :: C.CString -> IO C.CString

-- | Check that a Nero disc image file is valid.
isNrg :: FilePath -> IO Bool
isNrg :: String -> IO Bool
isNrg = (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
M.toBool (IO CBool -> IO Bool) -> (String -> IO CBool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Ptr CChar -> IO CBool) -> IO CBool)
-> (Ptr CChar -> IO CBool) -> String -> IO CBool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> (Ptr CChar -> IO CBool) -> IO CBool
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString Ptr CChar -> IO CBool
isNrg'

foreign import ccall safe "cdio/compat/device.h cdio_is_nrg"
  isNrg' :: C.CString -> IO CBool

-- | Check that a cdrdao-style TOC description file is valid.
isToc :: FilePath -> IO Bool
isToc :: String -> IO Bool
isToc = (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
M.toBool (IO CBool -> IO Bool) -> (String -> IO CBool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Ptr CChar -> IO CBool) -> IO CBool)
-> (Ptr CChar -> IO CBool) -> String -> IO CBool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> (Ptr CChar -> IO CBool) -> IO CBool
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString Ptr CChar -> IO CBool
isToc'

foreign import ccall safe "cdio/compat/device.h cdio_is_tocfile"
  isToc' :: C.CString -> IO CBool

-- | Determine whether the given path refers to a hardware device, according to
-- the given driver.  'DriverUnknown' or 'DriverDevice' may be passed if the
-- system is unknown.
isDevice :: FilePath -> DriverId -> IO Bool
isDevice :: String -> DriverId -> IO Bool
isDevice String
f DriverId
d = CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
M.toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Ptr CChar -> IO CBool) -> IO CBool
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString String
f ((Ptr CChar -> CDriverReturnCode -> IO CBool)
-> CDriverReturnCode -> Ptr CChar -> IO CBool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr CChar -> CDriverReturnCode -> IO CBool
isDevice' (CDriverReturnCode -> Ptr CChar -> IO CBool)
-> (Int -> CDriverReturnCode) -> Int -> Ptr CChar -> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Ptr CChar -> IO CBool) -> Int -> Ptr CChar -> IO CBool
forall a b. (a -> b) -> a -> b
$ DriverId -> Int
forall a. Enum a => a -> Int
fromEnum DriverId
d)

foreign import ccall safe "cdio/compat/device.h cdio_is_device"
  isDevice' :: C.CString -> CDriverId -> IO CBool


-- | Set the blocksize for subsequent reads.
setBlocksize
    :: Cdio
        -- ^ The CdText object is mutated as a result of the function.
    -> Int
    -> IO DriverReturnCode
setBlocksize :: Cdio -> Int -> IO DriverReturnCode
setBlocksize Cdio
c Int
s = Maybe CDriverReturnCode -> DriverReturnCode
toDriverReturnCode (Maybe CDriverReturnCode -> DriverReturnCode)
-> IO (Maybe CDriverReturnCode) -> IO DriverReturnCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio
-> (Ptr Cdio -> IO CDriverReturnCode)
-> IO (Maybe CDriverReturnCode)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c ((Ptr Cdio -> CDriverReturnCode -> IO CDriverReturnCode)
-> CDriverReturnCode -> Ptr Cdio -> IO CDriverReturnCode
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Cdio -> CDriverReturnCode -> IO CDriverReturnCode
setBlocksize' (CDriverReturnCode -> Ptr Cdio -> IO CDriverReturnCode)
-> CDriverReturnCode -> Ptr Cdio -> IO CDriverReturnCode
forall a b. (a -> b) -> a -> b
$ Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)

foreign import ccall safe "cdio/compat/device.h cdio_set_blocksize"
  setBlocksize' :: C.Ptr Cdio -> C.CInt -> IO CDriverReturnCode

-- | Set the drive speed.  With many devices, if a value above their maximum
-- speed is given, it will be silently capped.
--
-- Note that, unlike 'MMC.setSpeed', this uses a unit unique to disc drives,
-- which depends on the type of disc; to convert to or from Kb/s, use the
-- formula @dt * cds = kbs@ where @dt@ is either @176@ for raw data or @150@
-- for filesystem data, and @cds@ is the 'Int' passed to this function.
setSpeed
    :: Cdio
        -- ^ The CdText object is mutated as a result of the function.
    -> Int
    -> IO DriverReturnCode
setSpeed :: Cdio -> Int -> IO DriverReturnCode
setSpeed Cdio
c Int
v = Maybe CDriverReturnCode -> DriverReturnCode
toDriverReturnCode (Maybe CDriverReturnCode -> DriverReturnCode)
-> IO (Maybe CDriverReturnCode) -> IO DriverReturnCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cdio
-> (Ptr Cdio -> IO CDriverReturnCode)
-> IO (Maybe CDriverReturnCode)
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c ((Ptr Cdio -> CDriverReturnCode -> IO CDriverReturnCode)
-> CDriverReturnCode -> Ptr Cdio -> IO CDriverReturnCode
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr Cdio -> CDriverReturnCode -> IO CDriverReturnCode
setSpeed' (CDriverReturnCode -> Ptr Cdio -> IO CDriverReturnCode)
-> CDriverReturnCode -> Ptr Cdio -> IO CDriverReturnCode
forall a b. (a -> b) -> a -> b
$ Int -> CDriverReturnCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)

foreign import ccall safe "cdio/compat/device.h cdio_set_speed"
  setSpeed' :: C.Ptr Cdio -> C.CInt -> IO CDriverReturnCode


-- | Retrieve the session value associated with the given key.  The particular
-- case of @"access-mode"@ is instead handled by 'getAccessMode'.
getArg :: Cdio -> SessionArg -> IO (Maybe String)
getArg :: Cdio -> SessionArg -> IO (Maybe String)
getArg Cdio
c SessionArg
k = String -> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString (SessionArg -> String
serializeSessionArg SessionArg
k) ((Ptr CChar -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr CChar -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
k' ->
    Cdio -> (Ptr Cdio -> IO (Ptr CChar)) -> IO (Maybe (Ptr CChar))
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c (Ptr Cdio -> Ptr CChar -> IO (Ptr CChar)
`getArg'` Ptr CChar
k') IO (Maybe (Ptr CChar))
-> (Maybe (Ptr CChar) -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe String)
-> (Ptr CChar -> IO (Maybe String))
-> Maybe (Ptr CChar)
-> 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) ((Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr CChar -> IO String
C.peekCString)

-- | Check what instruction set is in use for reading the disc.  Other session
-- values are handled by 'getArg'.
getAccessMode :: Cdio -> IO (Maybe AccessMode)
getAccessMode :: Cdio -> IO (Maybe AccessMode)
getAccessMode Cdio
c = String
-> (Ptr CChar -> IO (Maybe AccessMode)) -> IO (Maybe AccessMode)
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString String
"access-mode" ((Ptr CChar -> IO (Maybe AccessMode)) -> IO (Maybe AccessMode))
-> (Ptr CChar -> IO (Maybe AccessMode)) -> IO (Maybe AccessMode)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
k' -> do
    Maybe String
str <- Cdio -> (Ptr Cdio -> IO (Ptr CChar)) -> IO (Maybe (Ptr CChar))
forall b. Cdio -> (Ptr Cdio -> IO b) -> IO (Maybe b)
withCdio Cdio
c (Ptr Cdio -> Ptr CChar -> IO (Ptr CChar)
`getArg'` Ptr CChar
k') IO (Maybe (Ptr CChar))
-> (Maybe (Ptr CChar) -> IO (Maybe String)) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe String)
-> (Ptr CChar -> IO (Maybe String))
-> Maybe (Ptr CChar)
-> 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) ((Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek Ptr CChar -> IO String
C.peekCString)
    Maybe AccessMode -> IO (Maybe AccessMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AccessMode -> IO (Maybe AccessMode))
-> Maybe AccessMode -> IO (Maybe AccessMode)
forall a b. (a -> b) -> a -> b
$ (String -> AccessMode) -> Maybe String -> Maybe AccessMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> AccessMode
unserializeAccessMode Maybe String
str

foreign import ccall safe "cdio/compat/device.h cdio_get_arg"
  getArg' :: C.Ptr Cdio -> C.CString -> IO C.CString

{- This is very likely intended for internal use only
-- | Change the session value associated with the given key.
setArg
    :: Cdio
        -- ^ The CdText object is mutated as a result of the function.
    -> SessionArg
    -> String
        -- ^ The new property value.
    -> IO DriverReturnCode
setArg c k v = C.withCString (serializeSessionArg k) $ \k' -> C.withCString v $ \v' ->
    toDriverReturnCode <$> withCdio c (\c' -> setArg' c' k' v')

foreign import ccall safe "cdio/compat/device.h cdio_set_arg"
  setArg' :: C.Ptr Cdio -> C.CString -> C.CString -> IO CDriverReturnCode
-}

-- | Metadata about the session in the form of (often freeform) text, providing
-- a type-safe index to 'getArg'.  Note that not every driver type supports
-- every item.
--
-- The key @"access-mode"@ is handled separately by 'getAccessMode', to better
-- reflect its restricted outputs.
data SessionArg
    = Source
    | Cue
    | ScsiTuple
    | MmcSupported
  deriving ( SessionArg -> SessionArg -> Bool
(SessionArg -> SessionArg -> Bool)
-> (SessionArg -> SessionArg -> Bool) -> Eq SessionArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionArg -> SessionArg -> Bool
$c/= :: SessionArg -> SessionArg -> Bool
== :: SessionArg -> SessionArg -> Bool
$c== :: SessionArg -> SessionArg -> Bool
Eq, Eq SessionArg
Eq SessionArg
-> (SessionArg -> SessionArg -> Ordering)
-> (SessionArg -> SessionArg -> Bool)
-> (SessionArg -> SessionArg -> Bool)
-> (SessionArg -> SessionArg -> Bool)
-> (SessionArg -> SessionArg -> Bool)
-> (SessionArg -> SessionArg -> SessionArg)
-> (SessionArg -> SessionArg -> SessionArg)
-> Ord SessionArg
SessionArg -> SessionArg -> Bool
SessionArg -> SessionArg -> Ordering
SessionArg -> SessionArg -> SessionArg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SessionArg -> SessionArg -> SessionArg
$cmin :: SessionArg -> SessionArg -> SessionArg
max :: SessionArg -> SessionArg -> SessionArg
$cmax :: SessionArg -> SessionArg -> SessionArg
>= :: SessionArg -> SessionArg -> Bool
$c>= :: SessionArg -> SessionArg -> Bool
> :: SessionArg -> SessionArg -> Bool
$c> :: SessionArg -> SessionArg -> Bool
<= :: SessionArg -> SessionArg -> Bool
$c<= :: SessionArg -> SessionArg -> Bool
< :: SessionArg -> SessionArg -> Bool
$c< :: SessionArg -> SessionArg -> Bool
compare :: SessionArg -> SessionArg -> Ordering
$ccompare :: SessionArg -> SessionArg -> Ordering
$cp1Ord :: Eq SessionArg
Ord, SessionArg
SessionArg -> SessionArg -> Bounded SessionArg
forall a. a -> a -> Bounded a
maxBound :: SessionArg
$cmaxBound :: SessionArg
minBound :: SessionArg
$cminBound :: SessionArg
Bounded, Int -> SessionArg
SessionArg -> Int
SessionArg -> [SessionArg]
SessionArg -> SessionArg
SessionArg -> SessionArg -> [SessionArg]
SessionArg -> SessionArg -> SessionArg -> [SessionArg]
(SessionArg -> SessionArg)
-> (SessionArg -> SessionArg)
-> (Int -> SessionArg)
-> (SessionArg -> Int)
-> (SessionArg -> [SessionArg])
-> (SessionArg -> SessionArg -> [SessionArg])
-> (SessionArg -> SessionArg -> [SessionArg])
-> (SessionArg -> SessionArg -> SessionArg -> [SessionArg])
-> Enum SessionArg
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SessionArg -> SessionArg -> SessionArg -> [SessionArg]
$cenumFromThenTo :: SessionArg -> SessionArg -> SessionArg -> [SessionArg]
enumFromTo :: SessionArg -> SessionArg -> [SessionArg]
$cenumFromTo :: SessionArg -> SessionArg -> [SessionArg]
enumFromThen :: SessionArg -> SessionArg -> [SessionArg]
$cenumFromThen :: SessionArg -> SessionArg -> [SessionArg]
enumFrom :: SessionArg -> [SessionArg]
$cenumFrom :: SessionArg -> [SessionArg]
fromEnum :: SessionArg -> Int
$cfromEnum :: SessionArg -> Int
toEnum :: Int -> SessionArg
$ctoEnum :: Int -> SessionArg
pred :: SessionArg -> SessionArg
$cpred :: SessionArg -> SessionArg
succ :: SessionArg -> SessionArg
$csucc :: SessionArg -> SessionArg
Enum, Int -> SessionArg -> ShowS
[SessionArg] -> ShowS
SessionArg -> String
(Int -> SessionArg -> ShowS)
-> (SessionArg -> String)
-> ([SessionArg] -> ShowS)
-> Show SessionArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionArg] -> ShowS
$cshowList :: [SessionArg] -> ShowS
show :: SessionArg -> String
$cshow :: SessionArg -> String
showsPrec :: Int -> SessionArg -> ShowS
$cshowsPrec :: Int -> SessionArg -> ShowS
Show, ReadPrec [SessionArg]
ReadPrec SessionArg
Int -> ReadS SessionArg
ReadS [SessionArg]
(Int -> ReadS SessionArg)
-> ReadS [SessionArg]
-> ReadPrec SessionArg
-> ReadPrec [SessionArg]
-> Read SessionArg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SessionArg]
$creadListPrec :: ReadPrec [SessionArg]
readPrec :: ReadPrec SessionArg
$creadPrec :: ReadPrec SessionArg
readList :: ReadS [SessionArg]
$creadList :: ReadS [SessionArg]
readsPrec :: Int -> ReadS SessionArg
$creadsPrec :: Int -> ReadS SessionArg
Read )
instance S.Storable SessionArg where
    sizeOf :: SessionArg -> Int
sizeOf SessionArg
_ = Ptr CChar -> Int
forall a. Storable a => a -> Int
S.sizeOf (Ptr CChar
forall a. HasCallStack => a
undefined :: C.CString)
    alignment :: SessionArg -> Int
alignment SessionArg
_ = Ptr CChar -> Int
forall a. Storable a => a -> Int
S.alignment (Ptr CChar
forall a. HasCallStack => a
undefined :: C.CString)
    peek :: Ptr SessionArg -> IO SessionArg
peek Ptr SessionArg
p = do
        Ptr CChar
p' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
S.peek (Ptr (Ptr CChar) -> IO (Ptr CChar))
-> Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr SessionArg -> Ptr (Ptr CChar)
forall a b. Ptr a -> Ptr b
C.castPtr Ptr SessionArg
p
        if Ptr CChar
p' Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
C.nullPtr
            then String -> IO SessionArg
forall a. HasCallStack => String -> a
error String
"Storable(SessionArg).peek: NULL reference"
            else do
                String
str <- Ptr CChar -> IO String
C.peekCString Ptr CChar
p'
                SessionArg -> IO SessionArg
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionArg -> IO SessionArg) -> SessionArg -> IO SessionArg
forall a b. (a -> b) -> a -> b
$ case String
str of
                    String
"source" -> SessionArg
Source
                    String
"cue" -> SessionArg
Cue
                    String
"scsi-tuple" -> SessionArg
ScsiTuple
                    String
"mmc-supported?" -> SessionArg
MmcSupported
                    String
_ -> String -> SessionArg
forall a. HasCallStack => String -> a
error (String -> SessionArg) -> String -> SessionArg
forall a b. (a -> b) -> a -> b
$ String
"Storable(SessionArg).peek: unknown key '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
    poke :: Ptr SessionArg -> SessionArg -> IO ()
poke Ptr SessionArg
p SessionArg
hs = String -> IO (Ptr CChar)
C.newCString (SessionArg -> String
serializeSessionArg SessionArg
hs) IO (Ptr CChar) -> (Ptr CChar -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Ptr SessionArg -> Ptr (Ptr CChar)
forall a b. Ptr a -> Ptr b
C.castPtr Ptr SessionArg
p)

serializeSessionArg :: SessionArg -> String
serializeSessionArg :: SessionArg -> String
serializeSessionArg SessionArg
Source = String
"source"
serializeSessionArg SessionArg
Cue = String
"cue"
serializeSessionArg SessionArg
ScsiTuple = String
"scsi-tuple"
serializeSessionArg SessionArg
MmcSupported = String
"mmc-supported?"


-- | Which instruction set should be used to communicate with the driver,
-- providing a type-safe input for session initialization.  Note that not every
-- driver type supports every item.
data AccessMode
    = Image
    | Ioctl
        -- ^ The 'DriverLinux' and 'DriverBsdi' drivers use a different
        -- internal representation for 'Ioctl_'.
    | Ioctl_
        -- ^ The 'DriverFreeBsd' and 'DriverWin32' drivers use a different
        -- internal representation for 'Ioctl'.
    | Aspi
    | Atapi
    | Cam
    | Scsi
    | ReadCd
    | Read10
    | MmcReadWrite
    | MmcReadWriteExclusive
  deriving ( AccessMode -> AccessMode -> Bool
(AccessMode -> AccessMode -> Bool)
-> (AccessMode -> AccessMode -> Bool) -> Eq AccessMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessMode -> AccessMode -> Bool
$c/= :: AccessMode -> AccessMode -> Bool
== :: AccessMode -> AccessMode -> Bool
$c== :: AccessMode -> AccessMode -> Bool
Eq, Eq AccessMode
Eq AccessMode
-> (AccessMode -> AccessMode -> Ordering)
-> (AccessMode -> AccessMode -> Bool)
-> (AccessMode -> AccessMode -> Bool)
-> (AccessMode -> AccessMode -> Bool)
-> (AccessMode -> AccessMode -> Bool)
-> (AccessMode -> AccessMode -> AccessMode)
-> (AccessMode -> AccessMode -> AccessMode)
-> Ord AccessMode
AccessMode -> AccessMode -> Bool
AccessMode -> AccessMode -> Ordering
AccessMode -> AccessMode -> AccessMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AccessMode -> AccessMode -> AccessMode
$cmin :: AccessMode -> AccessMode -> AccessMode
max :: AccessMode -> AccessMode -> AccessMode
$cmax :: AccessMode -> AccessMode -> AccessMode
>= :: AccessMode -> AccessMode -> Bool
$c>= :: AccessMode -> AccessMode -> Bool
> :: AccessMode -> AccessMode -> Bool
$c> :: AccessMode -> AccessMode -> Bool
<= :: AccessMode -> AccessMode -> Bool
$c<= :: AccessMode -> AccessMode -> Bool
< :: AccessMode -> AccessMode -> Bool
$c< :: AccessMode -> AccessMode -> Bool
compare :: AccessMode -> AccessMode -> Ordering
$ccompare :: AccessMode -> AccessMode -> Ordering
$cp1Ord :: Eq AccessMode
Ord, AccessMode
AccessMode -> AccessMode -> Bounded AccessMode
forall a. a -> a -> Bounded a
maxBound :: AccessMode
$cmaxBound :: AccessMode
minBound :: AccessMode
$cminBound :: AccessMode
Bounded, Int -> AccessMode
AccessMode -> Int
AccessMode -> [AccessMode]
AccessMode -> AccessMode
AccessMode -> AccessMode -> [AccessMode]
AccessMode -> AccessMode -> AccessMode -> [AccessMode]
(AccessMode -> AccessMode)
-> (AccessMode -> AccessMode)
-> (Int -> AccessMode)
-> (AccessMode -> Int)
-> (AccessMode -> [AccessMode])
-> (AccessMode -> AccessMode -> [AccessMode])
-> (AccessMode -> AccessMode -> [AccessMode])
-> (AccessMode -> AccessMode -> AccessMode -> [AccessMode])
-> Enum AccessMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AccessMode -> AccessMode -> AccessMode -> [AccessMode]
$cenumFromThenTo :: AccessMode -> AccessMode -> AccessMode -> [AccessMode]
enumFromTo :: AccessMode -> AccessMode -> [AccessMode]
$cenumFromTo :: AccessMode -> AccessMode -> [AccessMode]
enumFromThen :: AccessMode -> AccessMode -> [AccessMode]
$cenumFromThen :: AccessMode -> AccessMode -> [AccessMode]
enumFrom :: AccessMode -> [AccessMode]
$cenumFrom :: AccessMode -> [AccessMode]
fromEnum :: AccessMode -> Int
$cfromEnum :: AccessMode -> Int
toEnum :: Int -> AccessMode
$ctoEnum :: Int -> AccessMode
pred :: AccessMode -> AccessMode
$cpred :: AccessMode -> AccessMode
succ :: AccessMode -> AccessMode
$csucc :: AccessMode -> AccessMode
Enum, Int -> AccessMode -> ShowS
[AccessMode] -> ShowS
AccessMode -> String
(Int -> AccessMode -> ShowS)
-> (AccessMode -> String)
-> ([AccessMode] -> ShowS)
-> Show AccessMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessMode] -> ShowS
$cshowList :: [AccessMode] -> ShowS
show :: AccessMode -> String
$cshow :: AccessMode -> String
showsPrec :: Int -> AccessMode -> ShowS
$cshowsPrec :: Int -> AccessMode -> ShowS
Show, ReadPrec [AccessMode]
ReadPrec AccessMode
Int -> ReadS AccessMode
ReadS [AccessMode]
(Int -> ReadS AccessMode)
-> ReadS [AccessMode]
-> ReadPrec AccessMode
-> ReadPrec [AccessMode]
-> Read AccessMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AccessMode]
$creadListPrec :: ReadPrec [AccessMode]
readPrec :: ReadPrec AccessMode
$creadPrec :: ReadPrec AccessMode
readList :: ReadS [AccessMode]
$creadList :: ReadS [AccessMode]
readsPrec :: Int -> ReadS AccessMode
$creadsPrec :: Int -> ReadS AccessMode
Read )
instance S.Storable AccessMode where
    sizeOf :: AccessMode -> Int
sizeOf AccessMode
_ = Ptr CChar -> Int
forall a. Storable a => a -> Int
S.sizeOf (Ptr CChar
forall a. HasCallStack => a
undefined :: C.CString)
    alignment :: AccessMode -> Int
alignment AccessMode
_ = Ptr CChar -> Int
forall a. Storable a => a -> Int
S.alignment (Ptr CChar
forall a. HasCallStack => a
undefined :: C.CString)
    peek :: Ptr AccessMode -> IO AccessMode
peek Ptr AccessMode
p = do
        Ptr CChar
p' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
S.peek (Ptr (Ptr CChar) -> IO (Ptr CChar))
-> Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr AccessMode -> Ptr (Ptr CChar)
forall a b. Ptr a -> Ptr b
C.castPtr Ptr AccessMode
p
        if Ptr CChar
p' Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
C.nullPtr
            then String -> IO AccessMode
forall a. HasCallStack => String -> a
error String
"Storable(AccessMode).peek: NULL reference"
            else String -> AccessMode
unserializeAccessMode (String -> AccessMode) -> IO String -> IO AccessMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO String
C.peekCString Ptr CChar
p'
    poke :: Ptr AccessMode -> AccessMode -> IO ()
poke Ptr AccessMode
p AccessMode
hs = String -> IO (Ptr CChar)
C.newCString (AccessMode -> String
serializeAccessMode AccessMode
hs) IO (Ptr CChar) -> (Ptr CChar -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Ptr AccessMode -> Ptr (Ptr CChar)
forall a b. Ptr a -> Ptr b
C.castPtr Ptr AccessMode
p)

serializeAccessMode :: AccessMode -> String
serializeAccessMode :: AccessMode -> String
serializeAccessMode AccessMode
Image = String
"image"
serializeAccessMode AccessMode
Ioctl = String
"IOCTL"
serializeAccessMode AccessMode
Ioctl_ = String
"ioctl"
serializeAccessMode AccessMode
Aspi = String
"ASPI"
serializeAccessMode AccessMode
Atapi = String
"ATAPI"
serializeAccessMode AccessMode
Cam = String
"CAM"
serializeAccessMode AccessMode
Scsi = String
"SCSI"
serializeAccessMode AccessMode
ReadCd = String
"READ_CD"
serializeAccessMode AccessMode
Read10 = String
"READ_10"
serializeAccessMode AccessMode
MmcReadWrite = String
"MMC_RDWR"
serializeAccessMode AccessMode
MmcReadWriteExclusive = String
"MMC_RDWR_EXCL"

unserializeAccessMode :: String -> AccessMode
unserializeAccessMode :: String -> AccessMode
unserializeAccessMode String
"image" = AccessMode
Image
unserializeAccessMode String
"IOCTL" = AccessMode
Ioctl
unserializeAccessMode String
"ioctl" = AccessMode
Ioctl_
unserializeAccessMode String
"ASPI" = AccessMode
Aspi
unserializeAccessMode String
"ATAPI" = AccessMode
Atapi
unserializeAccessMode String
"CAM" = AccessMode
Cam
unserializeAccessMode String
"SCSI" = AccessMode
Scsi
unserializeAccessMode String
"READ_CD" = AccessMode
ReadCd
unserializeAccessMode String
"READ_10" = AccessMode
Read10
unserializeAccessMode String
"MMC_RDRW" = AccessMode
MmcReadWrite
unserializeAccessMode String
"MMC_RDRW_EXCL" = AccessMode
MmcReadWriteExclusive
unserializeAccessMode String
str = String -> AccessMode
forall a. HasCallStack => String -> a
error (String -> AccessMode) -> String -> AccessMode
forall a b. (a -> b) -> a -> b
$ String
"Storable(AccessMode).peek: unknown key '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"