System.hs

{-# LANGUAGE OverloadedStrings #-}

{-|
Description:    

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

Stability:      experimental
Portability:    portable
-}
module Test.Libcdio.Upstream.Sound.System (tests) where


import qualified Test.HUnit as U
import Test.HUnit ( (@?), (~:) )

import qualified Data.Maybe as Y

import Sound.Libcdio
import Sound.Libcdio.Device
import Sound.Libcdio.Read.Data

import Test.Libcdio.Upstream.Sound.Common


tests :: U.Test
tests = "Sound.Libcdio.Test.System" ~: U.TestList
    [ haveSystemDriver d ts
    | (d, ts) <-
        [ (DriverFreeBsd, testsBsd)
        , (DriverLinux, testsLinux)
        , (DriverOsX, testsOsx)
        , (DriverSolaris, testsSolaris)
        , (DriverWin32, testsWin32)
        ]
    ]

testsBsd :: U.Test
testsBsd = find DriverFreeBsd Nothing $ \p -> do
    s <- checkSource [p]
    a <- checkAccessMode [Ioctl_, Cam]
    m <- checkMmc $ Just False
    return [s, a, m]

testsLinux :: U.Test
testsLinux = find DriverLinux (Just MmcReadWrite) $ \p -> do
    s <- checkSource [p]
    m <- checkMmc Nothing
    t <- checkArg ScsiTuple []
    return [s, m, t]

testsOsx :: U.Test
testsOsx = find DriverOsX Nothing $ \p -> do
    s <- checkSource [p]
    -- can't supply arbitrary access modes
    --a <- checkAccessMode ["OS X"]
    
    d <- discMode
    let d' = Y.isJust d @? "Error getting disc mode"
    
    return [s, d']

testsSolaris :: U.Test
testsSolaris = find DriverSolaris (Just Scsi) $ \p -> do
    s <- checkSource [p]
    a <- checkAccessMode [Scsi]
    return [s, a]

testsWin32 :: U.Test
testsWin32 = U.TestList $ map (uncurry $ find DriverWin32)
    [ ( Nothing, \p -> do
        s <- checkSource [p]
        return [s]
      )
    , ( Just Aspi, \p -> do
        s <- checkSource [p]
        a <- checkAccessMode [Aspi]
        return [s, a]
      )
    , ( Just Ioctl_, \p -> do
        s <- checkSource [p]
        t <- checkArg ScsiTuple []
        a <- checkAccessMode [Ioctl_]
        m <- checkMmc $ Just True
        return [s, t, a, m]
      )
    ]


haveSystemDriver :: DriverId -> U.Test -> U.Test
haveSystemDriver d ts
    | elem d drivers = drop 6 (show d) ~: ts
    | otherwise = U.TestList []

find :: DriverId -> Maybe AccessMode -> (FilePath -> Cdio [U.Assertion]) -> U.Test
find d m c = U.TestCase $ do
    ps <- devices d
    -- Don't actually want to fail on no device, for systems without CD drives
    sequence_ . unwrap $ testCdioMode m ps c
  where unwrap (U.TestCase a) = [a]
        unwrap (U.TestList ts) = concatMap unwrap ts
        unwrap (U.TestLabel _ t) = unwrap t