content: 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 key hmsto = hmsto key
  
  
  -- | Store and the load the given value.
  storeAndThenLoad :: EndianStore a
                   => a -> IO a
  storeAndThenLoad a = allocaBuffer (sizeOf $ pure a) (runStoreLoad . castPtr)
    where runStoreLoad ptr = store ptr a >> load ptr
  
  
  allocCast      :: BYTES Int -> (Ptr a -> IO c) -> IO c
  allocCast sz f = allocaBuffer sz $ f . castPtr
  
  storeAdjustAndPeek :: EndianStore a
                     => a
                     -> IO a
  storeAdjustAndPeek a
    = allocCast sz $ \ ptr -> do store ptr a
                                 adjustEndian ptr 1
                                 peek ptr
    where sz = sizeOf $ pure a
  
  pokeAdjustAndLoad :: EndianStore a
                     => a
                     -> IO a
  pokeAdjustAndLoad a
    = allocCast sz $ \ ptr -> do poke ptr a
                                 adjustEndian ptr 1
                                 load ptr
    where sz = sizeOf $ pure a
  
  
  
  basicEndianSpecs :: ( EndianStore a, Show a, Eq a, Arbitrary a)
                    => a -> Spec
  basicEndianSpecs a = describe "Endian Checks" $ do
    prop "store followed by load returns original value" $ \ x ->
      storeAndThenLoad (x `asTypeOf` a) `shouldReturn` x
  
    prop "store, adjust followed by peek should return the original value" $ \ x ->
      storeAdjustAndPeek (x `asTypeOf` a) `shouldReturn` x
  
    prop "poke, adjust followed by load should return the original value" $ \ x ->
      pokeAdjustAndLoad (x `asTypeOf` a) `shouldReturn` x
  
  
  
  -- | Shorten a string to make it readable in tests.
  shortened :: String -> String
  shortened x | l <= 11    = paddedx
              | otherwise  = prefix ++ "..." ++ suffix
    where l = length x
          prefix = take  4 x
          suffix = drop (l - 4) x
          paddedx = x ++ replicate (11 - l) ' '
  
  -- | Generate bytestrings that are multiples of block size of a
  -- primitive.
  blocks :: Primitive prim => Proxy prim -> Gen ByteString
  blocks primProxy = B.concat <$> listOf singleBlock
    where singleBlock = pack <$> vector sz
          BYTES sz    = inBytes $ blocksOf 1 primProxy
  
  
  -- | Run a property with a given generator.
  feed :: (Testable pr, Show a) => Gen a -> (a -> IO pr) -> Property
  feed gen pr = monadicIO $ pick gen >>= (run . pr)
  
  repeated :: Monoid m => m -> Int -> m
  repeated m n = mconcat $ replicate n m
  