{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Test.Hspec
import Test.Hspec.QuickCheck
import ClassyPrelude hiding (undefined)
import Test.QuickCheck.Arbitrary
import Prelude (undefined)
import Control.Monad.Trans.Writer (tell, Writer, runWriter)
import qualified Data.Set as Set
import qualified Data.HashSet as HashSet

dictionaryProps
    :: ( MapValue c ~ Char
       , ContainerKey c ~ Int
       , Arbitrary c
       , IsMap c
       , Eq c
       , Show c
       )
    => c
    -> Spec
dictionaryProps dummy = do
    prop "insert x y (insert x z c) == insert x y c" $ \x y z c ->
        insertMap x y (insertMap x z (c `asTypeOf` dummy)) == insertMap x y c
    prop "insertMap x y (deleteMap x c) == insertMap x y c" $ \x y c ->
        insertMap x y (deleteMap x (c `asTypeOf` dummy)) == insertMap x y c
    prop "deleteMap x (insertMap x y c) == deleteMap x c" $ \x y c ->
        mapFromList (mapToList $ deleteMap x (insertMap x y (c `asTypeOf` dummy))) == (mapFromList (mapToList ((deleteMap x c) `asTypeOf` dummy) :: [(Int, Char)]) `asTypeOf` dummy)
    prop "lookup k (insertMap k v empty) == Just v" $ \k v ->
        lookup k (insertMap k v mempty `asTypeOf` dummy) == Just v
    prop "lookup k (deleteMap k c) == Nothing" $ \k c ->
        lookup k (deleteMap k c`asTypeOf` dummy) == Nothing

mapProps :: ( i ~ Element c
            , MonoFoldable c
            , Eq c
            , Arbitrary c
            , Show c
            )
         => ((i -> i) -> c -> c)
         -> ([i] -> c)
         -> c
         -> (i -> i)
         -> (i -> i)
         -> Spec
mapProps map' pack' dummy f g = do
    prop "map f c == pack (map f (unpack c))" $ \c ->
        map' f (c `asTypeOf` dummy) == pack' (fmap f (unpack c))
    prop "map (f . g) c == map f (map g c)" $ \c ->
        map' (g . f) (c `asTypeOf` dummy) == map' g (map' f c)

concatMapProps :: ( MonoFoldable c
                  , IsSequence c
                  , Eq c
                  , Arbitrary c
                  , Show c
                  )
               => c
               -> (Element c -> c)
               -> Spec
concatMapProps dummy f = do
    prop "concatMap f c == pack (concatMap (unpack . f) (unpack c))" $ \c ->
        concatMap f (c `asTypeOf` dummy) == pack (concatMap (unpack . f) (unpack c))

filterProps :: ( Eq c
               , Show c
               , IsSequence c
               , Arbitrary c
               )
            => c
            -> (Element c -> Bool)
            -> Spec
filterProps dummy f = do
    prop "filter f c == pack (filter f (unpack c))" $ \c ->
        (repack (filter f (c `asTypeOf` dummy)) `asTypeOf` dummy) == pack (filter f (unpack c))

filterMProps :: ( Eq c
                , Show c
                , IsSequence c
                , Arbitrary c
                )
             => c
             -> (Element c -> Bool)
             -> Spec
filterMProps dummy f' = do
    prop "filterM f c == fmap pack (filterM f (unpack c))" $ \c ->
        runIdentity (fmap repack (filterM f (c `asTypeOf` dummy))) `asTypeOf` dummy == runIdentity (fmap pack (filterM f (unpack c)))
  where
    f = return . f'

lengthProps :: ( Show c
               , MonoFoldable c
               , Monoid c
               , Arbitrary c
               )
            => c
            -> Spec
lengthProps dummy = do
    prop "length c == fromIntegral (length (unpack c))" $ \c ->
        length (c `asTypeOf` dummy) == fromIntegral (length (unpack c))
    prop "null c == (length c == 0)" $ \c ->
        null (c `asTypeOf` dummy) == (length c == 0)
    prop "length (x ++ y) <= length x + length y" $ \x y ->
        length (x ++ y `asTypeOf` dummy) <= length x + length y
    prop "length (x ++ y) >= max (length x) (length y)" $ \x y ->
        length (x ++ y `asTypeOf` dummy) >= max (length x) (length y)
    prop "length (x ++ empty) == length x" $ \x ->
        length (x ++ mempty `asTypeOf` dummy) == length x
    prop "null empty" $ null (mempty `asTypeOf` dummy)

mapMProps :: ( Eq c
             , Show c
             , IsSequence c
             , Arbitrary c
             , Element c ~ Int
             )
          => c
          -> Spec
mapMProps dummy = do
    let f :: Int -> Writer [Int] Int
        f x = tell [x] >> return x
    prop "omapM f c == omapM f (toList c)" $ \c ->
        runWriter (omapM f (c `asTypeOf` dummy)) ==
            let (x, y) = runWriter (omapM f (toList c))
             in (pack x, y)

mapM_Props :: ( Eq (Element c)
              , Show c
              , MonoFoldable c
              , Arbitrary c
              )
           => c
           -> Spec
mapM_Props dummy = do
    let f x = tell [x]
    prop "mapM_ f c == mapM_ f (toList c)" $ \c ->
        runWriter (mapM_ f (c `asTypeOf` dummy)) == runWriter (mapM_ f (toList c))

foldProps :: ( Eq a
             , Show c
             , MonoFoldable c
             , Arbitrary c
             )
          => c
          -> (a -> Element c -> a)
          -> a
          -> Spec
foldProps dummy f accum =
    prop "foldl' f accum c == foldl' f accum (toList c)" $ \c ->
        foldl' f accum (c `asTypeOf` dummy) == foldl' f accum (toList c)

replicateProps :: ( Eq a
                  , Show (Element c)
                  , IsSequence a
                  , IsSequence c
                  , Arbitrary (Element c)
                  , Element a ~ Element c
                  )
               => a
               -> (c -> a)
               -> Spec
replicateProps dummy pack' =
    prop "replicate i a == pack (replicate i a)" $ \{- takes too long i-} a ->
        (replicate i a `asTypeOf` dummy) == pack' (replicate i a)
  where
    i = 3

chunkProps :: ( Eq a
              , Show a
              , Arbitrary a
              , LazySequence a s
              )
           => a
           -> Spec
chunkProps dummy = do
    prop "fromChunks . toChunks == id" $ \a ->
        fromChunks (toChunks (a `asTypeOf` dummy)) == a
    prop "fromChunks . return . concat . toChunks == id" $ \a ->
        fromChunks [concat $ toChunks (a `asTypeOf` dummy)] == a

suffixProps :: ( Eq c
               , Show c
               , Arbitrary c
               , IsSequence c
               , Eq (Element c)
               )
            => c
            -> Spec
suffixProps dummy = do
    prop "y `isSuffixOf` (x ++ y)" $ \x y ->
        (y `asTypeOf` dummy) `isSuffixOf` (x ++ y)
    prop "stripSuffix y (x ++ y) == Just x" $ \x y ->
        stripSuffix y (x ++ y) == Just (x `asTypeOf` dummy)
    prop "isJust (stripSuffix x y) == isSuffixOf x y" $ \x y ->
        isJust (stripSuffix x y) == isSuffixOf x (y `asTypeOf` dummy)
    prop "dropSuffix y (x ++ y) == x" $ \x y ->
        dropSuffix y (x ++ y) == (x `asTypeOf` dummy)
    prop "dropSuffix x y == y || x `isSuffixOf` y" $ \x y ->
        dropSuffix x y == y || x `isSuffixOf` (y `asTypeOf` dummy)

replicateMProps :: ( Eq a
                   , Show (Index a)
                   , Show (Element a)
                   , IsSequence a
                   , Arbitrary (Index a)
                   , Arbitrary (Element a)
                   )
                => a
                -> Spec
replicateMProps dummy = do
    prop "runIdentity (replicateM i (return x)) == replicate i x" $ \i' x ->
        let i = i' `mod` 20
         in runIdentity (replicateM i (return x)) == (replicate i x `asTypeOf` dummy)

utf8Props :: ( Eq t
             , Show t
             , Arbitrary t
             , Textual t
             , Utf8 t b
             )
          => t
          -> Spec
utf8Props dummy = do
    prop "decodeUtf8 . encodeUtf8 == id" $ \t ->
        decodeUtf8 (encodeUtf8 t) == (t `asTypeOf` dummy)

compareLengthProps :: ( MonoFoldable c
                      , Arbitrary c
                      , Show c
                      )
                   => c
                   -> Spec
compareLengthProps dummy = do
    prop "compare (length c) i == compareLength c i" $ \i c ->
        compare (length c) i == compareLength (c `asTypeOf` dummy) i

prefixProps :: ( Eq c
               , IsSequence c
               , Eq (Element c)
               , Arbitrary c
               , Show c
               )
            => c
            -> Spec
prefixProps dummy = do
    prop "x `isPrefixOf` (x ++ y)" $ \x y ->
        (x `asTypeOf` dummy) `isPrefixOf` (x ++ y)
    prop "stripPrefix x (x ++ y) == Just y" $ \x y ->
        stripPrefix x (x ++ y) == Just (y `asTypeOf` dummy)
    prop "stripPrefix x y == Nothing || x `isPrefixOf` y" $ \x y ->
        stripPrefix x y == Nothing || x `isPrefixOf` (y `asTypeOf` dummy)
    prop "dropPrefix x (x ++ y) == y" $ \x y ->
        dropPrefix x (x ++ y) == (y `asTypeOf` dummy)
    prop "dropPrefix x y == y || x `isPrefixOf` y" $ \x y ->
        dropPrefix x y == y || x `isPrefixOf` (y `asTypeOf` dummy)

main :: IO ()
main = hspec $ do
    describe "dictionary" $ do
        describe "Data.Map" $ dictionaryProps (undefined :: Map Int Char)
        describe "Data.HashMap" $ dictionaryProps (undefined :: HashMap Int Char)
        describe "assoc list" $ dictionaryProps (undefined :: [(Int, Char)])
    describe "map" $ do
        describe "list" $ mapProps fmap pack (undefined :: [Int]) (+ 1) (+ 2)
        describe "Data.Vector" $ mapProps fmap pack (undefined :: Vector Int) (+ 1) (+ 2)
        describe "Data.Vector.Unboxed" $ mapProps omap pack (undefined :: UVector Int) (+ 1) (+ 2)
        describe "Data.Set" $ mapProps Set.map setFromList (undefined :: Set Int) (+ 1) (+ 2)
        describe "Data.HashSet" $ mapProps HashSet.map setFromList (undefined :: HashSet Int) (+ 1) (+ 2)
        describe "Data.ByteString" $ mapProps omap pack (undefined :: ByteString) (+ 1) (+ 2)
        describe "Data.ByteString.Lazy" $ mapProps omap pack (undefined :: LByteString) (+ 1) (+ 2)
        describe "Data.Text" $ mapProps omap pack (undefined :: Text) succ succ
        describe "Data.Text.Lazy" $ mapProps omap pack (undefined :: LText) succ succ
        describe "Data.Sequence" $ mapProps fmap pack (undefined :: Seq Int) succ succ
    describe "concatMap" $ do
        describe "list" $ concatMapProps (undefined :: [Int]) (\i -> [i + 1, i + 2])
        describe "Data.Vector" $ concatMapProps (undefined :: Vector Int) (\i -> fromList [i + 1, i + 2])
        describe "Data.Vector.Unboxed" $ concatMapProps (undefined :: UVector Int) (\i -> fromList [i + 1, i + 2])
        describe "Data.ByteString" $ concatMapProps (undefined :: ByteString) (\i -> fromList [i + 1, i + 2])
        describe "Data.ByteString.Lazy" $ concatMapProps (undefined :: LByteString) (\i -> fromList [i + 1, i + 2])
        describe "Data.Text" $ concatMapProps (undefined :: Text) (\c -> pack [succ c, succ $ succ c])
        describe "Data.Text.Lazy" $ concatMapProps (undefined :: LText) (\c -> pack [succ c, succ $ succ c])
        describe "Data.Sequence" $ concatMapProps (undefined :: Seq Int) (\i -> pack [i + 1, i + 2])
    describe "filter" $ do
        describe "list" $ filterProps (undefined :: [Int]) (< 20)
        describe "Data.Vector" $ filterProps (undefined :: Vector Int) (< 20)
        describe "Data.Vector.Unboxed" $ filterProps (undefined :: UVector Int) (< 20)
        describe "Data.ByteString" $ filterProps (undefined :: ByteString) (< 20)
        describe "Data.ByteString.Lazy" $ filterProps (undefined :: LByteString) (< 20)
        describe "Data.Text" $ filterProps (undefined :: Text) (< 'A')
        describe "Data.Text.Lazy" $ filterProps (undefined :: LText) (< 'A')
        {- FIXME
        describe "Data.Map" $ filterProps (undefined :: Map Int Char) (\(i, _) -> i < 20)
        describe "Data.HashMap" $ filterProps (undefined :: HashMap Int Char) (\(i, _) -> i < 20)
        describe "Data.Set" $ filterProps (undefined :: Set Int) (< 20)
        -}
        describe "Data.Sequence" $ filterProps (undefined :: Seq Int) (< 20)
    describe "filterM" $ do
        describe "list" $ filterMProps (undefined :: [Int]) (< 20)
        describe "Data.Vector" $ filterMProps (undefined :: Vector Int) (< 20)
        describe "Data.Vector.Unboxed" $ filterMProps (undefined :: Vector Int) (< 20)
        describe "Data.Sequence" $ filterMProps (undefined :: Seq Int) (< 20)
    describe "length" $ do
        describe "list" $ lengthProps (undefined :: [Int])
        describe "Data.Vector" $ lengthProps (undefined :: Vector Int)
        describe "Data.Vector.Unboxed" $ lengthProps (undefined :: UVector Int)
        describe "Data.ByteString" $ lengthProps (undefined :: ByteString)
        describe "Data.ByteString.Lazy" $ lengthProps (undefined :: LByteString)
        describe "Data.Text" $ lengthProps (undefined :: Text)
        describe "Data.Text.Lazy" $ lengthProps (undefined :: LText)
        describe "Data.Map" $ lengthProps (undefined :: Map Int Char)
        describe "Data.HashMap" $ lengthProps (undefined :: HashMap Int Char)
        describe "Data.Set" $ lengthProps (undefined :: Set Int)
        describe "Data.HashSet" $ lengthProps (undefined :: HashSet Int)
        describe "Data.Sequence" $ lengthProps (undefined :: Seq Int)
    describe "mapM" $ do
        describe "list" $ mapMProps (undefined :: [Int])
        describe "Data.Vector" $ mapMProps (undefined :: Vector Int)
        describe "Data.Vector.Unboxed" $ mapMProps (undefined :: UVector Int)
        describe "Seq" $ mapMProps (undefined :: Seq Int)
    describe "mapM_" $ do
        describe "list" $ mapM_Props (undefined :: [Int])
        describe "Data.Vector" $ mapM_Props (undefined :: Vector Int)
        describe "Data.Vector.Unboxed" $ mapM_Props (undefined :: UVector Int)
        describe "Set" $ mapM_Props (undefined :: Set Int)
        describe "HashSet" $ mapM_Props (undefined :: HashSet Int)
        describe "Seq" $ mapM_Props (undefined :: Seq Int)
    describe "fold" $ do
        let f = flip (:)
        describe "list" $ foldProps (undefined :: [Int]) f []
        describe "Data.Vector" $ foldProps (undefined :: Vector Int) f []
        describe "Data.Vector.Unboxed" $ foldProps (undefined :: UVector Int) f []
        describe "Data.ByteString" $ foldProps (undefined :: ByteString) f []
        describe "Data.ByteString.Lazy" $ foldProps (undefined :: LByteString) f []
        describe "Data.Text" $ foldProps (undefined :: Text) f []
        describe "Data.Text.Lazy" $ foldProps (undefined :: LText) f []
        describe "Data.Set" $ foldProps (undefined :: Set Int) f []
        describe "Data.HashSet" $ foldProps (undefined :: HashSet Int) f []
        describe "Data.Sequence" $ foldProps (undefined :: Seq Int) f []
    describe "replicate" $ do
        describe "list" $ replicateProps (undefined :: [Int]) pack
        describe "Data.Vector" $ replicateProps (undefined :: Vector Int) pack
        describe "Data.Vector.Unboxed" $ replicateProps (undefined :: UVector Int) pack
        describe "Data.ByteString" $ replicateProps (undefined :: ByteString) pack
        describe "Data.ByteString.Lazy" $ replicateProps (undefined :: LByteString) pack
        describe "Data.Text" $ replicateProps (undefined :: Text) pack
        describe "Data.Text.Lazy" $ replicateProps (undefined :: LText) pack
        describe "Data.Sequence" $ replicateProps (undefined :: Seq Int) pack
    describe "chunks" $ do
        describe "ByteString" $ chunkProps (asLByteString undefined)
        describe "Text" $ chunkProps (asLText undefined)
    describe "Suffix" $ do
        describe "list" $ suffixProps (undefined :: [Int])
        describe "Text" $ suffixProps (undefined :: Text)
        describe "LText" $ suffixProps (undefined :: LText)
        describe "ByteString" $ suffixProps (undefined :: ByteString)
        describe "LByteString" $ suffixProps (undefined :: LByteString)
        describe "Vector" $ suffixProps (undefined :: Vector Int)
        describe "UVector" $ suffixProps (undefined :: UVector Int)
        describe "Seq" $ suffixProps (undefined :: Seq Int)
    describe "replicateM" $ do
        describe "list" $ replicateMProps (undefined :: [Int])
        describe "Vector" $ replicateMProps (undefined :: Vector Int)
        describe "UVector" $ replicateMProps (undefined :: UVector Int)
        describe "Seq" $ replicateMProps (undefined :: Seq Int)
    describe "encode/decode UTF8" $ do
        describe "Text" $ utf8Props (undefined :: Text)
        describe "LText" $ utf8Props (undefined :: LText)
    describe "compareLength" $ do
        describe "list" $ compareLengthProps (undefined :: [Int])
        describe "Text" $ compareLengthProps (undefined :: Text)
        describe "LText" $ compareLengthProps (undefined :: LText)
    describe "Prefix" $ do
        describe "list" $ prefixProps (undefined :: [Int])
        describe "Text" $ prefixProps (undefined :: Text)
        describe "LText" $ prefixProps (undefined :: LText)
        describe "ByteString" $ prefixProps (undefined :: ByteString)
        describe "LByteString" $ prefixProps (undefined :: LByteString)
        describe "Vector" $ prefixProps (undefined :: Vector Int)
        describe "UVector" $ prefixProps (undefined :: UVector Int)
        describe "Seq" $ prefixProps (undefined :: Seq Int)
    {- This tests depend on timing and are unreliable. Instead, we're relying
       on the test suite in safe-exceptions itself.
    describe "any exceptions" $ do
        it "catchAny" $ do
            failed <- newIORef 0
            tid <- forkIO $ do
                catchAny
                    (threadDelay 20000)
                    (const $ writeIORef failed 1)
                writeIORef failed 2
            threadDelay 10000
            throwTo tid DummyException
            threadDelay 50000
            didFail <- readIORef failed
            liftIO $ didFail `shouldBe` (0 :: Int)
        it "tryAny" $ do
            failed <- newIORef False
            tid <- forkIO $ do
                _ <- tryAny $ threadDelay 20000
                writeIORef failed True
            threadDelay 10000
            throwTo tid DummyException
            threadDelay 50000
            didFail <- readIORef failed
            liftIO $ didFail `shouldBe` False
        it "tryAnyDeep" $ do
            eres <- tryAny $ return $!! impureThrow DummyException
            case eres of
                Left e
                    | Just DummyException <- fromException e -> return ()
                    | otherwise -> error "Expected a DummyException"
                Right () -> error "Expected an exception" :: IO ()
    -}
    it "basic DList functionality" $
        (toList $ asDList $ mconcat
            [ fromList [1, 2]
            , singleton 3
            , cons 4 mempty
            , fromList $ applyDList (singleton 5 ++ singleton 6) [7, 8]
            ]) `shouldBe` [1..8 :: Int]

    describe "Data.ByteVector" $ do
        prop "toByteVector" $ \ws ->
            (otoList . toByteVector . fromList $ ws) `shouldBe` ws

        prop "fromByteVector" $ \ws ->
            (otoList . fromByteVector . fromList $ ws) `shouldBe` ws

data DummyException = DummyException
    deriving (Show, Typeable)
instance Exception DummyException

instance Arbitrary (HashMap Int Char) where
    arbitrary = mapFromList <$> arbitrary
instance Arbitrary (Vector Int) where
    arbitrary = fromList <$> arbitrary
instance Arbitrary (UVector Int) where
    arbitrary = fromList <$> arbitrary
instance Arbitrary (HashSet Int) where
    arbitrary = setFromList <$> arbitrary
instance Arbitrary ByteString where
    arbitrary = fromList <$> arbitrary
instance Arbitrary LByteString where
    arbitrary = fromList <$> arbitrary
instance Arbitrary Text where
    arbitrary = fromList <$> arbitrary
instance Arbitrary LText where
    arbitrary = fromList <$> arbitrary

#if !MIN_VERSION_QuickCheck(2,8,2)
instance Arbitrary (Seq Int) where
    arbitrary = fromList <$> arbitrary
instance Arbitrary (Set Int) where
    arbitrary = setFromList <$> arbitrary
instance Arbitrary (Map Int Char) where
    arbitrary = mapFromList <$> arbitrary
#endif