{-# LANGUAGE OverloadedStrings #-}

module Properties (tests) where

import Control.Applicative
import Data.ByteString.Char8 (pack)
import Data.ByteString.From
import Data.ByteString.From.Hex
import Data.Int
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Data.Word
import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck
import Text.Printf

tests :: TestTree
tests = testGroup "Properties"
    [ testGroup "Decimals"
        [ testProperty "Int"    (\a -> Just (a :: Int)    == readBack a)
        , testProperty "Int8"   (\a -> Just (a :: Int8)   == readBack a)
        , testProperty "Int16"  (\a -> Just (a :: Int16)  == readBack a)
        , testProperty "Int32"  (\a -> Just (a :: Int32)  == readBack a)
        , testProperty "Int64"  (\a -> Just (a :: Int64)  == readBack a)
        , testProperty "Word"   (\a -> Just (a :: Word)   == readBack a)
        , testProperty "Word8 " (\a -> Just (a :: Word8)  == readBack a)
        , testProperty "Word16" (\a -> Just (a :: Word16) == readBack a)
        , testProperty "Word32" (\a -> Just (a :: Word32) == readBack a)
        , testProperty "Word64" (\a -> Just (a :: Word64) == readBack a)
        ]
    , testGroup "Hexadecimals"
        [ testProperty "Int"    (\a -> Just (a :: Hex Int)    == readBackHex a)
        , testProperty "Int8"   (\a -> Just (a :: Hex Int8)   == readBackHex a)
        , testProperty "Int16"  (\a -> Just (a :: Hex Int16)  == readBackHex a)
        , testProperty "Int32"  (\a -> Just (a :: Hex Int32)  == readBackHex a)
        , testProperty "Int64"  (\a -> Just (a :: Hex Int64)  == readBackHex a)
        , testProperty "Word"   (\a -> Just (a :: Hex Word)   == readBackHex a)
        , testProperty "Word8 " (\a -> Just (a :: Hex Word8)  == readBackHex a)
        , testProperty "Word16" (\a -> Just (a :: Hex Word16) == readBackHex a)
        , testProperty "Word32" (\a -> Just (a :: Hex Word32) == readBackHex a)
        , testProperty "Word64" (\a -> Just (a :: Hex Word64) == readBackHex a)
        ]
    , testGroup "Bool"
        [ testProperty "True"  readBackTrue
        , testProperty "False" readBackFalse
        ]
    , testGroup "Double"
        [ testProperty "Double" readBackDouble
        ]
    , testGroup "List"
        [ testProperty "[Int]"     (readCSV :: [Int]  -> Bool)
        , testProperty "[Word]"    (readCSV :: [Word] -> Bool)
        , testProperty "[Double]"  (readCSV :: [Double] -> Bool)
        , testProperty "[Bool]"    (readCSV :: [Bool] -> Bool)
        , testProperty "[Hex]"     readHexCSV
        , testProperty "Error"     readDoubleCSVAsInt
        ]
    ]

readBack :: (Show a, FromByteString a) => a -> Maybe a
readBack = fromByteString . pack . show

readBackDouble :: Double -> Bool
readBackDouble d = Just d == (fromByteString . pack . show $ d)

readBackHex :: (PrintfArg i, Show i, FromByteString i, Integral i) => i -> Maybe i
readBackHex = fromByteString . pack . printf "+0x%x"

readBackTrue :: Property
readBackTrue = forAll (elements ["True", "true"]) $
    fromMaybe False . fromByteString

readBackFalse :: Property
readBackFalse = forAll (elements ["False", "false"]) $
    fromMaybe False . fmap not . fromByteString

readCSV :: (Eq a, Show a, FromByteString a) => [a] -> Bool
readCSV lst = Just lst == fromByteString (pack (csv lst))
  where
    csv = intercalate "," . map show

readHexCSV :: [HexStr] -> Bool
readHexCSV lst = Just (map (snd . hex) lst) == fromByteString (pack (csv lst))
  where
    csv = intercalate "," . map (fst . hex)

readDoubleCSVAsInt :: [Double] -> Bool
readDoubleCSVAsInt []  = True
readDoubleCSVAsInt lst = Nothing == (fromByteString (pack (csv lst)) :: Maybe [Int])
  where
    csv = intercalate "," . map show

newtype HexStr = HexStr
    { hex :: (String, Hex Int)
    } deriving (Show)

instance Arbitrary HexStr where
    arbitrary = do
        i <- arbitrary
        x <- elements ['x', 'X']
        return $ HexStr (printf ('+':'0':x:"%x") i, i)

instance Arbitrary a => Arbitrary (Hex a) where
    arbitrary = Hex <$> arbitrary