{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RebindableSyntax    #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}
-- |
-- Module      : Data.Array.Accelerate.Test.NoFib.Issues.Issue364
-- Copyright   : [2009..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- https://github.com/AccelerateHS/accelerate/issues/364
--

module Data.Array.Accelerate.Test.NoFib.Issues.Issue364 (

  test_issue364

) where

import Prelude                                            ( fromInteger, show )
import qualified Prelude                                  as P

import Data.Array.Accelerate                              hiding ( fromInteger )
import Data.Array.Accelerate.Sugar.Elt                    as S
import Data.Array.Accelerate.Sugar.Shape                  as S
import Data.Array.Accelerate.Test.NoFib.Base
import Data.Array.Accelerate.Test.NoFib.Config

import Hedgehog

import Test.Tasty
import Test.Tasty.HUnit


test_issue364 :: RunN -> TestTree
test_issue364 runN =
  testGroup "issue364"
    [ at @TestInt8   $ testElt i8
    , at @TestInt16  $ testElt i16
    , at @TestInt32  $ testElt i32
    , at @TestInt64  $ testElt i64
    -- , at @TestHalf   $ testElt f16
    , at @TestFloat  $ testElt f32
    , at @TestDouble $ testElt f64
    ]
    where
      testElt :: forall e. (Show e, Num e, Eq e, P.Num e, P.Enum e, P.Eq e)
              => Gen e
              -> TestTree
      testElt _ =
        testGroup (show (eltR @e))
          [ testCase "A" $ expectedArray @_ @e Z 64 @=? runN (scanl iappend one) (intervalArray Z 64)
          , testCase "B" $ expectedArray @_ @e Z 65 @=? runN (scanl iappend one) (intervalArray Z 65) -- failed for integral types
          ]


-- interval of summations monoid
--
one,top :: Num e => Exp (e, e)
one = T2 (-1) (-1)
top = T2 (-2) (-2)

iappend :: (Num e, Eq e) => Exp (e,e) -> Exp (e,e) -> Exp (e,e)
iappend x y =
  if x == one             then y   else
  if y == one             then x   else
  if x == top || y == top then top
    else
      let T2 x1 x2 = x
          T2 y1 y2 = y
       in
       if x2 + 1 == y1
         then T2 x1 y2
         else top

intervalArray :: (Shape sh, Elt e, P.Num e, P.Enum e)
    => sh
    -> Int
    -> Array (sh:.Int) (e,e)
intervalArray sh n
  = fromList (sh:.n)
  . P.concat
  $ P.replicate (S.size sh) [ (i,i) | i <- [0.. (P.fromIntegral n-1)] ]

expectedArray :: (Shape sh, Elt e, P.Num e, P.Enum e)
    => sh
    -> Int
    -> Array (sh:.Int) (e,e)
expectedArray sh n
  = fromList (sh:.n+1)
  $ P.concat
  $ P.replicate (S.size sh) $ (-1,-1) : [ (0,i) | i <- [0 .. P.fromIntegral n - 1] ]