{-# LANGUAGE OverloadedStrings #-}

module Properties (tests) where

import Data.ByteString.Char8 (pack)
import Data.ByteString.From
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 :: Int)    == readBackHex a)
        , testProperty "Int8"   (\a -> Just (a :: Int8)   == readBackHex a)
        , testProperty "Int16"  (\a -> Just (a :: Int16)  == readBackHex a)
        , testProperty "Int32"  (\a -> Just (a :: Int32)  == readBackHex a)
        , testProperty "Int64"  (\a -> Just (a :: Int64)  == readBackHex a)
        , testProperty "Word"   (\a -> Just (a :: Word)   == readBackHex a)
        , testProperty "Word8 " (\a -> Just (a :: Word8)  == readBackHex a)
        , testProperty "Word16" (\a -> Just (a :: Word16) == readBackHex a)
        , testProperty "Word32" (\a -> Just (a :: Word32) == readBackHex a)
        , testProperty "Word64" (\a -> Just (a :: 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 :: [Hex] -> 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 Hex = Hex { hex :: (String, Int) } deriving (Show)

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