{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

module Main (main) where

import           Data.Proxy
import           Data.Typeable
import           Data.Monoid

import           Data.Map.Strict          (Map)

import qualified Data.Vector              as Vector
import qualified Data.Vector.Storable     as Storable
import qualified Data.Vector.Unboxed      as Unboxed

import           Data.Semiring
import           Data.Semiring.Infinite
import           Data.Semiring.Numeric

import           Numeric.Natural
import           Numeric.Sized.WordOfSize

import           Test.DocTest
import           Test.Tasty
import qualified Test.Tasty.QuickCheck    as QC
import qualified Test.Tasty.SmallCheck    as SC

import           Test.Semiring

import           ApproxLog
import           Fraction
import           Func
import           LimitSize
import           Orphans                  ()
import           Vectors
import           Properties

type Tup2 a = (a,a)
type Tup3 a = (a,a,a)
type Tup4 a = (a,a,a,a)
type Tup5 a = (a,a,a,a,a)
type Tup6 a = (a,a,a,a,a,a)
type Tup7 a = (a,a,a,a,a,a,a)
type Tup8 a = (a,a,a,a,a,a,a,a)
type Tup9 a = (a,a,a,a,a,a,a,a,a)

groupType :: Typeable a => Proxy a -> [Proxy a -> TestTree] -> TestTree
groupType p = testGroup (show (typeRep p)) . map ($p)

typeclassTests :: TestTree
typeclassTests =
    testGroup
        "typeclass tests"
        [ storableQCT (Proxy :: Proxy
              [ PositiveInfinite Int
              , NegativeInfinite Int
              , Infinite Int
              ])
        , liftedQCT (Proxy :: Proxy
              [ PositiveInfinite
              , NegativeInfinite
              , Infinite
              , Add
              , Mul
              , Max
              , Min
              , Bottleneck
              , Division
              , Łukasiewicz
              , Viterbi
              , PosFrac
              , PosInt
              ])]

semiringLawTests :: TestTree
semiringLawTests =
    testGroup
        "Semiring/StarSemiring Laws"
        [ semiringLawsSCT (Proxy :: Proxy
              [ ApproxLog Double
              , SApproxLog Double
              , Integer
              , PositiveInfinite Natural
              , Int
              , WordOfSize 2
              , Tup2 (WordOfSize 2)
              , ()
              , Bool
              , Any
              , All
              , Min (PositiveInfinite Integer)
              , Max (NegativeInfinite Integer)
              , Division Integer
              , Viterbi Fraction
              , Łukasiewicz Fraction
              ])
        , semiringLawsQCT (Proxy :: Proxy
              [ Matrix V0 V0 Integer
              , Matrix V1 V1 Integer
              , Matrix V2 V2 Integer
              , Matrix V5 V5 Integer
              , Func Bool Bool
              , Tup3 (WordOfSize 2)
              , Tup4 Int
              , Tup5 Int
              , Tup6 Int
              , Tup7 Int
              , Tup8 Int
              , Tup9 Int
              , [Int]
              , Vector.Vector Int
              , Storable.Vector Int
              , Unboxed.Vector Int
              ])
        , starLawsQCT (Proxy :: Proxy
              [ Tup4 (PositiveInfinite Int)
              , Tup5 (PositiveInfinite Int)
              , Tup6 (PositiveInfinite Int)
              , Tup7 (PositiveInfinite Int)
              , Tup8 (PositiveInfinite Int)
              , Tup9 (PositiveInfinite Int)
              , LimitSize 100 (PositiveInfinite Integer)
              ])
        , starLawsSCT (Proxy :: Proxy
              [ Tup2 (PositiveInfinite (WordOfSize 2))
              , Tup3 (PositiveInfinite (WordOfSize 2))
              , ()
              , Bool
              , Any
              , All
              , Min (Infinite Integer)
              , Max (Infinite Integer)
              ])
        , ordLawsQCT (Proxy :: Proxy '[])
        , ordLawsSCT (Proxy :: Proxy
              [ Integer
              , PositiveInfinite Natural
              , Int
              , ()
              , Bool
              , Any
              , All
              ])
        , zeroLawsQCT (Proxy :: Proxy
              [ Tup3 (WordOfSize 2)
              , Tup4 Int
              , Tup5 Int
              , Tup6 Int
              , Tup7 Int
              , Tup8 Int
              , Tup9 Int
              ])
        , zeroLawsSCT (Proxy :: Proxy
              [ Integer
              , PositiveInfinite Natural
              , Int
              , WordOfSize 2
              , Tup2 (WordOfSize 2)
              , ()
              , Bool
              , Any
              , All
              , Min (PositiveInfinite Integer)
              , Max (NegativeInfinite Integer)
              , Division Integer
              , Viterbi Fraction
              , Łukasiewicz Fraction
              ])
        , refListMulQCT (Proxy :: Proxy
              [ [Int]
              , Vector.Vector Int
              , Unboxed.Vector Int
              , Storable.Vector Int
              , Unboxed.Vector (NegativeInfinite Int)
              , Unboxed.Vector (Infinite Int)
              ])
        , groupType
              (Proxy :: Proxy (Map String Int))
              [localOption (QC.QuickCheckMaxSize 10) . semiringLawsQC]
        , testGroup
              "Endo Bool"
              [ QC.testProperty
                    "plusId"
                    (plusId :: UnaryLaws (EndoFunc (Add Bool)))
              , QC.testProperty
                    "mulId"
                    (mulId :: UnaryLaws (EndoFunc (Add Bool)))
              , QC.testProperty
                    "annihilateR"
                    (annihilateR :: UnaryLaws (EndoFunc (Add Bool)))
              , zeroLawsQC (Proxy :: Proxy (EndoFunc (Add Bool)))
              , QC.testProperty
                    "plusComm"
                    (plusComm :: BinaryLaws (EndoFunc (Add Bool)))
              , QC.testProperty
                    "plusAssoc"
                    (plusAssoc :: TernaryLaws (EndoFunc (Add Bool)))
              , QC.testProperty
                    "mulAssoc"
                    (mulAssoc :: TernaryLaws (EndoFunc (Add Bool)))
              , QC.testProperty
                    "mulDistribR"
                    (mulDistribR :: TernaryLaws (EndoFunc (Add Bool)))]
        , testGroup
              "Negative Infinite Integer"
              [ SC.testProperty
                    "plusId"
                    (plusId :: UnaryLaws (NegativeInfinite Integer))
              , SC.testProperty
                    "mulId"
                    (mulId :: UnaryLaws (NegativeInfinite Integer))
              , SC.testProperty
                    "annihilateR"
                    (annihilateR :: UnaryLaws (NegativeInfinite Integer))
              , zeroLawsSC (Proxy :: Proxy (NegativeInfinite Integer))
              , SC.testProperty
                    "plusComm"
                    (plusComm :: BinaryLaws (NegativeInfinite Integer))
              , ordLawsSC (Proxy :: Proxy (NegativeInfinite Integer))
              , SC.testProperty
                    "plusAssoc"
                    (plusAssoc :: TernaryLaws (NegativeInfinite Integer))
              , SC.testProperty
                    "mulAssoc"
                    (mulAssoc :: TernaryLaws (NegativeInfinite Integer))
              , SC.testProperty
                    "mulDistribL"
                    (mulDistribL :: TernaryLaws (NegativeInfinite Integer))]
        , testGroup
              "Infinite Integer"
              [ SC.testProperty
                    "plusId"
                    (plusId :: UnaryLaws (Infinite Integer))
              , SC.testProperty "mulId" (mulId :: UnaryLaws (Infinite Integer))
              , SC.testProperty
                    "annihilateR"
                    (annihilateR :: UnaryLaws (Infinite Integer))
              , SC.testProperty
                    "annihilateL"
                    (annihilateL :: UnaryLaws (Infinite Integer))
              , zeroLawsSC (Proxy :: Proxy (Infinite Integer))
              , SC.testProperty
                    "plusComm"
                    (plusComm :: BinaryLaws (Infinite Integer))
              , ordLawsSC (Proxy :: Proxy (Infinite Integer))
              , SC.testProperty
                    "plusAssoc"
                    (plusAssoc :: TernaryLaws (Infinite Integer))
              , SC.testProperty
                    "mulAssoc"
                    (mulAssoc :: TernaryLaws (Infinite Integer))]
        ]

main :: IO ()
main = do
    doctest ["-isrc", "src/"]
    defaultMain $ testGroup "Tests" [typeclassTests, semiringLawTests]