-- Copyright : (C) 2009 Corey O'Connor
-- License : BSD-style (see the file LICENSE)
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE ImplicitPrelude #-}
{- I think using a combinatorial species module would vastly simplify this code. Unfortunately I
- just don't know enough about coninatorial species to effectively use a module implementing them.
-
-}
module ArbMarshal where
import Verify hiding ( Property )
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Data.Monoid
import Data.Word
{- A description of a large set of static marshals.
- These are generated by induction on the size of the static marshal. Obviously the generation
- should not be complete. Even for sizes of 1 there are 256 (static value) + 1 (variable hole) =
- 257 possibilities.
- The holes in these marshals have a type (with a static size) and a byte offset location. No hole
- overlaps and they are listed in increasing offset order.
-
- Each static marshal has an associated data value and byte string. The byte string deserialized to
- the data value and the data value serializes to the byte string.
-
- The variable holes are paired up with values. These are paired with the static bytes to form the
- actualy bytes.
-}
data StaticStructure = StaticStructure
-- consecutive properties. A property is either a value or a hole
{ properties :: [Property]
}
deriving (Eq, Show)
instance NFData StaticStructure where
rnf (StaticStructure properties) = rnf properties
class ByteSize v where
byte_size :: v -> Int
total_size = sum . map byte_size
instance ByteSize StaticStructure where
byte_size (StaticStructure properties) = total_size properties
data Property
= Value Value
| Hole
{ byte_offset :: Int
, hole_type :: HoleType
}
deriving (Eq, Show)
instance NFData Property where
rnf (Value v) = rnf v
rnf (Hole o t) = rnf o `seq` rnf t
instance ByteSize Property where
byte_size (Value value) = byte_size value
byte_size (Hole _ hole_type) = byte_size hole_type
hole_count :: StaticStructure -> Int
hole_count (StaticStructure props) = length [ h | Hole _ h <- props ]
data HoleType
= Word8Hole
| Word16Hole
| Word32Hole
deriving (Eq, Show)
instance NFData HoleType where
rnf Word8Hole = ()
rnf Word16Hole = ()
rnf Word32Hole = ()
instance ByteSize HoleType where
byte_size Word8Hole = 1
byte_size Word16Hole = 2
byte_size Word32Hole = 4
data Value
= Word8Value !Word8
| Word16Value !Word16
| Word32Value !Word32
deriving (Eq, Show)
instance NFData Value where
rnf (Word8Value _) = ()
rnf (Word16Value _) = ()
rnf (Word32Value _) = ()
type_for_value :: Value -> HoleType
type_for_value (Word8Value _) = Word8Hole
type_for_value (Word16Value _) = Word16Hole
type_for_value (Word32Value _) = Word32Hole
instance ByteSize Value where
byte_size (Word8Value _ ) = 1
byte_size (Word16Value _ ) = 2
byte_size (Word32Value _ ) = 4
-- A specific value is a static marshal paired with values for the holes and a bytestring.
data StaticStructureValue = StaticStructureValue
{ static_structure :: StaticStructure
, hole_values :: [Value]
}
deriving (Eq, Show)
instance NFData StaticStructureValue where
rnf (StaticStructureValue s vs) = rnf s `seq` rnf vs
instance Arbitrary Value where
arbitrary =
oneof [ Word8Value <$> arbitrary
, Word16Value <$> arbitrary
, Word32Value <$> arbitrary
]
-- This should be sufficient to generate:
-- - a static serialization procedure
-- - the arguments for a static serialization procedure
-- - the bytes expected from a static serialization procedure when applied to a given set of
-- arguments.
-- - the value expected when a deserialization procedure is applied to the given bytes.
-- There is one twist: The serialization and deserialization procedures, being static, have to be
-- generated into haskell modules BEFORE the tests are run.
hole_for_value :: Int -> Value -> Property
hole_for_value byte_offset (Word8Value _) = Hole byte_offset Word8Hole
hole_for_value byte_offset (Word16Value _) = Hole byte_offset Word16Hole
hole_for_value byte_offset (Word32Value _) = Hole byte_offset Word32Hole
instance Arbitrary Property where
arbitrary = do
value <- arbitrary
is_hole <- arbitrary
if is_hole
then return $ hole_for_value 0 value
else return $ Value value
update_offsets :: [Property] -> [Property]
update_offsets props = update_offsets' 0 props
update_offsets' :: Int -> [Property] -> [Property]
update_offsets' byte_offset []
= []
update_offsets' byte_offset (Value v : props)
= Value v : update_offsets' (byte_size v + byte_offset) props
update_offsets' byte_offset (Hole _ t : props)
= Hole byte_offset t : update_offsets' (byte_size t + byte_offset) props
instance Arbitrary StaticStructure where
arbitrary = do
raw_properties <- listOf1 (arbitrary :: Gen Property)
return $ StaticStructure $ update_offsets raw_properties
instance Arbitrary StaticStructureValue where
arbitrary = do
structure <- arbitrary
values <- arbitrary_values structure
return $ StaticStructureValue structure values
arbitrary_values structure = do
let holes = [ h | h@(Hole _ _) <- properties structure ]
forM holes $ \h -> case hole_type h of
Word8Hole -> Word8Value <$> arbitrary
Word16Hole -> Word16Value <$> arbitrary
Word32Hole -> Word32Value <$> arbitrary
ssv_for_ss structure = do
values <- single_arbitrary (arbitrary_values structure)
return $ StaticStructureValue structure values
instance ByteSize StaticStructureValue where
byte_size = byte_size . static_structure
{- A description of a large set of dynamic marshals.
- This description is what is deserialized from the marshal bytes and is what the description
- serializes to.
- The goal is to generate an arbitrary description and corresponding bytes that covers a lot of the
- domain of dynamic memory actions.
-}