{-|
Description:    Information and procedures related to a system's (usually) physical disc drives.

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

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

Any software dealing with CDs has to deal with the fact that they are,
ultimately, a physical medium and thus reading from them requires interfacing
with system hardware.  This module provides the means to do just that.  Note
that, unlike the C and "Foreign.Libcdio" interfaces, however, this /doesn't/
provide any means to open a read session; that functionality is instead
exported directly from "Sound.Libcdio".
-}
module Sound.Libcdio.Device
    ( -- * Types
      Foreign.HardwareInfo ( .. )
    , Foreign.emptyHardwareInfo
    , Foreign.DriverId ( .. )
    , Foreign.DriverReturnCode ( .. )
      -- ** Capabilities
    , Foreign.DriveCaps
    , Foreign.DriveCapabilityRead ( .. )
    , Foreign.DriveReadCaps
    , Foreign.DriveCapabilityWrite ( .. )
    , Foreign.DriveWriteCaps
    , Foreign.capsWriteCd
    , Foreign.capsWriteDvd
    , Foreign.capsWrite
    , Foreign.DriveCapabilityMisc ( .. )
    , Foreign.DriveMiscCaps
      -- * Drivers
    , driver
    , Foreign.drivers
    , Foreign.osDriver
    , isImageDriver
    , isDevice
      -- * Session
    , setBlocksize
    , setSpeed
    , isMediaChanged
      -- * Devices
    , Foreign.devices
    , Foreign.defaultDevice
    , Foreign.defaultDeviceDriver
    , capabilities
    , deviceCapabilities
      -- ** Images
    , isCue
    , Foreign.isToc
    , Foreign.isNrg
      -- ** Hardware
    , hardware
    , haveAtapi
    , ejectDevice
    , closeDeviceTray
    , closeDeviceTray'
    ) where


import qualified Data.Maybe as Y

import qualified Foreign.Libcdio.Device as Foreign

import Sound.Libcdio.Types.Cdio


-- | Get the driver through which the disc is being read.
driver :: Cdio Foreign.DriverId
driver :: Cdio DriverId
driver = (Cdio -> IO DriverId) -> Cdio DriverId
forall a. (Cdio -> IO a) -> Cdio a
liftCdio ((Cdio -> IO DriverId) -> Cdio DriverId)
-> (Cdio -> IO DriverId) -> Cdio DriverId
forall a b. (a -> b) -> a -> b
$ (Maybe DriverId -> DriverId) -> IO (Maybe DriverId) -> IO DriverId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DriverId -> Maybe DriverId -> DriverId
forall a. a -> Maybe a -> a
Y.fromMaybe DriverId
Foreign.DriverUnknown) (IO (Maybe DriverId) -> IO DriverId)
-> (Cdio -> IO (Maybe DriverId)) -> Cdio -> IO DriverId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cdio -> IO (Maybe DriverId)
Foreign.driverId

-- | Whether a particular driver deals with image files saved to disc, or a CD
-- drive itself.
isImageDriver :: Foreign.DriverId -> Bool
isImageDriver :: DriverId -> Bool
isImageDriver = Bool -> Bool
not (Bool -> Bool) -> (DriverId -> Bool) -> DriverId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DriverId -> [DriverId] -> Bool) -> [DriverId] -> DriverId -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip DriverId -> [DriverId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [DriverId]
Foreign.deviceDrivers


-- | Get a description of the device in use.
hardware :: Cdio Foreign.HardwareInfo
hardware :: Cdio HardwareInfo
hardware = (Cdio -> IO HardwareInfo) -> Cdio HardwareInfo
forall a. (Cdio -> IO a) -> Cdio a
liftCdio ((Cdio -> IO HardwareInfo) -> Cdio HardwareInfo)
-> (Cdio -> IO HardwareInfo) -> Cdio HardwareInfo
forall a b. (a -> b) -> a -> b
$ (Maybe HardwareInfo -> HardwareInfo)
-> IO (Maybe HardwareInfo) -> IO HardwareInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HardwareInfo -> Maybe HardwareInfo -> HardwareInfo
forall a. a -> Maybe a -> a
Y.fromMaybe HardwareInfo
Foreign.emptyHardwareInfo) (IO (Maybe HardwareInfo) -> IO HardwareInfo)
-> (Cdio -> IO (Maybe HardwareInfo)) -> Cdio -> IO HardwareInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cdio -> IO (Maybe HardwareInfo)
Foreign.hwinfo

-- | Which features are provided by the current device.  See
-- 'deviceCapabilities' when a session has not yet been opened.
capabilities :: Cdio Foreign.DriveCaps
capabilities :: Cdio DriveCaps
capabilities = (Cdio -> IO DriveCaps) -> Cdio DriveCaps
forall a. (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO DriveCaps
Foreign.driveCap

-- | Whether ATAPI commands are understood by the current device.
-- 
-- Returns 'Nothing' if the capability can't be determined.
haveAtapi :: Cdio (Maybe Bool)
haveAtapi :: Cdio (Maybe Bool)
haveAtapi = (Cdio -> IO (Maybe Bool)) -> Cdio (Maybe Bool)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO (Maybe Bool)
Foreign.haveAtapi


-- | Which features are provided by a particular device.  See 'capabilities'
-- for accessing these within a 'Cdio' session.
deviceCapabilities :: FilePath -> IO Foreign.DriveCaps
deviceCapabilities :: FilePath -> IO DriveCaps
deviceCapabilities = FilePath -> IO DriveCaps
Foreign.driveCapDevice


-- | Open a particular device's tray or otherwise free any disc it holds for
-- removal, replacement, or insertion.
ejectDevice :: Maybe FilePath -> IO Foreign.DriverReturnCode
ejectDevice :: Maybe FilePath -> IO DriverReturnCode
ejectDevice = Maybe FilePath -> IO DriverReturnCode
Foreign.ejectDrive

-- | If a device supports discs on an extending, motorized tray (i.e. a
-- standard CD drive), close it.
closeDeviceTray :: Maybe FilePath -> IO Foreign.DriverReturnCode
closeDeviceTray :: Maybe FilePath -> IO DriverReturnCode
closeDeviceTray = ((DriverReturnCode, DriverId) -> DriverReturnCode)
-> IO (DriverReturnCode, DriverId) -> IO DriverReturnCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DriverReturnCode, DriverId) -> DriverReturnCode
forall a b. (a, b) -> a
fst (IO (DriverReturnCode, DriverId) -> IO DriverReturnCode)
-> (Maybe FilePath -> IO (DriverReturnCode, DriverId))
-> Maybe FilePath
-> IO DriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> DriverId -> IO (DriverReturnCode, DriverId))
-> DriverId -> Maybe FilePath -> IO (DriverReturnCode, DriverId)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe FilePath -> DriverId -> IO (DriverReturnCode, DriverId)
Foreign.closeTray DriverId
Foreign.DriverUnknown

-- | As 'closeDeviceTray'', but specify the driver to use in case of ambiguity.
closeDeviceTray' :: Maybe FilePath -> Foreign.DriverId -> IO Foreign.DriverReturnCode
closeDeviceTray' :: Maybe FilePath -> DriverId -> IO DriverReturnCode
closeDeviceTray' Maybe FilePath
p = ((DriverReturnCode, DriverId) -> DriverReturnCode)
-> IO (DriverReturnCode, DriverId) -> IO DriverReturnCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DriverReturnCode, DriverId) -> DriverReturnCode
forall a b. (a, b) -> a
fst (IO (DriverReturnCode, DriverId) -> IO DriverReturnCode)
-> (DriverId -> IO (DriverReturnCode, DriverId))
-> DriverId
-> IO DriverReturnCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> DriverId -> IO (DriverReturnCode, DriverId)
Foreign.closeTray Maybe FilePath
p


-- | Specify how much data should be read from a disc at once.  Note that this
-- only affects the transport; any reading functions operate on independant
-- byte counts or other sizes derived from such.
setBlocksize :: Int -> Cdio Foreign.DriverReturnCode
setBlocksize :: Int -> Cdio DriverReturnCode
setBlocksize Int
s = (Cdio -> IO DriverReturnCode) -> Cdio DriverReturnCode
forall a. (Cdio -> IO a) -> Cdio a
liftCdio ((Cdio -> IO DriverReturnCode) -> Cdio DriverReturnCode)
-> (Cdio -> IO DriverReturnCode) -> Cdio DriverReturnCode
forall a b. (a -> b) -> a -> b
$ (Cdio -> Int -> IO DriverReturnCode)
-> Int -> Cdio -> IO DriverReturnCode
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cdio -> Int -> IO DriverReturnCode
Foreign.setBlocksize Int
s

-- | Specify the speed at which the disc is read.  Lower values result in
-- slower IO, but better accuracy.
setSpeed :: Int -> Cdio Foreign.DriverReturnCode
setSpeed :: Int -> Cdio DriverReturnCode
setSpeed Int
s = (Cdio -> IO DriverReturnCode) -> Cdio DriverReturnCode
forall a. (Cdio -> IO a) -> Cdio a
liftCdio ((Cdio -> IO DriverReturnCode) -> Cdio DriverReturnCode)
-> (Cdio -> IO DriverReturnCode) -> Cdio DriverReturnCode
forall a b. (a -> b) -> a -> b
$ (Cdio -> Int -> IO DriverReturnCode)
-> Int -> Cdio -> IO DriverReturnCode
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cdio -> Int -> IO DriverReturnCode
Foreign.setSpeed Int
s


-- | Check if any data in the read session has been changed since the last call
-- of this function.  This is most helpful when multiple 'Cdio' computations
-- are run on a partial call of 'Sound.Libcdio.Types.Cdio.open' or similar.
isMediaChanged :: Cdio (Either Foreign.DriverReturnCode Bool)
isMediaChanged :: Cdio (Either DriverReturnCode Bool)
isMediaChanged = (Cdio -> IO (Either DriverReturnCode Bool))
-> Cdio (Either DriverReturnCode Bool)
forall a. (Cdio -> IO a) -> Cdio a
liftCdio Cdio -> IO (Either DriverReturnCode Bool)
Foreign.isMediaChanged


-- | Whether a file is valid according to the (loose) CUE standard.
isCue :: FilePath -> IO Bool
isCue :: FilePath -> IO Bool
isCue = (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> Bool
forall a. Maybe a -> Bool
Y.isJust (IO (Maybe FilePath) -> IO Bool)
-> (FilePath -> IO (Maybe FilePath)) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe FilePath)
Foreign.binFromCue

-- | Whether the path represents a physical disc drive in the system.
isDevice :: FilePath -> IO Bool
isDevice :: FilePath -> IO Bool
isDevice = (FilePath -> DriverId -> IO Bool)
-> DriverId -> FilePath -> IO Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> DriverId -> IO Bool
Foreign.isDevice DriverId
Foreign.DriverDevice