{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications  #-}
{- HLINT ignore -}
module IntervalAlgebra.IntervalUtilitiesSpec
  ( spec
  ) where

import           Control.Monad                  ( liftM2 )
import           Data.List                      ( sort )
import           Data.Maybe                     ( fromJust
                                                , isJust
                                                , isNothing
                                                )
import           Data.Set                       ( Set
                                                , difference
                                                , fromList
                                                , member
                                                , toList
                                                )
import qualified Data.Set                       ( null )
import           Data.Time                      ( Day
                                                , UTCTime
                                                )
import           IntervalAlgebra                ( Interval
                                                , IntervalCombinable(..)
                                                , IntervalRelation(..)
                                                , IntervalSizeable
                                                , Intervallic(..)
                                                , beginerval
                                                , complement
                                                , converse
                                                , disjointRelations
                                                , duration
                                                , intervalRelations
                                                , moment
                                                , predicate
                                                , rangeInterval
                                                , safeInterval
                                                , starts
                                                , strictWithinRelations
                                                , withinRelations
                                                )
import           IntervalAlgebra.Arbitrary      ( arbitraryWithRelation )
import           IntervalAlgebra.IntervalUtilities
                                                ( clip
                                                , combineIntervals
                                                , combineIntervalsFromSorted
                                                , durations
                                                , filterAfter
                                                , filterBefore
                                                , filterConcur
                                                , filterContains
                                                , filterDisjoint
                                                , filterDuring
                                                , filterEnclosedBy
                                                , filterEncloses
                                                , filterEquals
                                                , filterFinishedBy
                                                , filterFinishes
                                                , filterMeets
                                                , filterMetBy
                                                , filterNotDisjoint
                                                , filterOverlappedBy
                                                , filterOverlaps
                                                , filterStartedBy
                                                , filterStarts
                                                , filterWithin
                                                , foldMeetingSafe
                                                , formMeetingSequence
                                                , gaps
                                                , gapsL
                                                , gapsWithin
                                                , intersect
                                                , nothingIfAll
                                                , nothingIfAny
                                                , nothingIfNone
                                                , relationsL
                                                )
import           IntervalAlgebra.PairedInterval ( PairedInterval
                                                , getPairData
                                                , makePairedInterval
                                                , trivialize
                                                )
import           Test.Hspec                     ( Spec
                                                , describe
                                                , it
                                                , shouldBe
                                                )
import           Test.Hspec.QuickCheck          ( modifyMaxDiscardRatio
                                                , modifyMaxSuccess
                                                )
import           Test.QuickCheck                ( (===)
                                                , (==>)
                                                , Arbitrary(arbitrary, shrink)
                                                , Arbitrary1(liftArbitrary)
                                                , Property
                                                , Testable(property)
                                                , elements
                                                , listOf
                                                , orderedList
                                                , resize
                                                , sublistOf
                                                , suchThat
                                                )
import           Witherable                     ( Filterable )

-- Types for testing

-- SmallInterval is just to test properties for which events of interest are so
-- rare QuickCheck gives up, e.g. filterEquals
newtype SmallInterval
  = SmallInterval { unSmall :: Interval Int }
  deriving (Eq, Show)

instance Arbitrary SmallInterval where
  arbitrary = SmallInterval . beginerval 0 <$> elements [0 .. 10]

-- A "state" here is just used test formMeetingSequence
newtype Events a
  = Events { getEvents :: [StateEvent a] }
  deriving (Eq, Ord, Show)

newtype State
  = State [Bool]
  deriving (Eq, Show)

instance Semigroup State where
  State x <> State y = State $ zipWith (||) x y

instance Monoid State where
  mempty = State [False, False, False]

newtype StateEvent a = MkEvent { getEvent :: PairedInterval State a }
   deriving (Eq, Ord, Show)

unEvents :: [StateEvent a] -> [PairedInterval State a]
unEvents = fmap getEvent

-- Type for checking arbitraryWithRelation
-- A target and reference pair, where targetInterval satisfies at least one of
-- refRelations relative to refInterval
data IntervalReferenced = IntervalReferenced
  { refInterval    :: Interval Int
  , refRelations   :: Set IntervalRelation
  , targetInterval :: Maybe (Interval Int)
  }
  deriving (Eq, Show)


mkEv :: IntervalSizeable a a => (a, a) -> b -> PairedInterval b a
mkEv i s = makePairedInterval s (safeInterval i)

instance Arbitrary State where
  arbitrary = State <$> suchThat (listOf arbitrary) (\x -> length x == 3)

-- SmallInterval again to address issue of generating from too large a possible
-- range of intervals
instance Arbitrary (StateEvent Int) where
  arbitrary = liftM2 (\x y -> MkEvent $ makePairedInterval x y)
                     arbitrary
                     (unSmall <$> arbitrary)

instance Arbitrary (Events Int) where
  arbitrary = Events <$> orderedList

-- restricted refIv to decrease rareness causing quickcheck to quit
instance Arbitrary IntervalReferenced where
  arbitrary = do
    refIv <- liftM2 beginerval (elements [1 .. 3]) (elements [0 .. 3])
    rels  <- fromList <$> sublistOf (toList intervalRelations)
    iv    <- arbitraryWithRelation refIv rels
    pure $ IntervalReferenced refIv rels iv

-- Testing functions
checkSeqStates :: (Intervallic i) => [i Int] -> Bool
checkSeqStates x = (length x > 1) || all (== Meets) (relationsL x)

-- Creation functions
iv :: Int -> Int -> Interval Int
iv = beginerval

evpi :: Int -> Int -> [Bool] -> StateEvent Int
evpi i j s = MkEvent $ makePairedInterval (State s) (beginerval i j)

-- Test cases
containmentInt :: Interval Int
containmentInt = iv (10 :: Int) (0 :: Int)

noncontainmentInt :: Interval Int
noncontainmentInt = iv 6 4

anotherInt :: Interval Int
anotherInt = iv 5 (15 :: Int)

gapInt :: Interval Int
gapInt = iv 5 (10 :: Int)

meets1 :: [Interval Int]
meets1 = [iv 2 0, iv 2 2]

meets2 :: [Interval Int]
meets2 = [iv 2 0, iv 2 2, iv 10 4, iv 2 14]

meets3 :: [PairedInterval Int Int]
meets3 = map (uncurry makePairedInterval)
             [(5, iv 2 0), (5, iv 2 2), (9, iv 10 4), (10, iv 2 14)]

meets3eq :: [PairedInterval Int Int]
meets3eq =
  map (uncurry makePairedInterval) [(5, iv 4 0), (9, iv 10 4), (10, iv 2 14)]

c0in :: [StateEvent Int]
c0in =
  [ evpi 9 1 [True, False, False]
  , evpi 8 2 [True, False, False]
  , evpi 3 5 [False, True, False]
  , evpi 3 6 [False, True, False]
  ]
c0out :: [StateEvent Int]
c0out =
  [ evpi 4 1 [True, False, False]
  , evpi 4 5 [True, True, False]
  , evpi 1 9 [True, False, False]
  ]

c1in :: [StateEvent Int]
c1in = [evpi 4 1 [True, False, False], evpi 4 6 [False, True, False]]
c1out :: [StateEvent Int]
c1out =
  [ evpi 4 1 [True, False, False]
  , evpi 1 5 [False, False, False]
  , evpi 4 6 [False, True, False]
  ]

c2in :: [StateEvent Int]
c2in = [evpi 4 1 [True, False, False], evpi 5 5 [False, True, False]]
c2out :: [StateEvent Int]
c2out = [evpi 4 1 [True, False, False], evpi 5 5 [False, True, False]]

c3in :: [StateEvent Int]
c3in = [evpi 4 1 [True, False, False], evpi 6 4 [False, True, False]]
c3out :: [StateEvent Int]
c3out =
  [ evpi 3 1 [True, False, False]
  , evpi 1 4 [True, True, False]
  , evpi 5 5 [False, True, False]
  ]

c4in :: [StateEvent Int]
c4in =
  [ evpi 1 (-1) [True, True, False]
  , evpi 1 3    [True, False, True]
  , evpi 1 3    [False, False, False]
  ]
c4out :: [StateEvent Int]
c4out =
  [ evpi 1 (-1) [True, True, False]
  , evpi 3 0    [False, False, False]
  , evpi 1 3    [True, False, True]
  ]



c5in :: [PairedInterval State Int]
c5in =
  [ mkEv (-63, 21) (State [False, True, True])
  , mkEv (-56, 20) (State [True, True, True])
  , mkEv (1  , 41) (State [False, True, False])
  , mkEv (11 , 34) (State [True, False, True])
  , mkEv (27 , 28) (State [False, True, True])
  ]

c5out :: [PairedInterval State Int]
c5out =
  [ mkEv (-63, -56) (State [False, True, True])
  , mkEv (-56, 34)  (State [True, True, True])
  , mkEv (34 , 41)  (State [False, True, False])
  ]

-- Properties

-- arbitraryWithRelation props
-- 'tautology' because this repeats the logic of arbitraryWithRelation
prop_withRelation_tautology :: IntervalReferenced -> Bool
prop_withRelation_tautology ir
  | isEnclose && isMom = isNothing iv
  | otherwise          = isJust iv && predicate rels refIv (fromJust iv)
 where
  refIv = refInterval ir
  iv    = targetInterval ir
  rels  = refRelations ir
  isEnclose =
    Data.Set.null $ Data.Set.difference rels (converse strictWithinRelations)
  isMom = duration refIv == moment @Int


-- Check that the only relation remaining after applying a function is Before
prop_before
  :: (Ord a) => ([Interval a] -> [Interval a]) -> [Interval a] -> Property
prop_before f x = relationsL ci === replicate (length ci - 1) Before
  where ci = f (sort x)

prop_combineIntervals1 :: (Ord a, Show a, Eq a) => [Interval a] -> Property
prop_combineIntervals1 = prop_before combineIntervals

prop_gaps1 :: (Ord a) => [Interval a] -> Property
prop_gaps1 = prop_before gapsL

-- In the case that that the input is not null, then
-- * all relationsL should be `Meets` after formMeetingSequence
prop_formMeetingSequence0 :: Events Int -> Property
prop_formMeetingSequence0 x =
  not (null es)
    ==> all (== Meets) (relationsL $ formMeetingSequence (unEvents es))
    === True
  where es = getEvents x

-- In the case that the input has
-- *     at least one Before relation between consequent pairs
-- * AND does not have any empty states
--
-- THEN the number empty states in the output should smaller than or equal to
--      the number before relationsL in the output
prop_formMeetingSequence1 :: Events Int -> Property
prop_formMeetingSequence1 x =
  (beforeCount > 0 && not
      (any (\x -> getPairData x == State [False, False, False])
           (unEvents $ getEvents x)
      )
    )
    ==> beforeCount
    >=  emptyCount
 where
  res         = formMeetingSequence (unEvents $ getEvents x)
  beforeCount = lengthWhen (== Before) (relationsL (unEvents $ getEvents x))
  emptyCount  = lengthWhen (\x -> getPairData x == mempty) res
  lengthWhen f = length . filter f

-- Check that formMeetingSequence doesn't return an empty list unless input is
-- empty.
prop_formMeetingSequence2 :: Events Int -> Property
prop_formMeetingSequence2 x = not (null $ getEvents x) ==> not $ null res
  where res = formMeetingSequence (unEvents $ getEvents x)

class ( Ord a ) => FiltrationProperties a  where
   prop_filtration ::
      (Interval a ->  [Interval a] -> [Interval a])
      -> Set IntervalRelation
      -> Interval a
      -> [Interval a]
      -> Property
   prop_filtration fltr s x l =
      not (null res) ==> and (fmap (predicate s x) res) === True
     where res = fltr x l

   prop_filterOverlaps :: Interval a
      -> [Interval a]
      -> Property
   prop_filterOverlaps = prop_filtration filterOverlaps (fromList [Overlaps])

   prop_filterOverlappedBy :: Interval a
      -> [Interval a]
      -> Property
   prop_filterOverlappedBy = prop_filtration filterOverlappedBy (fromList [OverlappedBy])

   prop_filterBefore :: Interval a
      -> [Interval a]
      -> Property
   prop_filterBefore = prop_filtration filterBefore (fromList [Before])

   prop_filterAfter :: Interval a
      -> [Interval a]
      -> Property
   prop_filterAfter = prop_filtration filterAfter (fromList [After])

   prop_filterStarts :: Interval a
      -> [Interval a]
      -> Property
   prop_filterStarts = prop_filtration filterStarts (fromList [Starts])

   prop_filterStartedBy :: Interval a
      -> [Interval a]
      -> Property
   prop_filterStartedBy = prop_filtration filterStartedBy (fromList [StartedBy])

   prop_filterFinishes :: Interval a
      -> [Interval a]
      -> Property
   prop_filterFinishes = prop_filtration filterFinishes (fromList [Finishes])

   prop_filterFinishedBy :: Interval a
      -> [Interval a]
      -> Property
   prop_filterFinishedBy = prop_filtration filterFinishedBy (fromList [FinishedBy])

   prop_filterMeets :: Interval a
      -> [Interval a]
      -> Property
   prop_filterMeets = prop_filtration filterMeets (fromList [Meets])

   prop_filterMetBy :: Interval a
      -> [Interval a]
      -> Property
   prop_filterMetBy = prop_filtration filterMetBy (fromList [MetBy])

   prop_filterDuring :: Interval a
      -> [Interval a]
      -> Property
   prop_filterDuring = prop_filtration filterDuring (fromList [During])

   prop_filterContains :: Interval a
      -> [Interval a]
      -> Property
   prop_filterContains = prop_filtration filterContains (fromList [Contains])

   prop_filterEquals :: Interval a
      -> [Interval a]
      -> Property
   prop_filterEquals = prop_filtration filterEquals (fromList [Equals])

   prop_filterDisjoint :: Interval a
      -> [Interval a]
      -> Property
   prop_filterDisjoint = prop_filtration filterDisjoint disjointRelations

   prop_filterNotDisjoint :: Interval a
      -> [Interval a]
      -> Property
   prop_filterNotDisjoint = prop_filtration filterNotDisjoint (complement disjointRelations)

   prop_filterWithin :: Interval a
      -> [Interval a]
      -> Property
   prop_filterWithin = prop_filtration filterWithin withinRelations

   prop_filterEnclosedBy :: Interval a
      -> [Interval a]
      -> Property
   prop_filterEnclosedBy = prop_filtration filterEnclosedBy withinRelations

   prop_filterEncloses :: Interval a
      -> [Interval a]
      -> Property
   prop_filterEncloses = prop_filtration filterEncloses (converse withinRelations)

   prop_filterConcur :: Interval a
      -> [Interval a]
      -> Property
   prop_filterConcur = prop_filtration filterConcur (complement disjointRelations)

instance FiltrationProperties Int

prop_clip_intersect
  :: (Show a, Ord a, IntervalSizeable a b)
  => Interval a
  -> Interval a
  -> Property
prop_clip_intersect x y = clip x y === intersect (min x y) (max x y)

-- NOTE: use this instead of prop_filterEquals
prop_small_filterEquals :: SmallInterval -> [SmallInterval] -> Property
prop_small_filterEquals x l =
  not (null res) ==> and (fmap (predicate s i) res) === True
 where
  i   = unSmall x
  li  = map unSmall l
  res = filterEquals i li
  s   = fromList [Equals]

-- RUNNER

spec :: Spec
spec = do
  describe "gaps tests" $ modifyMaxSuccess (* 10) $ do
    it "no gaps in containmentInt and noncontainmentInt"
      $          gapsL [containmentInt, noncontainmentInt]
      `shouldBe` []
    it "no gaps in containmentInt" $ gapsL [containmentInt] `shouldBe` []
    it "single gap between containmentInt and anotherInt"
      $          gapsL [containmentInt, anotherInt]
      `shouldBe` [gapInt]
    it "after gaps, only relation should be Before" $ property (prop_gaps1 @Int)

  describe "durations unit tests" $ do
    it "durations of containmentInt is 10"
      $          durations [containmentInt]
      `shouldBe` [10]
    it "durations of empty list is empty list"
      $          durations ([] :: [Interval Int])
      `shouldBe` []
    it "durations of [containmentInt, anotherInt] is [10, 5]"
      $          durations [containmentInt, anotherInt]
      `shouldBe` [10, 5]

  describe "clip tests" $ do
    it "clip disjoint should be Nothing"
      $          clip containmentInt gapInt
      `shouldBe` Nothing
    it "clip Interval (4, 10) Interval (0, 10) should be Interval (4, 10)"
      $          clip noncontainmentInt containmentInt
      `shouldBe` Just (iv 6 4)
    it "clip x y === intersect sort x y " $ property (prop_clip_intersect @Int)

  describe "relationsL tests" $ do
    it
        "relationsL [(0, 10), (4, 10), (10, 15), (15, 20)] == [FinishedBy, Meets, Meets]"
      $ relationsL [containmentInt, noncontainmentInt, gapInt, anotherInt]
      `shouldBe` [FinishedBy, Meets, Meets]
    it "relationsL of [] shouldBe []"
      $          relationsL ([] :: [Interval Int])
      `shouldBe` []
    it "relationsL of singleton shouldBe []"
      $          relationsL [containmentInt]
      `shouldBe` []
    it "length of relationsL result should be 1 less then length of input"
      $ property
          (\x ->
            not (null x)
              ==> length (relationsL x)
              === length (x :: [Interval Int])
              -   1
          )

  describe "gapsWithin tests" $ do
    it "gapsWithin (1, 10) [(0,5), (7,9), (12,15)] should be [(5,7), (9,10)]"
      $          gapsWithin (iv 9 1) [iv 5 0, iv 2 7, iv 3 12]
      `shouldBe` Just [iv 2 5, iv 1 9]
    it "gapsWithin (1, 10) [(-1, 0), (12,15)] should be [(5,7), (9,10)]"
      $          gapsWithin (iv 9 1) [iv 1 (-1), iv 3 12]
      `shouldBe` Nothing
    it "gapsWithin (0, 455) [(0, 730), (731, 762), (763, 793)]"
      $ gapsWithin (safeInterval (0 :: Int, 455))
                   (fmap safeInterval [(0, 730), (731, 762), (763, 793)])
      `shouldBe` Just []
    it "gapsWithin (1, 10) [] should be []"
      $          gapsWithin (iv 9 1) ([] :: [Interval a])
      `shouldBe` Nothing

  describe "emptyIf tests" $ do
    it "emptyIfNone (starts (3, 5)) [(3,4), (5,6)] should be empty"
      $          nothingIfNone (starts (iv 2 3)) [iv 1 3, iv 1 5]
      `shouldBe` Nothing
    it "emptyIfNone (starts (3, 5)) [(3,6), (5,6)] shoiuld be input"
      $          nothingIfNone (starts (iv 2 3)) [iv 3 3, iv 1 5]
      `shouldBe` Just [iv 3 3, iv 1 5]

  describe "filtration tests" $ modifyMaxDiscardRatio (* 2) $ do
    it "disjoint filter should filter out noncontainment"
      $          filterDisjoint containmentInt [noncontainmentInt, anotherInt]
      `shouldBe` [anotherInt]
    it "notDisjoint filter should keep noncontainment"
      $ filterNotDisjoint containmentInt [noncontainmentInt, anotherInt]
      `shouldBe` [noncontainmentInt]
    it "filterBefore property" $ property (prop_filterBefore @Int)
    it "filterAfter property" $ property (prop_filterAfter @Int)
    it "filterOverlaps property" $ property (prop_filterOverlaps @Int)
    it "filterOverlappedBy property" $ property (prop_filterOverlappedBy @Int)
    it "filterStarts property" $ property (prop_filterStarts @Int)
    it "filterStartedBy property" $ property (prop_filterStartedBy @Int)
    it "filterFinishes property" $ property (prop_filterFinishes @Int)
    it "filterFinishedBy property" $ property (prop_filterFinishedBy @Int)
    it "filterMeets property" $ property (prop_filterMeets @Int)
    it "filterMetBy property" $ property (prop_filterMetBy @Int)
    it "filterDuring property" $ property (prop_filterDuring @Int)
    it "filterContains property" $ property (prop_filterContains @Int)
    it "filterEquals property" $ property prop_small_filterEquals
    it "filterDisjoint property" $ property (prop_filterDisjoint @Int)
    it "filterNotDisjoint property" $ property (prop_filterNotDisjoint @Int)
    it "filterWithin property" $ property (prop_filterWithin @Int)
    it "filterConcur property" $ property (prop_filterConcur @Int)
    it "filterEncloses property" $ property (prop_filterEncloses @Int)
    it "filterEnclosedBy property" $ property (prop_filterEnclosedBy @Int)

  describe "nothingIf unit tests" $ do
    it "nothing from nothingIfAll"
      $          nothingIfAll (starts (iv 2 3)) [iv 3 3, iv 4 3]
      `shouldBe` Nothing
    it "something from nothingIfAll"
      $          nothingIfAll (starts (iv 2 3)) [iv 3 0, iv 4 3]
      `shouldBe` Just [iv 3 0, iv 4 3]
    it "nothing from nothingIfAny"
      $          nothingIfAny (starts (iv 2 3)) [iv 3 3, iv 1 5]
      `shouldBe` Nothing
    it "something from nothingIfAny"
      $          nothingIfAny (starts (iv 2 3)) [iv 3 1, iv 1 5]
      `shouldBe` Just [iv 3 1, iv 1 5]

  describe "intersection tests" $ do
    it "intersection of (0, 2) (2, 4) should be Nothing"
      $          intersect (iv 2 0) (iv 2 2)
      `shouldBe` Nothing
    it "intersection of (0, 2) (3, 4) should be Nothing"
      $          intersect (iv 2 0) (iv 1 3)
      `shouldBe` Nothing
    it "intersection of (2, 4) (0, 2) should be Nothing"
      $          intersect (iv 2 2) (iv 2 0)
      `shouldBe` Nothing

  describe "intersection tests" $ do
    it "intersection of (0, 2) (2, 4) should be Nothing"
      $          intersect (iv 2 0) (iv 2 2)
      `shouldBe` Nothing
    it "intersection of (0, 2) (3, 4) should be Nothing"
      $          intersect (iv 2 0) (iv 1 3)
      `shouldBe` Nothing
    it "intersection of (2, 4) (0, 2) should be Nothing"
      $          intersect (iv 2 2) (iv 2 0)
      `shouldBe` Nothing
    it "intersection of (0, 2) (1, 3) should be Just (1, 2)"
      $          intersect (iv 2 0) (iv 2 1)
      `shouldBe` Just (iv 1 1)
    it "intersection of (0, 2) (-1, 3) should be Just (0, 2)"
      $          intersect (iv 2 0) (iv 4 (-1))
      `shouldBe` Just (iv 2 0)
    it "intersection of (0, 2) (0, 2) should be Just (0, 2)"
      $          intersect (iv 2 0) (iv 2 0)
      `shouldBe` Just (iv 2 0)
    it "intersection of (0, 2) (-1, 1) should be Just (0, 1)"
      $          intersect (iv 2 0) (iv 2 (-1))
      `shouldBe` Just (iv 1 0)
    it "intersection of (0, 3) (1, 2) should be Just (1, 2)"
      $          intersect (iv 3 0) (iv 1 1)
      `shouldBe` Just (iv 1 1)
  describe "rangeInterval unit tests" $ do
    it "range of empty list returns Nothing"
      $          rangeInterval ([] :: [Interval Int])
      `shouldBe` Nothing
    it "rangeInterval returns the containing interval"
      $          rangeInterval [beginerval 0 (1 :: Int), beginerval 3 (-1)]
      `shouldBe` (Just $ beginerval 3 (-1))
    it "disjoint intervals"
      $          rangeInterval [beginerval 10 (1 :: Int), beginerval 1 (-1)]
      `shouldBe` (Just $ beginerval 12 (-1))
    it "order of list does not matter"
      $          rangeInterval [beginerval 10 (1 :: Int), beginerval 1 (-1)]
      `shouldBe` rangeInterval [beginerval 1 (-1), beginerval 10 (1 :: Int)]
    it "works on Right"
      $          rangeInterval (Right $ beginerval 10 (1 :: Int))
      `shouldBe` (Just $ beginerval 10 (1 :: Int))
    it "Left variant returns Nothing"
      $          rangeInterval (Left $ beginerval 10 (1 :: Int))
      `shouldBe` (Nothing :: Maybe (Interval Int))
  describe "combineIntervals unit tests" $ do
    it "noncontainmentInt combined into containmentInt"
      $          combineIntervals [containmentInt, noncontainmentInt]
      `shouldBe` [containmentInt]
    it "noncontainmentInt combined into containmentInt; anotherInt unchanged"
      $ combineIntervals [containmentInt, noncontainmentInt, anotherInt]
      `shouldBe` [containmentInt, anotherInt]
    it "idempotency of containmentInt"
      $          combineIntervals [containmentInt]
      `shouldBe` [containmentInt]
    it "idempotency of noncontainmentInt"
      $          combineIntervals [noncontainmentInt]
      `shouldBe` [noncontainmentInt]
    it "combineIntervals [] should be []"
      $          combineIntervals ([] :: [Interval Int])
      `shouldBe` []
    it "combineIntervals works on sorted intervals"
      $          combineIntervals [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
      `shouldBe` [iv 12 0, iv 2 13]
    it "combineIntervalsFromSorted works on sorted intervals"
      $          combineIntervalsFromSorted [iv 10 0, iv 5 2, iv 2 10, iv 2 13]
      `shouldBe` [iv 12 0, iv 2 13]
    it "combineIntervals works on unsorted intervals"
      $          combineIntervals [iv 2 13, iv 10 0, iv 2 10, iv 5 2]
      `shouldBe` [iv 12 0, iv 2 13]

  describe "combineIntervals property tests" $ modifyMaxSuccess (* 10) $ do
    it "after combining, only relation should be Before"
      $ property (prop_combineIntervals1 @Int)
    it "after combining, only relation should be Before"
      $ property (prop_combineIntervals1 @Day)
    it "after combining, only relation should be Before"
      $ property (prop_combineIntervals1 @UTCTime)

  describe "foldMeets unit tests" $ do
    it "foldMeetingSafe meets1"
      $          foldMeetingSafe (trivialize meets1)
      `shouldBe` trivialize [iv 4 0]
    it "foldMeetingSafe meets2"
      $          foldMeetingSafe (trivialize meets2)
      `shouldBe` trivialize [iv 16 0]
    it "foldMeetingSafe meets3" $ foldMeetingSafe meets3 `shouldBe` meets3eq

  describe "formMeetingSequence unit tests" $ do
    it "formMeetingSequence unit test 0"
      $          formMeetingSequence (unEvents c0in)
      `shouldBe` unEvents c0out
    it "formMeetingSequence unit test 1"
      $          formMeetingSequence (unEvents c1in)
      `shouldBe` unEvents c1out
    it "formMeetingSequence unit test 2"
      $          formMeetingSequence (unEvents c2in)
      `shouldBe` unEvents c2out
    it "formMeetingSequence unit test 3"
      $          formMeetingSequence (unEvents c3in)
      `shouldBe` unEvents c3out
    it "formMeetingSequence unit test 4"
      $          formMeetingSequence (unEvents c4in)
      `shouldBe` unEvents c4out
    it "formMeetingSequence unit test 5"
      $          formMeetingSequence c5in
      `shouldBe` c5out
    it "formMeetingSequence unit test 6"
      $          formMeetingSequence ([] :: [PairedInterval State Int])
      `shouldBe` []

  describe "formMeetingSequence property tests" $ modifyMaxSuccess (* 2) $ do
    it "prop_formMeetingSequence0" $ property prop_formMeetingSequence0
     -- 2022-05-18 - BS
    -- Commmenting out this test as the execution of the test suite blows up
    -- when this property check is included.
    -- TODO: consider whether this check is worthwhile.
    -- it "prop_formMeetingSequence1" $ property prop_formMeetingSequence1
    it "prop_formMeetingSequence2" $ property prop_formMeetingSequence2

  -- describe "arbitraryWithRelation property tests" $ do
  --   it "prop_withRelation_tautology" $ property prop_withRelation_tautology
