module Tests.Core.Utils where

import Raaz.Core.Types.Internal ( BYTES(..) )

import Tests.Core.Imports hiding (length, replicate)
import Prelude                   (length, replicate)

import Foreign.Ptr           ( castPtr )
import Data.ByteString as B  (concat)

-- | Run a spec with a give key.
with :: key -> (key -> Spec) -> Spec
with :: forall key. key -> (key -> Spec) -> Spec
with key
key key -> Spec
hmsto = key -> Spec
hmsto key
key


-- | Store and the load the given value.
storeAndThenLoad :: EndianStore a
                 => a -> IO a
storeAndThenLoad :: forall a. EndianStore a => a -> IO a
storeAndThenLoad a
a = BYTES Int -> (Ptr Any -> IO a) -> IO a
forall l (ptr :: * -> *) something b.
(LengthUnit l, Pointer ptr) =>
l -> (ptr something -> IO b) -> IO b
allocaBuffer (Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int) -> Proxy a -> BYTES Int
forall a b. (a -> b) -> a -> b
$ a -> Proxy a
forall a. a -> Proxy a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (Ptr a -> IO a
runStoreLoad (Ptr a -> IO a) -> (Ptr Any -> Ptr a) -> Ptr Any -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Any -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)
  where runStoreLoad :: Ptr a -> IO a
runStoreLoad Ptr a
ptr = Ptr a -> a -> IO ()
forall w. EndianStore w => Ptr w -> w -> IO ()
store Ptr a
ptr a
a IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> IO a
forall w. EndianStore w => Ptr w -> IO w
load Ptr a
ptr


allocCast      :: BYTES Int -> (Ptr a -> IO c) -> IO c
allocCast :: forall a c. BYTES Int -> (Ptr a -> IO c) -> IO c
allocCast BYTES Int
sz Ptr a -> IO c
f = BYTES Int -> (Ptr Any -> IO c) -> IO c
forall l (ptr :: * -> *) something b.
(LengthUnit l, Pointer ptr) =>
l -> (ptr something -> IO b) -> IO b
allocaBuffer BYTES Int
sz ((Ptr Any -> IO c) -> IO c) -> (Ptr Any -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO c
f (Ptr a -> IO c) -> (Ptr Any -> Ptr a) -> Ptr Any -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Any -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr

storeAdjustAndPeek :: EndianStore a
                   => a
                   -> IO a
storeAdjustAndPeek :: forall a. EndianStore a => a -> IO a
storeAdjustAndPeek a
a
  = BYTES Int -> (Ptr a -> IO a) -> IO a
forall a c. BYTES Int -> (Ptr a -> IO c) -> IO c
allocCast BYTES Int
sz ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr -> do Ptr a -> a -> IO ()
forall w. EndianStore w => Ptr w -> w -> IO ()
store Ptr a
ptr a
a
                               Ptr a -> Int -> IO ()
forall w. EndianStore w => Ptr w -> Int -> IO ()
adjustEndian Ptr a
ptr Int
1
                               Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
ptr
  where sz :: BYTES Int
sz = Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int) -> Proxy a -> BYTES Int
forall a b. (a -> b) -> a -> b
$ a -> Proxy a
forall a. a -> Proxy a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

pokeAdjustAndLoad :: EndianStore a
                   => a
                   -> IO a
pokeAdjustAndLoad :: forall a. EndianStore a => a -> IO a
pokeAdjustAndLoad a
a
  = BYTES Int -> (Ptr a -> IO a) -> IO a
forall a c. BYTES Int -> (Ptr a -> IO c) -> IO c
allocCast BYTES Int
sz ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr -> do Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
a
                               Ptr a -> Int -> IO ()
forall w. EndianStore w => Ptr w -> Int -> IO ()
adjustEndian Ptr a
ptr Int
1
                               Ptr a -> IO a
forall w. EndianStore w => Ptr w -> IO w
load Ptr a
ptr
  where sz :: BYTES Int
sz = Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int) -> Proxy a -> BYTES Int
forall a b. (a -> b) -> a -> b
$ a -> Proxy a
forall a. a -> Proxy a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a



basicEndianSpecs :: ( EndianStore a, Show a, Eq a, Arbitrary a)
                  => a -> Spec
basicEndianSpecs :: forall a. (EndianStore a, Show a, Eq a, Arbitrary a) => a -> Spec
basicEndianSpecs a
a = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Endian Checks" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> (a -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"store followed by load returns original value" ((a -> IO ()) -> Spec) -> (a -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \ a
x ->
    a -> IO a
forall a. EndianStore a => a -> IO a
storeAndThenLoad (a
x a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
a) IO a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` a
x

  String -> (a -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"store, adjust followed by peek should return the original value" ((a -> IO ()) -> Spec) -> (a -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \ a
x ->
    a -> IO a
forall a. EndianStore a => a -> IO a
storeAdjustAndPeek (a
x a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
a) IO a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` a
x

  String -> (a -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"poke, adjust followed by load should return the original value" ((a -> IO ()) -> Spec) -> (a -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$ \ a
x ->
    a -> IO a
forall a. EndianStore a => a -> IO a
pokeAdjustAndLoad (a
x a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
a) IO a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
`shouldReturn` a
x



-- | Shorten a string to make it readable in tests.
shortened :: String -> String
shortened :: String -> String
shortened String
x | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
11    = String
paddedx
            | Bool
otherwise  = String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
  where l :: Int
l = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x
        prefix :: String
prefix = Int -> String -> String
forall a. Int -> [a] -> [a]
take  Int
4 String
x
        suffix :: String
suffix = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) String
x
        paddedx :: String
paddedx = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
11 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Char
' '

genEncodable :: (Encodable a, Storable a) => Gen a
genEncodable :: forall a. (Encodable a, Storable a) => Gen a
genEncodable = a -> Gen a
forall a. (Encodable a, Storable a) => a -> Gen a
go a
forall a. HasCallStack => a
undefined
  where go :: (Encodable a, Storable a) => a -> Gen a
        go :: forall a. (Encodable a, Storable a) => a -> Gen a
go a
x = ByteString -> a
forall a. Encodable a => ByteString -> a
unsafeFromByteString (ByteString -> a) -> ([Word8] -> ByteString) -> [Word8] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
pack ([Word8] -> a) -> Gen [Word8] -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector (BYTES Int -> Int
forall a. Enum a => a -> Int
fromEnum (BYTES Int -> Int) -> BYTES Int -> Int
forall a b. (a -> b) -> a -> b
$ Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int) -> Proxy a -> BYTES Int
forall a b. (a -> b) -> a -> b
$ a -> Proxy a
forall a. a -> Proxy a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)

-- | Generate bytestrings that are multiples of block size of a
-- primitive.
blocks :: Primitive prim => Proxy prim -> Gen ByteString
blocks :: forall prim. Primitive prim => Proxy prim -> Gen ByteString
blocks Proxy prim
primProxy = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> Gen [ByteString] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString -> Gen [ByteString]
forall a. Gen a -> Gen [a]
listOf Gen ByteString
singleBlock
  where singleBlock :: Gen ByteString
singleBlock = [Word8] -> ByteString
pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
sz
        BYTES Int
sz    = BlockCount prim -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes (BlockCount prim -> BYTES Int) -> BlockCount prim -> BYTES Int
forall a b. (a -> b) -> a -> b
$ Int -> Proxy prim -> BlockCount prim
forall p. Int -> Proxy p -> BlockCount p
blocksOf Int
1 Proxy prim
primProxy


-- | Run a property with a given generator.
feed :: (Testable pr, Show a) => Gen a -> (a -> IO pr) -> Property
feed :: forall pr a.
(Testable pr, Show a) =>
Gen a -> (a -> IO pr) -> Property
feed Gen a
gen a -> IO pr
pr = PropertyM IO pr -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO pr -> Property) -> PropertyM IO pr -> Property
forall a b. (a -> b) -> a -> b
$ Gen a -> PropertyM IO a
forall (m :: * -> *) a. (Monad m, Show a) => Gen a -> PropertyM m a
pick Gen a
gen PropertyM IO a -> (a -> PropertyM IO pr) -> PropertyM IO pr
forall a b.
PropertyM IO a -> (a -> PropertyM IO b) -> PropertyM IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO pr -> PropertyM IO pr
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (IO pr -> PropertyM IO pr) -> (a -> IO pr) -> a -> PropertyM IO pr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO pr
pr)

repeated :: Monoid m => m -> Int -> m
repeated :: forall m. Monoid m => m -> Int -> m
repeated m
m Int
n = [m] -> m
forall a. Monoid a => [a] -> a
mconcat ([m] -> m) -> [m] -> m
forall a b. (a -> b) -> a -> b
$ Int -> m -> [m]
forall a. Int -> a -> [a]
replicate Int
n m
m