packages feed

hscdio-0.1.0.0: test/Test/Libcdio/Upstream/Foreign/BinCue.hs

{-|
Description:    

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

Stability:      experimental
Portability:    portable
-}
module Test.Libcdio.Upstream.Foreign.BinCue
    ( tests
    , goodCues
    , badCues
    ) where


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

import qualified Data.Maybe as Y

-- import qualified System.Directory as D

import Foreign.Libcdio.Device

import Test.Libcdio.Upstream.Foreign.Common


tests :: U.Test
tests = "Foreign.Libcdio.Test.BinCue" ~: U.TestList
    [ parse
    , open
    ]


parse :: U.Test
parse = "Distinguish valid and invalid CUE files" ~: U.TestList
    (map good goodCues ++ map bad badCues)
  where good = cueTest Y.isJust "is not recognized as a CUE file"
        bad = cueTest Y.isNothing "should not be recognized as a CUE file"
        cueTest t s f = U.TestCase $ t <$> binFromCue (dataFile f) @? "'" ++ f ++ "' " ++ s

goodCues :: [FilePath]
goodCues =
    [ "cdda.cue"
    , "isofs-m1.cue"
    ]

badCues :: [FilePath]
badCues =
    [ "bad-cat1.cue"
    , "bad-cat2.cue"
    , "bad-cat3.cue"
    , "bad-mode1.cue"
    , "bad-msf-1.cue"
    , "bad-msf-2.cue"
    , "bad-msf-3.cue"
    ]


open :: U.Test
open = "CUE files open the associated device correctly" ~: U.TestCase $ do
    c <- cdioOpen (Just $ dataFile "cdda.cue") DriverUnknown
    cdio <- case c of
        Nothing -> U.assertFailure "Can't open the CUE file"
        Just c' -> return c'
    
    b <- setBlocksize cdio 2048
    b @?= Unsupported
    
    checkMmc cdio $ Just False
    checkAccessMode cdio [Image]
    
    {- Seems to be either an unimplemented or a reverted equivalence
    d <- D.withCurrentDirectory dataDir . defaultDevice $ Just cdio
    device <- case d of
        Nothing -> U.assertFailure "No default device returned for the CUE file"
        Just d' -> return d'
    checkSource cdio [device]
    -}
    
    s <- setSpeed cdio 5
    s @?= Unsupported
    
    return ()