-- Normal imports
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Lazy as LZ
import Data.Char
import Data.List
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe
import Test.HUnit
import Text.Printf
import Test.QuickCheck
import Test.QuickCheck.Test hiding ( test )

-- Tested modules
import Data.Bencoding
import Data.Checksum
import Data.Metainfo
import Text.Regex.Simple
import Data.Extra

------------------------------
-- Tests for Data.Bencoding
instance Arbitrary L.ByteString where
    arbitrary = do
      txt <- arbitrary
      return $ L.pack txt

instance (Ord a, Arbitrary a, Arbitrary b) => Arbitrary (Map a b) where
    arbitrary = do
      l <- arbitrary
      return $ Map.fromList l

instance Arbitrary Bencoding where
    arbitrary = sized bencoding
        where
          bencoding 0 = return $ BencList []
          bencoding n = oneof [liftM BencInt arbitrary,
                               liftM BencString arbitrary,
                               liftM BencList thirdlist,
                               liftM BencDict thirdlist]
              where
                thirdlist :: (Arbitrary a) => Gen a
                thirdlist = resize (n `div` 3) arbitrary

prop_EncodeDecodeInt :: Integer -> Bool
prop_EncodeDecodeInt i = i == (fromJust . fromBencoding . fromJust 
                               . decode . (""++) . encode . BencInt $ i)

prop_EncodeDecodeString :: String -> Bool
prop_EncodeDecodeString s = s == (fromJust . fromBencoding . fromJust
                                  . decode . (""++) . encode . BencString . L.pack $ s)

prop_EncodeDecodeList :: [Integer] -> Bool
prop_EncodeDecodeList xs = BencList (map BencInt xs) 
                           == (fromJust . decode . (""++) . encode . BencList . map BencInt $ xs)

prop_EncodeDecode :: Bencoding -> Bool
prop_EncodeDecode x = x == (fromJust . decode . (""++) . encode $ x)

bencodingProps = [ ("encode.decode(int)/id", quickCheck prop_EncodeDecodeInt)
                 , ("encode.decode(string)/id ", quickCheck prop_EncodeDecodeString)
                 , ("encode.decode(list)/id", quickCheck prop_EncodeDecodeList)
                 , ("encode.decode/id", quickCheck prop_EncodeDecode)
                 ]

-- Why do I get the feeling that HUnit is useless when put next to QuickCheck?
bencodingTests = test [ "empty list" ~: (encode $ BencList []) ~=? (L.pack "le")
                      , "empty dict" ~: (encode $ BencDict Map.empty) ~=? (L.pack "de")
                      , "empty string" ~: (encode $ BencString L.empty) ~=? (L.pack "0:")
                      , "bad int" ~: (decode $ L.pack "ie") ~=? Nothing
                      , "bad int" ~: (decode $ L.pack "i") ~=? Nothing
                      , "bad int" ~: (decode $ L.pack "e") ~=? Nothing
                      , "bad int" ~: (decode $ L.pack "i23.3e") ~=? Nothing
                      , "bad int" ~: (decode $ L.pack "i23,3e") ~=? Nothing
                      , "bad int" ~: (decode $ L.pack "i2a3e") ~=? Nothing
                      , "bad int" ~: (decode $ L.pack "iiee") ~=? Nothing
                      , "bad int" ~: (decode $ L.pack "iae") ~=? Nothing
                      , "bad list" ~: (decode $ L.pack "l") ~=? Nothing
                      , "bad dict" ~: (decode $ L.pack "d") ~=? Nothing
                      ]

------------------------------
-- Tests for Data.Checksum

newtype HexNumber = HexNumber { getDigits :: [HexDigit] }
    deriving (Show, Eq)

newtype HexDigit = HexDigit { getCharValue :: [Char] }
    deriving (Show, Eq)

instance Arbitrary HexDigit where
    arbitrary = do
      c <- elements (concat [['0'..'9'], ['a'..'f']])
      d <- elements (concat [['0'..'9'], ['a'..'f']])
      return $ HexDigit [c, d]

instance Arbitrary HexNumber where
    arbitrary = do
      s <- sized $ \sz -> resize (sz `div` 2) arbitrary
      return $ HexNumber $ concat s

prop_B2HH2B :: HexNumber -> Bool
prop_B2HH2B hn = let hn' = L.pack . concatMap getCharValue . getDigits $ hn
                 in hn' == (bytesToHexGroups . (""++) . hexGroupsToBytes $ hn')

checksumProps = [ ("h2b.b2h/id", quickCheck prop_B2HH2B) ]

------------------------------
-- Tests for Data.Metainfo

metainfoTests = test [ "empty metainfo" ~: (parseMetainfo . L.pack $ "de") ~=? Nothing
                     , "empty metainfo" ~: (parseMetainfo . L.pack $ "") ~=? Nothing
                     , "partial metainfo" ~: (parseMetainfo . L.pack $ "d8:announce3:yes") 
                                          ~=? Nothing
                     ]

------------------------------
-- Tests for Text.Regex.Simple

prop_PrefixMatch :: String -> Bool
prop_PrefixMatch s = matchPattern (take (length s `div` 2) s) s

prop_PrefixFail :: String -> Bool
prop_PrefixFail s = let prefix = take (length s `div` 2) s
                        prefix' = map (\c -> if c =='.' then '#' else c)
                                  . map (\c -> chr $ ord c + 1) $ prefix
                    in if null prefix'
                       then True
                       else matchPattern prefix' s == False

regexTests = test [ "empty pattern" ~: matchPattern "" "" ~=? True
                  , "empty pattern" ~: matchPattern "" "abc" ~=? True
                  , "prefix pattern" ~: matchPattern "a" "abc" ~=? True
                  , "prefix pattern" ~: matchPattern "ab" "abc" ~=? True
                  , "full match" ~: matchPattern "abc" "abc" ~=? True
                  , "failed match" ~: matchPattern "c" "abc" ~=? False
                  , "failed match" ~: matchPattern "ca" "abc" ~=? False
                  , "empty text" ~: matchPattern "ca" "" ~=? False
                  , "failed match" ~: matchPattern "ac" "abc" ~=? False
                  , "shorter text" ~: matchPattern "ac" "a" ~=? False
                  , "failed match" ~: matchPattern "abd" "abc" ~=? False
                  , "wildcard" ~: matchPattern "." "" ~=? False
                  , "wildcard" ~: matchPattern "." "a" ~=? True
                  , "wildcard" ~: matchPattern "a." "abc" ~=? True
                  , "wildcard" ~: matchPattern ".b" "abc" ~=? True
                  , "wildcard" ~: matchPattern ".c" "abc" ~=? False
                  , "wildcard" ~: matchPattern "..." "abc" ~=? True
                  , "wildcard" ~: matchPattern "a.b" "abc" ~=? False
                  , "wildcard" ~: matchPattern "a.b" "aab" ~=? True
                  ]

regexProps = [ ("prefix match", quickCheck prop_PrefixMatch)
             , ("prefix fail", quickCheck prop_PrefixFail) ]

------------------------------
-- Tests for Data.Extra

ordered xs = and $ zipWith (<=) xs (tail xs)

prop_MergeSorted :: [Int] -> Bool
prop_MergeSorted xs = let len = length xs `div` 2
                          (ys, zs) = splitAt len xs
                          (ys', zs') = (sort ys, sort zs)
                      in ordered $ merge ys' zs'

newtype SmallString = SmallString String
    deriving (Show)

instance Arbitrary SmallString where
     arbitrary = do
      s <- sized $ \sz -> resize (sz `div` 2) arbitrary
      return $ SmallString s

prop_PadNothingString :: SmallString -> Bool
prop_PadNothingString (SmallString s) = (padFront 0 'x' s == s)
                                        && (padBack 0 'x' s == s)

newtype SmallInt = SmallInt Int
    deriving (Show)

instance Arbitrary SmallInt where
    arbitrary = do
      n <- sized $ \sz -> resize (sz `div` 2) arbitrary
      return $ SmallInt n

prop_PadLengthString :: SmallInt -> Bool
prop_PadLengthString (SmallInt n) = let s = "Hello World"
                                        l = length s
                                    in (l `max` n == length (padFront n 'x' s))
                                           && (l `max` n == length (padBack n 'x' s))

prop_PadPrefixSuffixString :: SmallInt -> Bool
prop_PadPrefixSuffixString (SmallInt n) = let s = "Hello World"
                                              l = length s
                                          in isSuffixOf s (padFront n 'x' s)
                                                 && isPrefixOf s (padBack n 'x' s)

prop_PadNothingBS :: SmallString -> Bool
prop_PadNothingBS (SmallString s) = let bs = L.pack s
                                    in (padFront 0 'x' bs == bs)
                                        && (padBack 0 'x' bs == bs)

prop_PadLengthBS :: SmallInt -> Bool
prop_PadLengthBS (SmallInt n) =
    let bs = L.pack "Hello World"
        l = L.length bs
    in (l `max` fromIntegral n == L.length (padFront n 'x' bs))
           && (l `max` fromIntegral n == L.length (padBack n 'x' bs))

prop_PadPrefixSuffixBS :: SmallInt -> Bool
prop_PadPrefixSuffixBS (SmallInt n) = let bs = L.pack "Hello World"
                                          l = L.length bs
                                          in LZ.isSuffixOf bs (padFront n 'x' bs)
                                                 && LZ.isPrefixOf bs (padBack n 'x' bs)

newtype NaturalInteger = NaturalInteger Integer
    deriving (Show)

instance Arbitrary NaturalInteger where
    arbitrary = do
      n <- arbitrary
      return . NaturalInteger . abs $ n

prop_MGSReflection :: NaturalInteger -> Bool
prop_MGSReflection (NaturalInteger n) = let ss = makeGroupedSum mgsConfigDiskSpace n
                                            mgss = map swapPair mgsConfigDiskSpace
                                            n' = foldl' (\t (i, s) -> t + i * (fromJust $ lookup s mgss)) 0 ss
                                        in n == n'
    where
      swapPair (a, b) = (b, a)

dataExtraProps = [ ("ordered.merge", quickCheck prop_MergeSorted)
                 , ("pad nothing s", quickCheck prop_PadNothingString)
                 , ("pad length s", quickCheck prop_PadLengthString)
                 , ("pad pre suf s", quickCheck prop_PadPrefixSuffixString)
                 , ("pad nothing bs", quickCheck prop_PadNothingBS)
                 , ("pad length bs", quickCheck prop_PadLengthBS)
                 , ("pad pre suf bs", quickCheck prop_PadPrefixSuffixBS) 
                 , ("mgs reflection", quickCheck prop_MGSReflection)]

props = concat [bencodingProps, checksumProps, regexProps, dataExtraProps]
tests = test [bencodingTests, metainfoTests, regexTests]

main :: IO ()
main = do
  putStrLn "Testing QuickCheck properties"
  mapM_ (\(s, a) -> printf "  %-25s: " s >> a) props

  putStrLn "Running HUnit tests"
  runTestTT tests

  putStrLn "All tests done"