{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
module IntervalAlgebraSpec (spec) where

import Test.Hspec                 ( hspec, describe, it, Spec, shouldBe )
import Test.Hspec.QuickCheck      ( modifyMaxSuccess, modifyMaxDiscardRatio )
import Test.QuickCheck            ( (===)
                                  , (==>)
                                  , quickCheck
                                  , generate
                                  , Gen(..)
                                  , Arbitrary(arbitrary)
                                  , Property
                                  , Testable(property) )
import GHC.Real                   ( Rational(..), Real(..) )
import Data.Maybe                 ( fromJust, isJust, isNothing )
import Data.Either                ( isRight )
import Data.Fixed                 ( Pico )
import IntervalAlgebra.Arbitrary  ()
import Data.Time as DT            ( Day(..)
                                  , UTCTime(..)
                                  , DiffTime
                                  , fromGregorian
                                  , secondsToDiffTime
                                  , picosecondsToDiffTime, NominalDiffTime
                                  )
import Data.Set                   ( Set
                                  , member
                                  , disjointUnion
                                  , fromList )
import IntervalAlgebra as IA      

mkIntrvl :: Int -> Int -> Interval Int
mkIntrvl = beginerval

prop_expandl_end ::(IntervalSizeable a b, Show a)=>
       b
    -> Interval a
    -> Property
prop_expandl_end d i = end (expandl d i) === end i


prop_expandr_begin ::(IntervalSizeable a b, Show a)=>
       b
    -> Interval a
    -> Property
prop_expandr_begin d i = begin (expandr d i) === begin i

-- | The relation between x and z should be an element of the set of the
--   composed relations between x y and between y z.
prop_compose :: Ord a =>
       Interval a
    -> Interval a
    -> Interval a
    -> Property
prop_compose x y z = member (relate x z) (compose (relate x y) (relate y z)) === True

-- | If two intervals are disjoint and not meeting, then there should be a gap
-- between the two (by ><), after the intervals are sorted.
prop_combinable_gap_exists :: Ord a => 
     Interval a
  -> Interval a
  -> Property 
prop_combinable_gap_exists x y = 
  (before <|> after) x y ==> isJust (uncurry (><) (min x y, max x y))

-- | If two intervals are not disjoint or meeting, then there should be NO gap
-- between the two (by ><), after the intervals are sorted.
prop_combinable_nogap_exists :: Ord a => 
     Interval a
  -> Interval a
  -> Property 
prop_combinable_nogap_exists x y = 
  (predicate $ complement $ fromList [Before, After]) x y ==> 
    isNothing (uncurry (><) (min x y, max x y))


spec :: Spec
spec = do
  describe "Basic Interval unit tests of typeclass and creation methods" $
    do
      it "equality works" $ beginerval 6 (1::Int) == beginerval 6 1 `shouldBe` True
      it "equality works" $ beginerval 0 (1::Int) == beginerval (-1) 1 `shouldBe` True
      it "equality works" $ enderval 1 (2::Int) == beginerval 1 1 `shouldBe` True
      it "not equality works" $ enderval 5 (2::Int) /= beginerval 1 1 `shouldBe` True

      it "parsing fails on bad inputs" $
         parseInterval 10 0 `shouldBe` Left (IA.ParseErrorInterval "0<10")
      it "parsing works on good inputs" $
         parseInterval 0 10 `shouldBe` Right (beginerval 10 (0::Int))

      it "show displays intervals as expected" $
         show (beginerval 10 (0::Int)) `shouldBe` "(0, 10)"

      it "fmap can convert Interval Integer to Interval Day" $
         fmap ModifiedJulianDay (beginerval 1 0) `shouldBe`
            beginerval 1 (fromGregorian 1858 11 17)

      it "(0, 2) <= (1, 3) is True" $
          beginerval 2 (0::Int) <= beginerval 2 1 `shouldBe` True

      it "(1, 2) < (0, 3) is True" $
          beginerval 2 (1::Int) < beginerval 3 0 `shouldBe` False
      it "(0, 2) < (1, 3) is True" $
          beginerval 2 (0::Int) < beginerval 2 1 `shouldBe` True
      it "(0, 2) < (0, 3) is True" $
          beginerval 2 (0::Int) < beginerval 3 0 `shouldBe` True

  describe "Basic IntervalRelation unit tests" $
    do 
      it "equality of IntervalRelations" $ Before == Before `shouldBe` True
      it "equality of IntervalRelations" $ Before /= After `shouldBe` True

      it "Bounds are set correctly" $ minBound @IntervalRelation `shouldBe` Before
      it "Bounds are set correctly" $ maxBound @IntervalRelation `shouldBe` After

      it "show Before is Before" $ show Before `shouldBe` "Before"

  describe "Relate unit tests" $
    do 
      it "relate before" $ 
        relate (beginerval 1 (0::Int)) (beginerval 1 2) `shouldBe` Before 
      it "relate after" $
        relate (beginerval 1 (2::Int)) (beginerval 1 0) `shouldBe` After 
      it "relate meets" $ 
        relate (beginerval 1 (0::Int)) (beginerval 1 1) `shouldBe` Meets 
      it "relate metBy" $ 
        relate (beginerval 1 (1::Int)) (beginerval 1 0) `shouldBe` MetBy 
      it "relate overlaps" $ 
        relate (beginerval 3 (0::Int)) (beginerval 5 2) `shouldBe` Overlaps 
      it "relate overlappedBy" $ 
        relate (beginerval 5 (2::Int)) (beginerval 3 0) `shouldBe` OverlappedBy
      it "relate starts" $
        relate (beginerval 3 (0::Int)) (beginerval 5 0) `shouldBe` Starts 
      it "relate startedBy" $
        relate (beginerval 5 (0::Int)) (beginerval 3 0) `shouldBe` StartedBy
      it "relate finishes" $
        relate (enderval 3 (0::Int)) (enderval 5 0) `shouldBe` Finishes
      it "relate finishedBy" $
        relate (enderval 5 (0::Int)) (enderval 3 0) `shouldBe` FinishedBy
      it "relate during" $
        relate (beginerval 1 (1::Int)) (beginerval 3 0) `shouldBe` During
      it "relate Contains" $
        relate (beginerval 3 (0::Int)) (beginerval 1 1) `shouldBe` Contains

  describe "IntervalRelation algebraic operations" $
    do 
      it "converse of Before is After" $ converse (fromList [Before]) `shouldBe`  fromList [After]

      it "union of IntervalRelations" $ union (fromList [Before]) (fromList [After]) 
        `shouldBe` fromList [Before, After]
      it "intersection of IntervalRelations" $ intersection (fromList [Before]) (fromList [After]) 
        `shouldBe` fromList []

  describe "IntervalSizeable tests" $
    do
      it "moment is 1" $ moment @Int `shouldBe` 1
      it "moment' is 1" $ moment' (beginerval 1 (0::Int)) `shouldBe` 1
      it "expandl doesn't change end"   $ property (prop_expandl_end @Int)
      it "expandr doesn't change begin" $ property (prop_expandr_begin @Int)
      it "expand 0 5 Interval (0, 1) should be Interval (0, 6)" $
        expand 0 5 (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (6::Int) (0::Int)
      it "expand 5 0 Interval (0, 1) should be Interval (-5, 1)" $
        expand 5 0 (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (6::Int) (-5::Int)
      it "expand 5 5 Interval (0, 1) should be Interval (-5, 6)" $
        expand 5 5 (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (11::Int) (-5::Int)
      it "expand -1 5 Interval (0, 1) should be Interval (-5, 6)" $
        expand (-1) 5 (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (6::Int) (0::Int)
      it "expand 5 -5 Interval (0, 1) should be Interval (-5, 1)" $
        expand 5 (-5) (beginerval (1::Int) (0::Int)) `shouldBe` beginerval (6::Int) (-5::Int)
      it "expand moment 0 Interval (0, 1) should be Interval (-1, 1)" $
        expand (moment @Int) 0 (beginerval (1::Int) (0::Int)) `shouldBe`
         beginerval (2::Int) (-1::Int)

      it "beginerval 2 10 should be Interval (10, 12)" $
        Right (beginerval (2::Int) 10) `shouldBe` parseInterval (10::Int) (12::Int)
      it "beginerval 0 10 should be Interval (10, 11)" $
        Right (beginerval (0::Int) 10) `shouldBe` parseInterval (10::Int) (11::Int)
      it "beginerval -2 10 should be Interval (10, 11)" $
        Right (beginerval (-2::Int) 10) `shouldBe` parseInterval (10::Int) (11::Int)
      it "enderval 2 10 should be Interval (8, 10)" $
        Right (enderval (2::Int) 10) `shouldBe` parseInterval (8::Int) (10::Int)
      it "enderval 0 10 should be Interval (9, 10)" $
        Right (enderval (0::Int) 10) `shouldBe` parseInterval (9::Int) (10::Int)
      it "enderval -2 10 should be Interval (9, 10)" $
        Right (enderval (-2::Int) 10) `shouldBe` parseInterval (9::Int) (10::Int)

      it "diffFromBegin can convert Interval Int to Interval Int" $
         diffFromBegin 
            (beginerval 2 (4 :: Int))
            (beginerval 2 10) `shouldBe`
            beginerval 2 6 -- (6, 8)

      it "diffFromEnd can convert Interval Int to Interval Int" $
         diffFromEnd
            (beginerval 2 (4 :: Int))
            (beginerval 2 10) `shouldBe`
            beginerval 2 4 -- (4, 6)

      it "diffFromBegin can convert Interval Day to Interval Integer" $
         diffFromBegin 
            (beginerval 2 (fromGregorian 2001 1 1))
            (beginerval 2 (fromGregorian 2001 1 10)) `shouldBe`
            beginerval 2 9 -- (9, 11)

      it "diffFromEnd can convert Interval Day to Interval Integer" $
         diffFromEnd
            (beginerval 2 (fromGregorian 2001 1 1))
            (beginerval 2 (fromGregorian 2001 1 10)) `shouldBe`
            beginerval 2 7 -- (7, 9)

      it "momentize works" $
         momentize
            (beginerval 2 (fromGregorian 2001 1 1))
            `shouldBe`
            beginerval 1 (fromGregorian 2001 1 1)


  describe "Intervallic tests" $
    --  modifyMaxSuccess (*10000) $
     do
      it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (-1, 4) is True" $
        (startedBy <|> overlappedBy) (mkIntrvl 9 0) (mkIntrvl 5 (-1))
         `shouldBe` True
      it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (0, 4) is True" $
        (startedBy <|> overlappedBy) (mkIntrvl 9 0) (mkIntrvl 4 0)
         `shouldBe` True
      it "(startedBy <|> overlappedBy) Interval (0, 9) Interval (-1, 9) is False" $
        (startedBy <|> overlappedBy) (mkIntrvl 9 0) (mkIntrvl 10 (-1))
         `shouldBe` False
      it "disjoint x y same as explicit union of predicates" $
         disjoint (mkIntrvl 2 0) (mkIntrvl 2 3) `shouldBe`
         (before <|> after <|> meets <|> metBy) (mkIntrvl 2 0) (mkIntrvl 2 3)
      it "within x y same as explicit union of predicates" $
         within (mkIntrvl 2 3) (mkIntrvl 2 3) `shouldBe`
         (starts <|> during <|> finishes <|> equals) (mkIntrvl 2 3) (mkIntrvl 2 3)
      it "prop_compose holds" $
         property (prop_compose @Int)

  describe "IntervalCombinable tests" $
      do
        it "join non-meeting intervals is Nothing" $ 
          beginerval 2 (0::Int) .+. beginerval 6 5 `shouldBe` Nothing
        it "join meeting intervals is Just _" $ 
          beginerval 2 (0::Int) .+. beginerval 6 2 `shouldBe` Just (beginerval 8 0)

        it "gap of disjoint intervals should be something" $
          property (prop_combinable_gap_exists @Int) 
        it "gap of disjoint intervals should be something" $
          property (prop_combinable_gap_exists @Day) 
        it "gap of disjoint intervals should be something" $
          property (prop_combinable_gap_exists @UTCTime) 

        it "gap of nondisjoint, nonmeeting intervals should be nothing" $
          property (prop_combinable_nogap_exists @Int) 
        it "gap of nondisjoint, nonmeeting intervals should be nothing" $
          property (prop_combinable_nogap_exists @Day) 

  describe "Interval Algebra relation unit tests for synonyms" $
    do
      it "(0, 2) precedes (10, 12)" $
          beginerval  2 (0::Int) `precedes` beginerval 2 10 `shouldBe` True
      it "precedes matches before" $
          beginerval  10 (0::Int) `precedes` beginerval 1 11 `shouldBe`
          beginerval  10 (0::Int) `before` beginerval 1 11
      it "(10, 12) precededBy (0, 2)" $
          precededBy (beginerval 2 10) (beginerval  2 (0::Int)) `shouldBe` True
      it "precededBy matches after" $
          precededBy (beginerval 1 11) (beginerval  10 (0::Int)) `shouldBe` 
          after (beginerval 1 11) (beginerval  10 (0::Int))
      it "concur matches notDdisjoint" $
          concur (beginerval 1 11) (beginerval  10 (0::Int)) `shouldBe` 
          notDisjoint (beginerval 1 11) (beginerval  10 (0::Int))
      it "concur matches notDisjoint" $
          concur (beginerval 1 0) (beginerval  10 (0::Int)) `shouldBe` 
          notDisjoint (beginerval 1 0) (beginerval  10 (0::Int))