LinearRingTests.hs

module Data.LinearRingTests where

import           Data.Foldable         (Foldable (..))
import           Data.List.NonEmpty    (NonEmpty (..))
import           Data.Validation       (AccValidation (..))
import           Test.Tasty
import           Test.Tasty.Hspec      (Spec, context, describe, it, shouldBe,
                                        testSpec)
import           Test.Tasty.QuickCheck (Property, property, testProperty)
-- Local
import           Arbitrary             ()
import           Data.LinearRing


-- Tests

tests :: IO TestTree
tests = do
  specs <- specTests
  pure $ testGroup "Data.LinearRingTests" [qcTests, specs]

qcTests :: TestTree
qcTests = testGroup "Data.LinearRingTests.QuickCheck"
  [ testProperty "Data.LinearRing.ringLength" testRingLength
  , testProperty "Data.LinearRing.fromLinearRing" testFromLinearRing
  , testProperty "Data.LinearRing.Foldable" testFoldable
  ]

specTests :: IO TestTree
specTests = do
  specs <- sequence
    [ testSpec "Data.LinearRing.fromList" testFromList
    ]
  pure $ testGroup "Data.LinearRingTests.Spec" specs

-- QuickCheck

-- > (\xs -> ringLength xs == (length (fromLinearRing xs))) (xs :: LinearRing Int)
--
testRingLength :: LinearRing Int -> Property
testRingLength xs = property $ ringLength xs == length (fromLinearRing xs)

-- > (\xs -> length (fromLinearRing xs) >= 4) (xs :: LinearRing Int)
--
testFromLinearRing :: LinearRing Int -> Property
testFromLinearRing xs = property $ length (fromLinearRing xs) >= 4

-- > (\xs -> (foldr (:) [] xs) == (fromLinearRing xs)) (xs :: LinearRing Int)
--
-- > (\xs -> (ringHead xs) == (foldr'' (\a -> const a) 0 xs)) (xs :: LinearRing Int)
--
testFoldable :: LinearRing Int -> Property
testFoldable xs = property $ (foldr (:) [] xs == fromLinearRing xs) && (ringHead xs == foldr' const 0 xs)

-- Spec

-- >>> fromList [] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int)
-- AccFailure (List too short: (length = 0) :| [])
--
-- >>> fromList [0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int)
-- AccFailure (List too short: (length = 1) :| [])
--
-- >>> fromList [0, 1] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int)
-- AccFailure (List too short: (length = 2) :| [])
--
-- >>> fromList [0, 1, 2] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int)
-- AccFailure (List too short: (length = 3) :| [])
--
-- >>> fromList [0, 1, 2, 3] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int)
-- AccSuccess [0,1,2,0]
--
-- >>> fromList [0, 1, 2, 4, 0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int)
-- AccSuccess [0,1,2,4,0]
--
-- >>> fromList [0, 1, 2, 4, 5, 0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int)
-- AccSuccess [0,1,2,4,5,0]

-- >>> fromList [0, 1, 2, 4, 5, 6] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int)
-- AccSuccess [0,1,2,4,5,0]
--
testFromList :: Spec
testFromList =
  describe "fromList" $ do
    it "creates a LinearRing out of a list of elements" $ do
      fromList ([0, 1, 2, 3] :: [Int])       `shouldBe` AccSuccess (makeLinearRing 0 1 2 [])
      fromList ([0, 1, 2, 4, 0] :: [Int])    `shouldBe` AccSuccess (makeLinearRing 0 1 2 [4])
      fromList ([0, 1, 2, 4, 5, 0] :: [Int]) `shouldBe` AccSuccess (makeLinearRing 0 1 2 [4, 5])
      fromList ([0, 1, 2, 4, 5, 6] :: [Int]) `shouldBe` AccSuccess (makeLinearRing 0 1 2 [4, 5])
    context "when provided with invalid input" $
      it "fails" $ do
        fromList []        `shouldBe` AccFailure (ListTooShort 0 :| [] :: NonEmpty (ListToLinearRingError Int))
        fromList [0]       `shouldBe` AccFailure (ListTooShort 1 :| [] :: NonEmpty (ListToLinearRingError Int))
        fromList [0, 1]    `shouldBe` AccFailure (ListTooShort 2 :| [] :: NonEmpty (ListToLinearRingError Int))
        fromList [0, 1, 2] `shouldBe` AccFailure (ListTooShort 3 :| [] :: NonEmpty (ListToLinearRingError Int))

-- TODO
-- > (\xs -> safeLast (fromLinearRing xs) == Just (ringHead xs)) (xs :: LinearRing Int)
--
-- > (\x xs -> length (foldrDropLast (:) [] (x : xs)) == length xs) (x :: Int) (xs :: [Int])
--