add semantic normalization tests; split test suite

1 files changed, 67 insertions, 0 deletions

diff --git a/test/BaseSpec.hs b/test/BaseSpec.hs
new file mode 100644
index 0000000..64ec920
--- /dev/null
+++ b/test/BaseSpec.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE MultiWayIf #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module BaseSpec (spec) where
+
+import Blessings
+import Control.Exception
+import Data.Sequences qualified as S
+import System.IO.Unsafe
+import System.Timeout
+import Test.Hspec
+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 =
+    oneof
+      [ Plain <$> arbitrary
+      , pure Empty
+      , (<>) <$> arbitrary <*> arbitrary
+      , SGR <$> arbitrary <*> arbitrary
+      ]
+
+spec :: Spec
+spec =
+    describe "Blessings" $ do
+      it "obeys the Semigroup laws" $
+        property $ \(x :: Blessings String) y z ->
+          (x <> y) <> z == x <> (y <> z)
+
+      it "obeys the Monoid laws" $
+        property $ \(x :: Blessings String) ->
+          x <> mempty == x && x == mempty <> x
+
+      it "splitAt produces pairs with elements of proper length" $
+        property $ \(i :: Int, x :: Blessings String) ->
+          unsafeTimeout 100000 $
+            let
+              (l, r) = S.splitAt i x
+              n = S.lengthIndex x
+            in
+            if | i <= 0    -> S.lengthIndex l == 0 && S.lengthIndex r == n
+               | i <= n    -> S.lengthIndex l == i && S.lengthIndex r == n - i
+               | otherwise -> S.lengthIndex l == n && S.lengthIndex r == 0
+
+      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
+            S.lengthIndex (S.take i infx) == i
+
+      it "can drop from infinite structure" $
+        property $ \(n :: NonNegative Int) ->
+          unsafeTimeout 100000 $
+            let i = getNonNegative n in
+            S.lengthIndex (S.take i (S.drop i infx)) == i
+
+      it "can take concat of infinite structures" $
+        property $ \(x :: Blessings String) ->
+          unsafeTimeout 100000 $
+            S.lengthIndex (S.take 1 $ infx <> x) <= 1