1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
-- 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
import Prelude
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
|
