{-# LANGUAGE ExistentialQuantification, ImpredicativeTypes, RankNTypes #-}
module Main where
import qualified Algebra.Ring.Polynomial            as P
import qualified Algebra.Ring.PolynomialAccumulated as PA
import           Control.Applicative
import           Control.DeepSeq
import           Control.Monad
import           Control.Parallel.Strategies
import           Criterion.Main
import           Data.Type.Monomorphic
import qualified SequenceMonomial                   as S
import           System.Random
import           Test.QuickCheck

data MonomPair = forall n. MonomPair { getMonoms :: !(P.Monomial n, P.Monomial n) }
data AMonomPair = forall n. AMonomPair { getAMonoms :: !(PA.Monomial n, PA.Monomial n) }

instance NFData MonomPair where
  rnf (MonomPair (n, m)) = rnf n `seq` rnf m `seq` ()

instance NFData AMonomPair where
  rnf (AMonomPair (n, m)) = rnf n `seq` rnf m `seq` ()

main :: IO ()
main = do
  as0 <- replicateM 5 genMonomial
  as <- return $!! (as0 `using` rdeepseq)
  defaultMain $ zipWith mkTestCase [1..] as

genMonomial :: IO (MonomPair, AMonomPair, (S.Monomial, S.Monomial))
genMonomial = do
  len <- abs <$> randomRIO (5, 20)
  liftM head . sample' $ do
    m <- map abs <$> vector len
    n <- map abs <$> vector len
    let mp = withPolymorhic len $ \sn -> MonomPair (P.fromList sn m, P.fromList sn n)
        amp = withPolymorhic len $ \sn -> AMonomPair (PA.fromList sn m, PA.fromList sn n)
    return (mp, amp, (S.fromList m, S.fromList n))

instance NFData Ordering where
  rnf EQ = ()
  rnf LT = ()
  rnf GT = ()

mkTestCase :: Int -> (MonomPair, AMonomPair, (S.Monomial, S.Monomial)) -> Benchmark
mkTestCase n (MonomPair m, AMonomPair am, m') =
    bgroup ("case-" ++ show n ++ "-len" ++ show len) $
           map subcase
                   [ ("lex", P.lex, PA.lex, S.lex)
                   , ("revlex", P.revlex, PA.revlex, S.revlex)
                   , ("grlex", P.grlex, PA.grlex, S.grlex)
                   , ("grevlex", P.grevlex, PA.grevlex, S.grevlex)
                   ]
  where
    len = S.length $ fst m'
    subcase :: (String, P.MonomialOrder, PA.MonomialOrder, S.MonomialOrder) -> Benchmark
    subcase (name, pol, apol, sq) =
        bgroup name [ bench "vector" $ nf (uncurry pol) m
                    , bench "accvec" $ nf (uncurry apol) am
                    , bench "sequence" $ nf (uncurry sq) m'
                    ]