{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-unused-local-binds #-} {-| 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.Image (tests) where import qualified Test.HUnit as U import Test.HUnit ( (@=?), (~:) ) import qualified Data.Either.Compat as E import qualified Data.Maybe as Y import qualified Data.Text as T import qualified System.Directory as D import Sound.Libcdio import Sound.Libcdio.Device import Sound.Libcdio.Read.CdText import Test.Libcdio.Upstream.Sound.Common import qualified Test.Libcdio.Upstream.Foreign.BinCue as Foreign import qualified Test.Libcdio.Upstream.Foreign.CdrDao as Foreign import qualified Test.Libcdio.Upstream.Foreign.Nrg as Foreign tests :: U.Test tests = "Sound.Libcdio.Test.Image" ~: U.TestList [ parseTests , run ] parseTests :: U.Test parseTests = "Distinguish valid and invalid image files" ~: U.TestList [ parseCue , parseToc ] parseCue :: U.Test parseCue = "CUE" ~: U.TestList (map good Foreign.goodCues ++ map bad Foreign.badCues) where good = parseTest "CUE" True bad = parseTest "CUE" False parseToc :: U.Test parseToc = "TOC" ~: U.TestList (map good Foreign.goodToc ++ map bad Foreign.badToc) where good = parseTest "TOC" True bad = parseTest "TOC" False parseTest :: String -> Bool -> FilePath -> U.Test parseTest i y f = msg ~: U.TestCase . D.withCurrentDirectory dataDir $ do o <- open (Just f) False $ return () y @=? E.isRight o where msg | y = f' ++ "is not recognized as a " ++ i' | otherwise = f' ++ "should not be recognized as a " ++ i' f' = "'" ++ f ++ "' " i' = i ++ " file" goodAll :: [FilePath] goodAll = Foreign.goodCues ++ Foreign.goodToc ++ Foreign.goodNrg goodCdText :: [FilePath] goodCdText = ["cdda.cue", "cdtext.toc"] ++ Foreign.goodNrg run :: U.Test run = U.TestList [ runAll , testCdText ] runAll :: U.Test runAll = "Expected session behaviour" ~: testCdio goodAll $ \f -> do _ <- setBlocksize 2048 m <- checkMmc $ Just False a <- checkAccessMode [Image] let f' = T.unpack . T.replace ".cue" ".bin" $ T.pack f s <- checkSource [f'] _ <- setSpeed 5 return [m, a, s] testCdText :: U.Test testCdText = "Properly-formed CDTEXT" ~: testCdio goodCdText . const $ do is <- cdText . withAll $ do i <- info Nothing i1 <- info $ Just 1 l' <- discId g' <- genre return (i, i1, l', g') let is' = E.fromRight [] is let checkCdText (i, i1, _, _) = map (\f -> f i) discTests ++ map (\f -> f i1) trackTests --checkCdText (i, i1, l', g') = map (\f -> f i) discTests ++ [l l', g g'] ++ map (\f -> f i1) trackTests p i = Just "Richard Stallman" @=? performer i t i = Just "Join us now we have the software" @=? title i s i = Nothing @=? songwriter i c i = Nothing @=? composer i a i = Nothing @=? arranger i m i = Nothing @=? message i o i = Nothing @=? code i l l' = Just "0000010271955" @=? l' g g' = (Nothing, Nothing) @=? g' --discTests = [p, t, s, c, a, m, o] discTests = [p, t] p1 i1 = Just "Richard S" @=? performer i1 t1 i1 = Just "Soft" @=? title i1 s1 i1 = Nothing @=? songwriter i1 c1 i1 = Nothing @=? composer i1 a1 i1 = Nothing @=? arranger i1 m1 i1 = Nothing @=? message i1 o1 i1 = Just "US-XX1-98-01234" @=? code i1 --trackTests = [p1, t1, s1, c1, a1, m1, o1] trackTests = [] return $ case length is' of 0 -> [U.assertFailure "Can't access the CD Text"] 1 -> checkCdText . head $ Y.catMaybes is' _ -> [U.assertFailure "Trailing CD Text languages"]