diff options
| -rw-r--r-- | test/Spec.hs | 33 |
1 files changed, 31 insertions, 2 deletions
diff --git a/test/Spec.hs b/test/Spec.hs index 351a517..f42712a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,8 +1,18 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -import Test.QuickCheck +import Blessings.Internal as B +import Blessings.String +import Control.Exception +import System.IO.Unsafe +import System.Timeout import Test.Hspec -import Blessings +import Test.QuickCheck + +unsafeTimeout :: Int -> a -> a +unsafeTimeout n f = + case unsafePerformIO $ timeout n (evaluate f) of + Nothing -> error "timeout" + Just y -> y instance Arbitrary a => Arbitrary (Blessings a) where arbitrary = @@ -24,3 +34,22 @@ main = it "obeys the Monoid laws" $ property $ \(x :: Blessings String) -> x <> mempty == x && x == mempty <> x + + let infx = mconcat (repeat (Plain "x" :: Blessings String)) + + it "can take from infinite structure" $ + property $ \(n :: NonNegative Int) -> + unsafeTimeout 100000 $ + let i = getNonNegative n in + B.length (B.take i infx) == i + + it "can drop from infinite structure" $ + property $ \(n :: NonNegative Int) -> + unsafeTimeout 100000 $ + let i = getNonNegative n in + B.length (B.take i (B.drop i infx)) == i + + it "can take concat of infinite structures" $ + property $ \(x :: Blessings String) -> + unsafeTimeout 100000 $ + B.length (B.take 1 $ infx <> x) <= 1 |