lapack-0.3.2: test/Main.hs

{-# LANGUAGE TypeFamilies #-}
module Main where

import qualified Test.Vector as Vector
import qualified Test.Matrix as Matrix
import qualified Test.Square as Square
import qualified Test.Triangular as Triangular
import qualified Test.Symmetric as Symmetric
import qualified Test.Hermitian as Hermitian
import qualified Test.Banded as Banded
import qualified Test.BandedHermitian as BandedHermitian
import qualified Test.LowerUpper as LowerUpper
import qualified Test.Orthogonal as Orthogonal
import qualified Test.Singular as Singular
import qualified Test.Shape as Shape
import qualified Test.Permutation as Permutation
import qualified DocTest.Main as DocTestMain
import Test.Format ()
import Test.Utility (Tagged(Tagged), prefix)

import qualified Test.QuickCheck as QC
import qualified Test.DocTest.Driver as DocTest

import Numeric.LAPACK.Scalar (RealOf)

import qualified Numeric.Netlib.Class as Class

import Type.Base.Proxy (Proxy(Proxy))

import System.Exit (exitFailure)

import Text.Printf (printf)

import qualified Control.Monad.Trans.Writer.Strict as MW
import qualified Control.Monad.Trans.Reader as MR
import Control.Monad.IO.Class (liftIO)
import Control.Monad (when, void)

import qualified Data.List as List
import Data.Complex (Complex)
import Data.Tuple.HT (mapSnd)


testsVar ::
   (Show a, Show ar,
    Class.Floating a, Eq a, RealOf a ~ ar, Class.Real ar, RealOf ar ~ ar) =>
   [(String, Tagged a QC.Property)]
testsVar =
   prefix "Vector" Vector.testsVar ++
   prefix "Matrix" Matrix.testsVar ++
   prefix "Square" Square.testsVar ++
   prefix "Triangular" Triangular.testsVar ++
   prefix "Symmetric" Symmetric.testsVar ++
   prefix "Hermitian" Hermitian.testsVar ++
   prefix "Banded" Banded.testsVar ++
   prefix "BandedHermitian" BandedHermitian.testsVar ++
   prefix "Permutation" Permutation.testsVar ++
   prefix "LowerUpper" LowerUpper.testsVar ++
   prefix "Orthogonal" Orthogonal.testsVar ++
   prefix "Singular" Singular.testsVar ++
   []

tagTests ::
   String -> Proxy tag ->
   [(String, Tagged tag QC.Property)] -> [(String, QC.Property)]
tagTests typeName Proxy =
   map (\(name, Tagged prop) -> (name++"."++typeName, prop))

tests :: [(String, QC.Property)]
tests =
   concat $ List.transpose $
   (tagTests "Float" (Proxy :: Proxy Float) testsVar) :
   (tagTests "Double" (Proxy :: Proxy Double) testsVar) :
   (tagTests "ComplexFloat" (Proxy :: Proxy (Complex Float)) testsVar) :
   (tagTests "ComplexDouble" (Proxy :: Proxy (Complex Double)) testsVar) :
   []

simpleTests :: [(String, QC.Property)]
simpleTests =
   prefix "Shape" Shape.tests ++
   []



run :: MW.WriterT DocTest.Count IO () -> IO ()
run act = do
   count <- MW.execWriterT act
   putStrLn ""
   void $ printf "Total: %d\n" $ DocTest.numTotal count
   void $ printf "Failures: %d\n" $ DocTest.numFailures count
   when (DocTest.numFailures count > 0) exitFailure

main :: IO ()
main =
   run $
   (>> MR.runReaderT DocTestMain.main QC.stdArgs) $

   mapM_
      (\(name,(args,act)) -> do
         liftIO (putStr (name ++ ": "))
         MR.runReaderT (DocTest.property act) args) $

   map (mapSnd ((,) (QC.stdArgs {QC.maxSuccess=200}))) tests
   ++
   map (mapSnd ((,) QC.stdArgs)) simpleTests