PairedIntervalSpec.hs

module IntervalAlgebra.PairedIntervalSpec
  ( spec
  ) where

import           Data.Bifunctor                 ( Bifunctor(bimap) )
import           Data.Bool
import           Data.Time                      ( Day(ModifiedJulianDay)
                                                , fromGregorian
                                                )
import           IntervalAlgebra                ( IntervalCombinable(..)
                                                , IntervalSizeable(duration)
                                                , before
                                                , beginerval
                                                , equals
                                                )
import           IntervalAlgebra.PairedInterval ( Empty(..)
                                                , PairedInterval
                                                , intervals
                                                , makePairedInterval
                                                )
import           Test.Hspec                     ( Spec
                                                , describe
                                                , it
                                                , shouldBe
                                                )

type TestPair = PairedInterval String Int

mkTestPr :: String -> Int -> Int -> TestPair
mkTestPr x i j = makePairedInterval x (beginerval i j)

t1 :: TestPair
t1 = mkTestPr "hi" 5 0
t2 :: TestPair
t2 = mkTestPr "bye" 4 6
t3 :: TestPair
t3 = mkTestPr "hello" 5 0

-- insta

spec :: Spec
spec = do
  describe "Basic tests of paired intervals" $ do
    it "the same pairInterval should be equal" $ t1 == t1 `shouldBe` True
    it "different pairInterval should not be equal" $ t1 /= t2 `shouldBe` True
    it "fmapping into a different interval type"
      $ fmap ModifiedJulianDay (makePairedInterval "hi" (beginerval 5 0))
      `shouldBe` makePairedInterval "hi"
                                    (beginerval 5 (fromGregorian 1858 11 17))
    it "bimapping into a different type"
      $          bimap (== "hi")
                       ModifiedJulianDay
                       (makePairedInterval "hi" (beginerval 5 0))
      `shouldBe` makePairedInterval True
                                    (beginerval 5 (fromGregorian 1858 11 17))
    it "show paired interval" $ show t1 `shouldBe` "{(0, 5), \"hi\"}"

    describe "tests on paired intervals" $ do
      it "t1 is before t2" $ (t1 `before` t2) `shouldBe` True
      it "duration of t1 is 5" $ duration t1 `shouldBe` 5
      it "t1 is equal to t3" $ (t1 `equals` t3) `shouldBe` True
      it "t1 is LT t2" $ (t1 < t2) `shouldBe` True
      it "getintervals [t1, t2, t3]"
        $          intervals [t1, t2, t3]
        `shouldBe` [beginerval 5 0, beginerval 4 6, beginerval 5 0]

    describe "IntervalCombinable tests" $ do
      it "" $ (t1 >< t3) `shouldBe` Nothing
      it "" $ (t1 >< mkTestPr "hello" 1 6) `shouldBe` Just (mkTestPr "" 1 5)
      it ""
        $          (t1 <+> mkTestPr "hello" 1 6)
        `shouldBe` [t1, mkTestPr "hello" 1 6]
      it "" $ (t1 <+> mkTestPr "hello" 5 3) `shouldBe` [mkTestPr "hihello" 8 0]

    describe "tests on empty" $ do
      it "show empty" $ show Empty `shouldBe` "Empty"
      it "combine emptyies" $ Empty <> Empty `shouldBe` Empty
      it "monoid empty" $ (mempty :: Empty) `shouldBe` Empty
      it "monoid mappend" $ mappend Empty Empty `shouldBe` Empty
      it "ord empty" $ Empty < Empty `shouldBe` False
      it "ord empty" $ Empty <= Empty `shouldBe` True