CdTypes.hs

{-# LANGUAGE ForeignFunctionInterface #-}

{-|
Description:    Objects used to describe the CD and filesystem format.

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

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

Like any drive, discs may store their data according to many different
filesystem structures.  These are abstracted to a degree in libcdio, but as
each track may store its data differently, and at the very least 'Audio' is
handled differently than any of the file-oriented layouts, it is still helpful
to know the underlying structure.


= @cd_types.h@

== Defines
* CDIO_FSTYPE                       (removed; cdio_fs_anal_t represented differently in Haskell)
* CDIO_FS_UNKNOWN                   (removed; handled via 'Nothing')

== Types
* @cdio_fs_t@                       -> 'Foreign.Libcdio.CdTypes.Filesystem'

    - @CDIO_FS_INTERACTIVE@         -> 'Foreign.Libcdio.CdTypes.CdI'
    - @CDIO_FS_ISO_HFS@             -> 'Foreign.Libcdio.CdTypes.Hfs' with a 'Just' 'Foreign.Libcdio.CdTypes.IsoAnalysis'
    - @CDIO_FS_ISO_9660_INTERACTIVE@ -> 'Foreign.Libcdio.CdTypes.CdI' with a 'Just' 'Foreign.Libcdio.CdTypes.IsoAnalysis'
    - @CDIO_FS_ISO_UDF@             -> 'Foreign.Libcdio.CdTypes.Udf' with a 'Just' 'Foreign.Libcdio.CdTypes.IsoAnalysis'
    - @CDIO_FS_ISO_XISO@            -> 'Foreign.Libcdio.CdTypes.XboxIso'
    - @CDIO_FS_ISO_UDFX@            -> 'Foreign.Libcdio.CdTypes.XboxUdf'

* @cdio_fs_cap_t@                   -> 'Foreign.Libcdio.CdTypes.FilesystemClass'

    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_FS_MASK@                (removed; cdio_fs_anal_t represented differently in Haskell)
    - @CDIO_FS_ANAL_VCD_ANY@        -> 'Foreign.Libcdio.CdTypes.fsAnyVcd'
    - @CDIO_FS_MATCH_ALL@           -> 'Foreign.Libcdio.CdTypes.fsAny'
    - @CDIO_FS_ANAL_CDTV@           -> 'Foreign.Libcdio.CdTypes.CommodoreCdtv'
    - @CDIO_FS_ANAL_SVCD@           -> 'Foreign.Libcdio.CdTypes.SuperVideoCd'
    - @CDIO_FS_ANAL_CVD@            -> 'Foreign.Libcdio.CdTypes.ChoijiVideoCd'
    - @CDIO_FS_ANAL_XISO@           -> 'Foreign.Libcdio.CdTypes.XboxIsoClass'

* @cdio_iso_analysis_t@             -> 'Foreign.Libcdio.CdTypes.IsoAnalysis'

    - @joliet_level@                -> 'Foreign.Libcdio.CdTypes.jolietLevel'
    - @iso_label@                   -> 'Foreign.Libcdio.CdTypes.label'
    - @isofs_size@                  -> 'Foreign.Libcdio.CdTypes.fsSize'
    - @UDFVerMajor@                 -> 'fst' 'Foreign.Libcdio.CdTypes.udfVersion'
    - @UDFVerMinor@                 -> 'snd' 'Foreign.Libcdio.CdTypes.udfVersion'

== Symbols
* @cdio_guess_cd_type@              -> 'Foreign.Libcdio.CdTypes.trackType'


= "Sound.Libcdio.Read.Filesystem"

* 'trackType'                       -> 'Sound.Libcdio.Read.Filesystem.filesystemType'
-}
module Foreign.Libcdio.CdTypes
    ( -- * Types
      Filesystem ( .. )
    , FilesystemClass ( .. )
    , FilesystemClasses
    , fsAny, fsAnyVcd
    , IsoAnalysis ( .. )
      -- * Access
    , trackType
    ) where


import qualified Data.Maybe as Y
import qualified Data.Word as W

import qualified Data.Array.BitArray as A

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.Storable as S

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


-- | Types of filesystem which may be read from a disc.
data Filesystem
    = Audio
    | HighSierra
    | Iso9660
    | CdI
    | Cd3do
    | Ext2
    | Hfs
    | Ufs
    | Udf
    | XboxIso
    | XboxUdf
  deriving ( Eq, Show, Read, Ord, Enum, Bounded )


-- | A collection of disc/filesystem descriptions.
type FilesystemClasses = A.BitArray FilesystemClass

-- | Any sort of Video CD.
fsAnyVcd :: FilesystemClasses
fsAnyVcd = genBitArray
    [ VideoCd
    , SuperVideoCd
    , ChoijiVideoCd
    ]

-- | The set of every 'FilesystemClass'.
fsAny :: FilesystemClasses
fsAny = genBitArray [minBound .. maxBound]


-- | A collection of data describing a disc using the ISO 9660 standard.
data IsoAnalysis = IsoAnalysis
    { jolietLevel :: Maybe Word
    , label       :: String
    , fsSize      :: Word
    , udfVersion  :: Maybe (W.Word8, W.Word8)
    }
  deriving ( Eq, Show, Read )
instance S.Storable IsoAnalysis where
    sizeOf _    = iaSizeOf
    alignment _ = iaAlign
    peek c = do
        j <- S.peekByteOff c iaJolietLevel :: IO C.CUInt
        l <- C.peekCString $ C.plusPtr c iaLabel
        s <- S.peekByteOff c iaIsoSize :: IO C.CUInt
        a <- S.peekByteOff c iaUDFMajor
        i <- S.peekByteOff c iaUDFMinor
        return $ IsoAnalysis
            { jolietLevel = if j == 0 then Nothing else Just $ fromIntegral j
            , label = l
            , fsSize = fromIntegral s
            , udfVersion = if a == 0 then Nothing else Just (a, i)
            }
    poke c hs = do
        let (a, i) = Y.fromMaybe (0, 0) $ udfVersion hs
        S.pokeByteOff c iaJolietLevel . maybe (0 :: C.CUInt) fromIntegral $ jolietLevel hs
        pokeCString (label hs) 33 $ C.plusPtr c iaLabel
        S.pokeByteOff c iaIsoSize (fromIntegral $ fsSize hs :: C.CUInt)
        S.pokeByteOff c iaUDFMajor a
        S.pokeByteOff c iaUDFMinor i


-- | Determine what type of file system is stored in the given track of a disc.
trackType :: Cdio -> Track -> IO (Maybe Filesystem, FilesystemClasses, Maybe IsoAnalysis)
trackType c t = do
    l' <- trackLsn c t
    (fs, iso') <- case l' of
        Just l -> withCdio' defaultCdType $ \c' -> M.alloca $ \i' -> do
            e' <- cdType_ c' l (withTrack t) i'
            iso <- S.peek i'
            return (modEnumFlags e', iso)
        Nothing -> return defaultCdType
    let fc = snd fs
        iso = Just iso' { udfVersion = Nothing }
        isoUdf = Just iso'
    return $ case fst fs of
        Nothing -> (Nothing, fc, isoUdf)
        Just Fs3do -> (Just Cd3do, fc, iso)
        Just FsAudio -> (Just Audio, fc, Nothing)
        Just FsExt2 -> (Just Ext2, fc, iso)
        Just FsHfs -> (Just Hfs, fc, Nothing)
        Just FsIsoHfs -> (Just Hfs, fc, iso)
        Just FsHighSierra -> (Just HighSierra, fc, iso)
        Just FsInteractive -> (Just CdI, fc, Nothing)
        Just FsIso9660Interactive -> (Just CdI, fc, iso)
        Just FsIso9660 -> (Just Iso9660, fc, iso)
        Just FsUdf -> (Just Udf, fc, Nothing)
        Just FsIsoUdf -> (Just Udf, fc, isoUdf)
        Just FsUdfx -> (Just Udf, fc, isoUdf)
        Just FsUfs -> (Just Ufs, fc, iso)
        Just FsXiso -> (Just XboxIso, fc, iso)
  where defaultCdType = ((Nothing, genBitArray []), IsoAnalysis Nothing "" 0 Nothing)
        withCdio' b = fmap (Y.fromMaybe b) . withCdio c

foreign import ccall safe "cdio/compat/cd_types.h cdio_guess_cd_type"
  cdType_ :: C.Ptr Cdio -> Lsn -> CTrack -> C.Ptr IsoAnalysis -> IO C.CInt