{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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
      ]

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

      it "pp (normalize x) == pp x" $
        property $ \(x :: Blessings String) ->
          pp (stripSGR (normalize x)) == pp (stripSGR x)

      it "take 1 x <> drop 1 x == x" $
        property $ \(x :: Blessings String) ->
          normalize (S.take 1 x <> S.drop 1 x) == normalize x

      it "uncurry (<>) (splitAt i x) == x" $
        property $ \(i :: Int, x :: Blessings String) ->
          unsafeTimeout 100000 $
            normalize (uncurry (<>) (S.splitAt i x)) == normalize 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