{-# 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_*@ -> @defaultDevice*@ (eg. 'defaultDeviceLinux') * @cdio_get_devices@ -> 'devices' * @cdio_get_devices_*@ -> @devices*@ (eg. 'devicesLinux') * @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_*@ -> @cdioOpen*@ (eg. 'cdioOpenLinux') * @cdio_open_am@ -> 'cdioOpenAm' * @cdio_open_am_*@ -> @cdioOpenAm*@ (eg. 'cdioOpenAmLinux') * @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 Uninitialized $ toEnum . 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 = genBitArray [ WriteCdRecordable , WriteCdReWritable ] -- | Capabilites indicating a device has some sort of DVD-writing ability. capsWriteDvd :: DriveWriteCaps capsWriteDvd = genBitArray [ WriteDvdRecordable , WriteDvdPlusRecordable , WriteDvdRam , WriteDvdReWritable , WriteDvdPlusReWritable ] -- | Capabilites indicating a device has some sort of disc-writing ability. capsWrite :: DriveWriteCaps capsWrite = A.zipWith (||) capsWriteCd capsWriteDvd -- | Length of the drive vendor name in returned in a 'HardwareInfo' query. vendorLength :: Word vendorLength = fromIntegral 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 = fromIntegral 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 = fromIntegral 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 { vendor :: String -- ^ The company who designed and/or built the drive. , model :: String -- ^ The name of the specific drive design. , revision :: String -- ^ The version number for hardware/firmware following a series. } deriving ( Eq, Show, Read ) instance S.Storable HardwareInfo where sizeOf _ = hiSizeOf alignment _ = hiAlign peek c = do v <- decode vendorLength hiVendor m <- decode modelLength hiModel r <- decode revisionLength hiRevision return $ HardwareInfo v m r where decode l o = C.peekCStringLen (C.plusPtr c o, fromIntegral l) poke c hs = do pokeCString (vendor hs) (fromIntegral vendorLength + 1) (C.plusPtr c hiVendor) pokeCString (model hs) (fromIntegral modelLength + 1) (C.plusPtr c hiModel) pokeCString (revision hs) (fromIntegral revisionLength + 1) (C.plusPtr c hiRevision) -- | A 'HardwareInfo' object with values suitable as defaults. emptyHardwareInfo :: HardwareInfo emptyHardwareInfo = HardwareInfo { vendor = replicate (fromIntegral vendorLength) '\NUL' , model = replicate (fromIntegral modelLength) '\NUL' , revision = replicate (fromIntegral revisionLength) '\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 is' = do is <- M.peekArray0 (fromIntegral $ fromEnum DriverUnknown) is' return $ map (toEnum . fromIntegral) is -- | All supported drivers, listed in order of preference. drivers :: [DriverId] drivers = filter haveDriver <$> IO.Unsafe.unsafePerformIO $ peekDriverIdArray 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 = IO.Unsafe.unsafePerformIO $ peekDriverIdArray 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 = toEnum $ fromIntegral 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 f d = M.maybeWith C.withCString f $ \f' -> M.with (fromIntegral $ fromEnum d) $ \d' -> do r <- closeTray' f' d' d'' <- S.peek d' return (toEnum $ fromIntegral r, toEnum $ fromIntegral 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 = IO.Unsafe.unsafePerformIO . C.peekCString . driverErrmsg' . fromIntegral . 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 = fmap toDriverReturnCode . flip withCdioPtr 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 = fmap (toEnum . fromIntegral) . flip (M.maybeWith C.withCString) 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 = defaultDevice' C.nullPtr >>= M.maybePeek 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 d = M.with (fromIntegral $ fromEnum d) $ \d' -> do f <- defaultDeviceDriver' d' >>= M.maybePeek C.peekCString d'' <- S.peek d' return (f, toEnum $ fromIntegral 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 d = devices' (fromIntegral $ fromEnum d) >>= 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 d = M.with (fromIntegral $ fromEnum d) $ \d' -> do fs <- devicesRet' d' >>= peekFStringArray d'' <- S.peek d' return (fs, toEnum $ fromIntegral 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 ps fs fc b = allocaStringArray ps $ \ps' -> devicesWithFilesystem' ps' (joinEnumFlags fs' fc) (M.fromBool b) >>= peekFStringArray where fs' = maybe 0 fromEnum 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 ps fs fc b = M.alloca $ \d -> allocaStringArray ps $ \ps' -> do ds <- devicesWithFilesystemRet' ps' (joinEnumFlags fs' fc) (M.fromBool b) d ds' <- peekFStringArray ds d' <- S.peek d return (ds', toEnum $ fromIntegral d') where fs' = maybe 0 fromEnum 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 c = M.alloca $ \x -> M.alloca $ \y -> M.alloca $ \z -> do withCdio_ c $ \c' -> driveCap' c' x y z peekDriveCaps x y 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 f = C.withCString f $ \f' -> M.alloca $ \x -> M.alloca $ \y -> M.alloca $ \z -> do driveCapDevice' f' x y z peekDriveCaps x y 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 x y z = do x' <- S.peek x y' <- S.peek y z' <- S.peek z return $ extractCapError x' y' 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 rs ws ms = case (packMay rs, packMay ws, packMay ms) of (Nothing, Nothing, Nothing) -> (pack empty, pack empty, pack empty) (rs', ws', ms') -> (orEmpty rs', orEmpty ws', orEmpty ms') where testEnumBit :: (Integral c, Enum i) => c -> i -> (i, Bool) testEnumBit c i = (i, (fromIntegral c .&. fromEnum i) /= 0) pack bs = A.array (minBound, maxBound) $ map (testEnumBit bs) [minBound .. maxBound] packMay bs | bs .&. capError == 0 = Nothing | bs .&. capUnknown == 0 = Nothing | otherwise = Just $ pack bs orEmpty :: (Bounded a, Enum a, Ix a) => Maybe (A.BitArray a) -> A.BitArray a orEmpty = Y.fromMaybe $ pack empty empty = 0x0 :: CBitfield -- | Describe the driver used by the session in a human-readable (English) -- manner. See also 'driverId'. driverName :: Cdio -> IO (Maybe String) driverName c = withCdio c driverName' >>= maybe (return Nothing) (M.maybePeek 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 c = fmap (toEnum . fromIntegral) <$> withCdio c 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 c = M.alloca $ \h -> do b <- withCdio c $ flip hwinfo' h case M.toBool <$> b of Just True -> M.maybePeek S.peek h _ -> return 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 c = M.alloca $ \l -> do r <- withCdio c $ flip lastSession' l l' <- S.peek l return $ case toEnum . fromIntegral <$> r of Just Success -> Right l' Just e -> Left e Nothing -> Left 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 c = maybe (Left Uninitialized) errorOrBool <$> withCdio c 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 c = fmap N.join . withCdio c $ fmap bool3 . 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 = M.toBool . haveDriver' . fromIntegral . 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 = IO.Unsafe.unsafePerformIO . C.peekCString . driverDescribe' . fromIntegral . 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 f d = M.maybeWith C.withCString f $ \f' -> do setupLogger c' <- cdioOpen' f' (fromIntegral $ fromEnum d) M.maybePeek peekCdio 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 f d m = M.maybeWith C.withCString f $ \f' -> C.withCString (serializeAccessMode m) $ \m' -> do setupLogger c' <- cdioOpenAm' f' (fromIntegral $ fromEnum d) m' M.maybePeek peekCdio 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' f p = withCStringNull p $ \p' -> do setupLogger f p' >>= M.maybePeek peekCdio openAm' :: (C.CString -> C.CString -> IO (C.Ptr Cdio)) -> Maybe FilePath -> AccessMode -> IO (Maybe Cdio) openAm' f p m = withCStringNull p $ \p' -> C.withCString (serializeAccessMode m) $ \m' -> do setupLogger f p' m' >>= M.maybePeek peekCdio withCStringNull :: Maybe String -> (C.CString -> IO a) -> IO a withCStringNull Nothing f = f C.nullPtr withCStringNull (Just str) f = C.withCString str f -- | Set up the specified CD-ROM device for reading. cdioOpenCd :: Maybe FilePath -> IO (Maybe Cdio) cdioOpenCd = open' 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 = openAm' 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 f = C.withCString f cueFromBin' >>= M.maybePeek 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 f = C.withCString f binFromCue' >>= M.maybePeek 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 = fmap M.toBool . flip C.withCString 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 = fmap M.toBool . flip C.withCString 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 f d = M.toBool <$> C.withCString f (flip isDevice' . fromIntegral $ fromEnum 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 c s = toDriverReturnCode <$> withCdio c (flip setBlocksize' $ fromIntegral 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 c v = toDriverReturnCode <$> withCdio c (flip setSpeed' $ fromIntegral 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 c k = C.withCString (serializeSessionArg k) $ \k' -> withCdio c (`getArg'` k') >>= maybe (return Nothing) (M.maybePeek 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 c = C.withCString "access-mode" $ \k' -> do str <- withCdio c (`getArg'` k') >>= maybe (return Nothing) (M.maybePeek C.peekCString) return $ fmap unserializeAccessMode 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 ( Eq, Ord, Bounded, Enum, Show, Read ) instance S.Storable SessionArg where sizeOf _ = S.sizeOf (undefined :: C.CString) alignment _ = S.alignment (undefined :: C.CString) peek p = do p' <- S.peek $ C.castPtr p if p' == C.nullPtr then error "Storable(SessionArg).peek: NULL reference" else do str <- C.peekCString p' return $ case str of "source" -> Source "cue" -> Cue "scsi-tuple" -> ScsiTuple "mmc-supported?" -> MmcSupported _ -> error $ "Storable(SessionArg).peek: unknown key '" ++ str ++ "'" poke p hs = C.newCString (serializeSessionArg hs) >>= S.poke (C.castPtr p) serializeSessionArg :: SessionArg -> String serializeSessionArg Source = "source" serializeSessionArg Cue = "cue" serializeSessionArg ScsiTuple = "scsi-tuple" serializeSessionArg MmcSupported = "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 ( Eq, Ord, Bounded, Enum, Show, Read ) instance S.Storable AccessMode where sizeOf _ = S.sizeOf (undefined :: C.CString) alignment _ = S.alignment (undefined :: C.CString) peek p = do p' <- S.peek $ C.castPtr p if p' == C.nullPtr then error "Storable(AccessMode).peek: NULL reference" else unserializeAccessMode <$> C.peekCString p' poke p hs = C.newCString (serializeAccessMode hs) >>= S.poke (C.castPtr p) serializeAccessMode :: AccessMode -> String serializeAccessMode Image = "image" serializeAccessMode Ioctl = "IOCTL" serializeAccessMode Ioctl_ = "ioctl" serializeAccessMode Aspi = "ASPI" serializeAccessMode Atapi = "ATAPI" serializeAccessMode Cam = "CAM" serializeAccessMode Scsi = "SCSI" serializeAccessMode ReadCd = "READ_CD" serializeAccessMode Read10 = "READ_10" serializeAccessMode MmcReadWrite = "MMC_RDWR" serializeAccessMode MmcReadWriteExclusive = "MMC_RDWR_EXCL" unserializeAccessMode :: String -> AccessMode unserializeAccessMode "image" = Image unserializeAccessMode "IOCTL" = Ioctl unserializeAccessMode "ioctl" = Ioctl_ unserializeAccessMode "ASPI" = Aspi unserializeAccessMode "ATAPI" = Atapi unserializeAccessMode "CAM" = Cam unserializeAccessMode "SCSI" = Scsi unserializeAccessMode "READ_CD" = ReadCd unserializeAccessMode "READ_10" = Read10 unserializeAccessMode "MMC_RDRW" = MmcReadWrite unserializeAccessMode "MMC_RDRW_EXCL" = MmcReadWriteExclusive unserializeAccessMode str = error $ "Storable(AccessMode).peek: unknown key '" ++ str ++ "'"