{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans       #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HarmTrace.Base.Chord.Tests
-- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
--                Multiphonyx Holding BV
-- License     :  LGPL-3
--
-- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Summary: Defines some property tests for testing the HarmTrace.Base package
--------------------------------------------------------------------------------
module Main where

import HarmTrace.Base.Chord
import HarmTrace.Base.Parse   ( parseDataSafe, pChord )
import HarmTrace.Base.Time

import Test.QuickCheck
import Test.QuickCheck.Batch

import Data.List              ( sort, foldl' )

import System.Exit            ( exitFailure, exitSuccess )

instance Arbitrary DiatonicNatural where
  arbitrary = elements . enumFrom $ C

instance Arbitrary IntNat where
  arbitrary = elements . enumFrom $ I1
  
instance Arbitrary Accidental where
  arbitrary = elements [Nat,Sh,Fl,SS,FF]


instance Arbitrary Root where
  arbitrary = elements . map pcToRoot $ [0..11]
  
instance Arbitrary Interval where
  arbitrary = choose (0,21) >>= return . icToInterval  
  
-- instance Arbitrary a => Arbitrary (Note a) where
  -- arbitrary = do nat <- arbitrary
                 -- acc <- arbitrary
                 -- return (Note acc nat)

               
instance Arbitrary Shorthand where
  arbitrary = elements . enumFrom $ Maj
  
instance Arbitrary Addition where
  arbitrary = oneof [ arbitrary >>= return . Add
                    , arbitrary >>= return . NoAdd ]

instance Arbitrary a => Arbitrary (Chord a) where
  arbitrary = do r   <- arbitrary
                 sh  <- elements [Maj, Min, Aug, Dim, Maj7, Min7, Sev, Dim7, HDim7, Aug7, MinMaj7]
                 -- sh  <- arbitrary
                 -- add <- arbitrary >>= listOf . return . Add 
                 
                 b   <- arbitrary
                 return (Chord r sh [] b ) -- (Note Nat I1))
                 
instance Arbitrary a => Arbitrary (Timed a) where
  arbitrary = do x  <- arbitrary
                 s  <- elements [2 .. 5]
                 ts <- vector s -- guarantee that this list has a minimum of 2 items
                 return . Timed x . sort $ ts
               
newtype ChkTimed = ChkTimed [Timed ChordLabel] deriving (Show, Eq)
instance Arbitrary ChkTimed where
  arbitrary = do let f :: [Timed a] -> (a, NumData) -> [Timed a]
                     f [   ] (a, x) = [timed a 0 x]
                     f (h:t) (a, x) = let o = offset h in timed a o (o+x) : h : t
                     
                     dups :: [Bool] -> [a] -> [a]
                     dups [ ]     l     = l
                     dups _      [ ]    = []
                     dups (b:bs) (e:es) | b         = e : dups bs (e : es)
                                        | otherwise = e : dups bs es
                 
                 ds <- arbitrary 
                 as <- arbitrary >>= return . dups ds
                 ns <- arbitrary >>= return . filter (> 0) 
                 return . ChkTimed . reverse . foldl' f [] $ zip as ns
                 
instance Arbitrary BeatTime where
  arbitrary = do choose (0.0, 100.0) >>= return . Time

                 
pcProp :: Root -> Bool
pcProp r = (toPitchClass r) == toPitchClass (pcToRoot (toPitchClass r))

pcSetProp :: Chord Root -> Bool
pcSetProp c = c == toChord (chordRoot c) (toIntSet c) (Just $ chordBass c)

intervalProp :: Interval -> Bool
intervalProp i = i == icToInterval (toIntervalClss i)

intervalProp2 :: Int -> Bool
intervalProp2 i = i == toIntervalClss (icToInterval i)

enHarEqProp :: Root -> Bool
enHarEqProp a = a &== a

parseProp :: Chord Root -> Bool
parseProp c = parseDataSafe pChord (show c) == c

mergeTimedTest :: ChkTimed -> Bool
mergeTimedTest (ChkTimed cs) = expandTimed (mergeTimed cs) == cs

mergeTimedTest2 :: ChkTimed -> Bool
mergeTimedTest2 (ChkTimed cs) = expandTimed cs == cs

mergeTimedTest3 :: ChkTimed -> Bool
mergeTimedTest3 (ChkTimed cs) = mergeTimed (mergeTimed cs) == mergeTimed cs

--------------------------------------------------------------------------------
-- Execute the tests
--------------------------------------------------------------------------------

main :: IO ()
main = do let opts = TestOptions 100    -- nr of tests to run
                                 0      -- no time limit
                                 True   -- debug?
              myTest s p = runTests ("Testing HarmTrace-Base: "++ s ++" ... ") 
                                    opts . map run $ p
          myTest "roots"        [ pcProp, enHarEqProp ]
          myTest "chords"       [ pcSetProp, parseProp ]
          myTest "intervals I"  [ intervalProp ]
          myTest "intervals II" [ intervalProp2 ]
          myTest "mergeTimed"   [ mergeTimedTest, mergeTimedTest2, mergeTimedTest3 ]