-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE OverloadedStrings #-}

module Properties (tests) where

import Control.Applicative
import Data.ByteString.Char8 (pack)
import Data.ByteString.Conversion
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 "List Int"     (readCSV :: List Int -> Bool)
        , testProperty "List Word"    (readCSV :: List Word -> Bool)
        , testProperty "List Double"  (readCSV :: List Double -> Bool)
        , testProperty "List Bool"    (readCSV :: List Bool -> Bool)
        , testProperty "List 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) => List a -> Bool
readCSV lst = Just lst == fromByteString (pack (csv lst))
  where
    csv = intercalate "," . map show . fromList

readHexCSV :: List HexStr -> Bool
readHexCSV lst =
    let x = fromByteString (pack (csv lst))
        y = map (snd . hex) (fromList lst)
    in x == Just (List y)
  where
    csv = intercalate "," . map (fst . hex) . fromList

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

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

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