Common.hs

{-|
Description:    

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

Stability:      experimental
Portability:    portable

The semantics of several functions in this module were copied from
@test/driver/helper.*@ in the libcdio source, but their implementation was
rewritten for the Haskell wrapper.
-}
module Test.Libcdio.Upstream.Foreign.Common where


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

import qualified Control.Monad as M

import qualified Data.Char as C
import qualified Data.Maybe as Y

import Foreign.Libcdio.Device


dataDir :: String
dataDir = "test/datafiles/upstream/"

dataFile :: String -> String
dataFile = (++) dataDir


checkArg :: SessionArg -> Cdio -> [String] -> U.Assertion
checkArg k c ss = do
    v <- getArg c k
    value <- case v of
        Nothing -> U.assertFailure $ show k ++ "' isn't assigned"
        Just v' -> return v'
    null ss || elem value ss @? show k ++ "' has invalid value '" ++ value ++ "'"

checkAccessMode :: Cdio -> [AccessMode] -> U.Assertion
checkAccessMode c ms = do
    v <- getAccessMode c
    value <- case v of
        Nothing -> U.assertFailure "'access-mode' isn't assigned"
        Just v' -> return v'
    null ms || elem value ms @? "'access-mode' has invalid value '" ++ show value ++ "'"

checkSource :: Cdio -> [String] -> U.Assertion
checkSource = checkArg Source


-- | Whether the session advertises MMC support.  A 'Nothing' value indicates
-- that the actual state doesn't matter, just that it's advertised at all.
-- 
-- The C function takes a numeric value translating to the following:
-- 
--   * @1@ -> 'Just' 'False'
--   * @2@ -> 'Just' 'True'
--   * @3@ -> 'Nothing'
checkMmc :: Cdio -> Maybe Bool -> U.Assertion
checkMmc c b = do
    v <- getArg c MmcSupported
    Y.isJust v @? "Session does not describe MMC status."
    case b of
        Just _ -> map C.toLower . show <$> b @=? v
        Nothing -> return ()


find :: DriverId -> Maybe AccessMode -> ((Cdio, String) -> U.Assertion) -> U.Test
find d m f = "The driver is able to find its devices" ~: U.TestCase $ do
    ss <- devices d
    not (null ss) @? "Can't find a device"
    let open s = case m of
            Nothing -> cdioOpen s d
            Just m' -> cdioOpenAm s d m'
    cs <- mapM (open . Just) ss
    cs' <- M.forM (zip ss cs) $ \(s, c) -> case c of
        Nothing -> U.assertFailure $ "Can't open device '" ++ s ++ "'"
        Just c' -> return c'
    mapM_ f $ zip cs' ss