{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Blessings.Internal as B
import Blessings.String
import Control.Exception
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
      ]

main :: IO ()
main =
  hspec $ do
    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

      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