#line 31 "src/wire.anansi"

#line 30 "src/introduction.anansi"
-- Copyright (C) 2009-2010 John Millikin <jmillikin@gmail.com>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

#line 32 "src/wire.anansi"
module DBus.Wire.Internal where
import Data.Word (Word8, Word64)
import qualified DBus.Types as T

#line 40 "src/wire.anansi"
data Endianness = LittleEndian | BigEndian
	deriving (Show, Eq)

encodeEndianness :: Endianness -> Word8
encodeEndianness LittleEndian = 108
encodeEndianness BigEndian    = 66

decodeEndianness :: Word8 -> Maybe Endianness
decodeEndianness 108 = Just LittleEndian
decodeEndianness 66  = Just BigEndian
decodeEndianness _   = Nothing

#line 69 "src/wire.anansi"
alignment :: T.Type -> Word8

#line 451 "src/wire.anansi"
alignment T.DBusByte    = 1
alignment T.DBusWord16  = 2
alignment T.DBusWord32  = 4
alignment T.DBusWord64  = 8
alignment T.DBusInt16   = 2
alignment T.DBusInt32   = 4
alignment T.DBusInt64   = 8
alignment T.DBusDouble  = 8

#line 548 "src/wire.anansi"
alignment T.DBusBoolean = 4

#line 629 "src/wire.anansi"
alignment T.DBusString     = 4
alignment T.DBusObjectPath = 4

#line 671 "src/wire.anansi"
alignment T.DBusSignature  = 1

#line 687 "src/wire.anansi"
alignment (T.DBusArray _) = 4

#line 769 "src/wire.anansi"
alignment (T.DBusDictionary _ _) = 4

#line 786 "src/wire.anansi"
alignment (T.DBusStructure _) = 8

#line 804 "src/wire.anansi"
alignment T.DBusVariant = 1

#line 71 "src/wire.anansi"

padding :: Word64 -> Word8 -> Word64
padding current count = required where
	count' = fromIntegral count
	missing = mod current count'
	required = if missing > 0
		then count' - missing
		else 0