PairedIntervalSpec.hs

module IntervalAlgebra.PairedIntervalSpec (spec) where

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

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