Image.hs

{-# 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"]