packages feed

hscdio-0.1.0.0: test/Test/Libcdio/Upstream/Sound/Common.hs

{-# LANGUAGE CPP #-}

{-|
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.Common
    ( Foreign.dataDir
    , checkArg
    , checkAccessMode
    , checkSource
    , checkMmc
    , testCdio
    , testCdioMode
    ) where


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

import qualified Data.Maybe as Y
import qualified Data.Text as T

import qualified System.Directory as D

import Sound.Libcdio

import qualified Test.Libcdio.Upstream.Foreign.Common as Foreign


-- | Whether the session argument is one of the allowed values.  An empty list
-- indicates that the actual value doesn't matter, just that it exists.
checkArg :: SessionArg -> [T.Text] -> Cdio U.Assertion
checkArg k ss = do
    v <- getArg k
    return $ case v of
        Nothing -> U.assertFailure $ show k ++ "' isn't assigned"
        Just v' -> if null ss || elem v' ss
            then return ()
            else U.assertFailure $ show k ++ "' has invalid value '" ++ T.unpack v' ++ "'"

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

checkSource :: [FilePath] -> Cdio U.Assertion
checkSource = checkArg Source . map T.pack


-- | 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 :: Maybe Bool -> Cdio U.Assertion
checkMmc b = do
    v <- getArg MmcSupported
    return $ if Y.isJust v
        then case b of
            Just _ -> (T.toLower . T.pack . show <$> b) @=? v
            Nothing -> return ()
        else U.assertFailure "Session does not describe MMC status."


testCdio :: [FilePath] -> (FilePath -> Cdio [U.Assertion]) -> U.Test
testCdio = testCdioMode Nothing

testCdioMode :: Maybe AccessMode -> [FilePath] -> (FilePath -> Cdio [U.Assertion]) -> U.Test
testCdioMode m fs c = U.TestList . flip map fs $ \f -> f ~: U.TestCase $ do
    o <- D.withCurrentDirectory Foreign.dataDir . open' (Just f) False $ c f
    either (const $ U.assertFailure "Can't open the image or device") sequence_ o
  where open' = case m of
            Just m' -> openMode m'
            Nothing -> open