Probably useful to include a "mkFixed" function example as well, to show how a Fixed can be constructed using the "optimal" data representation:

-- | Make a fixed field.
--
-- Note that this type constructor function chooses the minimal type
-- representation for the fixed value stored. Unsigned representations
-- are preferred over signed.
mkFixed :: String -> Int -> Integer -> Member
mkFixed name len val
  | len <= 0  = error $ "mkFixed " ++ name ++ ": length < 0"
  | len < 8  && validUnsigned len val = Fixed name len False (fromIntegral val :: Word8)
  | len < 8  && validSigned   len val = Fixed name len True  (fromIntegral val :: Int8)
  | len < 16 && validUnsigned len val = Fixed name len False (fromIntegral val :: Word16)
  | len < 16 && validSigned   len val = Fixed name len True  (fromIntegral val :: Int16)
  | len < 32 && validUnsigned len val = Fixed name len False (fromIntegral val :: Word32)
  | len < 32 && validSigned   len val = Fixed name len True  (fromIntegral val :: Int32)
  | len < 64 && validUnsigned len val = Fixed name len False (fromIntegral val :: Word64)
  | len < 64 && validSigned   len val = Fixed name len True  (fromIntegral val :: Int64)
  | otherwise = error $ "mkFixed " ++ name ++ ": cannot represent this bit field"


On Thu, Aug 23, 2012 at 11:47 AM, Scott Michel <scooter.phd@gmail.com> wrote:
Here's an example (not a complete module) I was using to represent bit-oriented structures as they occur in certain space applications, notably GPS frames. "Fixed" allows for fixed-sized fields and lets the end user choose the integral type that's best for the structure.

At least it's not a parser or language example. :-)


-scooter

-- | Member fields, etc., that comprise a 'BitStruct'
data Member where
  Field    :: String                    -- Field name
              -> Int                    -- Field length
              -> Bool                   -- Signed (True) or unsigned (False)
              -> Member
  ZeroPad  :: String                    -- Field name
              -> Int                    -- Field length
              -> Member
  OnesPad  :: String                    -- Field name
              -> Int                    -- Field length
              -> Member
  ArbPad   :: String                    -- Field name
              -> Int                    -- Field length
              -> Member
  Reserved :: String                    -- Field name
              -> Int                    -- Field length
              -> Member
  Fixed    :: (Integral x, Show x) =>
              String                    -- Field name
              -> Int                    -- Field length
              -> Bool                   -- Signed (True) or unsigned (False)
              -> x                      -- Type of the fixed field's value
              -> Member
  Variant  :: (Integral x, Show x) =>
              String                    -- Variant prefix name
              -> Maybe BitStruct        -- Header before the tag
              -> TagElement             -- The tag element itself
              -> Maybe BitStruct        -- Common elements after the tag
              -> Seq (x, BitStruct)     -- Variant element tuples (value, structure)
              -> Member
  -- Mult-value variant: Use this when multiple variant tag values have the
  -- same structure:
  MultiValueVariant :: (Integral x, Show x) =>
              String                            -- Variant prefix name
              -> Maybe BitStruct                -- Header before the tag
              -> TagElement                     -- The tag element itself
              -> Maybe BitStruct                -- Common elements after the tag
              -> Seq ([x], BitStruct)           -- Variant element tuples ([values], structure)
              -> Member