diff --git a/DBus.buildinfo.in b/DBus.buildinfo.in
new file mode 100644
--- /dev/null
+++ b/DBus.buildinfo.in
@@ -0,0 +1,2 @@
+cc-options: @DBUS_CFLAGS@
+ld-options: @DBUS_LIBS@
diff --git a/DBus.cabal b/DBus.cabal
new file mode 100644
--- /dev/null
+++ b/DBus.cabal
@@ -0,0 +1,33 @@
+name: DBus
+version: 0.1
+
+license: BSD3
+license-file: LICENSE
+copyright: Copyright (C) 2006 Evan Martin <martine@danga.com>
+author: Evan Martin <martine@danga.com>
+maintainer: Unmaintained
+
+stability: Experimental
+Category: System
+synopsis: DBus bindings
+description: Bindings for the D-Bus API.
+  For details on D-Bus, see the D-Bus wiki at:
+  <http://www.freedesktop.org/wiki/Software/dbus>
+  .
+  It's worth noting that this binding is not stable or
+  even well-tested at all. Use this library at your own risk.
+homepage: http://neugierig.org/software/hdbus
+
+build-depends: base
+build-type:    Simple
+tested-with:   GHC==6.8.2
+
+exposed-modules: DBus, DBus.Message, DBus.Connection
+other-modules:   DBus.Internal, DBus.Shared
+
+extensions:    ForeignFunctionInterface, OverlappingInstances,
+               ExistentialQuantification, PatternSignatures,
+               ScopedTypeVariables, FlexibleInstances, TypeSynonymInstances
+
+data-files:         README, doc-prologue.txt
+extra-source-files: configure.ac, DBus.buildinfo.in, demo/Demo.hs, demo/Monitor.hs
diff --git a/DBus.hsc b/DBus.hsc
new file mode 100644
--- /dev/null
+++ b/DBus.hsc
@@ -0,0 +1,36 @@
+-- HDBus -- Haskell bindings for D-Bus.
+-- Copyright (C) 2006 Evan Martin <martine@danga.com>
+
+#define DBUS_API_SUBJECT_TO_CHANGE
+#include "dbus/dbus.h"
+
+module DBus (
+  module DBus.Shared,
+
+  -- * Error Handling
+  -- | Some D-Bus functions can only fail on out-of-memory conditions.
+  -- I don't think there is much we can do in those cases.
+  --
+  -- Other D-Bus functions can fail with other sorts of errors, which are
+  -- raised as dynamic exceptions.  Errors can be caught with
+  -- 'Control.Exception.catchDyn', like this:
+  --
+  -- > do conn <- DBus.busGet DBus.System
+  -- >    doSomethingWith conn
+  -- > `catchDyn` (\(DBus.Error name msg) -> putStrLn ("D-Bus error! " ++ msg))
+  --
+  Error(..),
+) where
+
+import DBus.Shared
+import Data.Typeable (Typeable(..), mkTyConApp, mkTyCon)
+
+-- |'Error's carry a name (like \"org.freedesktop.dbus.Foo\") and a
+-- message (like \"connection failed\").
+data Error = Error String String
+instance Typeable Error where
+  typeOf _ = mkTyConApp (mkTyCon "DBus.Error") []
+instance Show Error where
+  show (Error name message) = "D-Bus Error (" ++ name ++ "): " ++ message
+
+-- vim: set ts=2 sw=2 tw=72 et ft=haskell :
diff --git a/DBus/Connection.hsc b/DBus/Connection.hsc
new file mode 100644
--- /dev/null
+++ b/DBus/Connection.hsc
@@ -0,0 +1,210 @@
+-- HDBus -- Haskell bindings for D-Bus.
+-- Copyright (C) 2006 Evan Martin <martine@danga.com>
+
+#define DBUS_API_SUBJECT_TO_CHANGE
+#include "dbus/dbus.h"
+
+module DBus.Connection (
+  -- * Connection Basics
+  Connection,
+  BusType(..),
+  busGet,
+  send, sendWithReplyAndBlock,
+  flush, close,
+  withConnection,
+
+  -- * Main Loop Management
+  readWriteDispatch, addFilter, addMatch,
+
+  RequestNameReply(..),
+  busRequestName,
+) where
+
+import Control.Exception (bracket)
+import Control.Monad (when)
+import Foreign
+import Foreign.C.String
+import Foreign.C.Types (CInt)
+
+import DBus.Internal
+import DBus.Message
+import DBus.Shared
+
+type Connection = ForeignPtr ConnectionTag
+
+data BusType = Session -- ^The login session bus.
+             | System  -- ^The systemwide bus.
+             | Starter -- ^The bus that started us, if any.
+
+foreign import ccall unsafe "&dbus_connection_unref"
+  connection_unref :: FunPtr (ConnectionP -> IO ())
+connectionPTOConnection conn = do
+  when (conn == nullPtr) $ fail "null connection"
+  newForeignPtr connection_unref conn
+
+foreign import ccall unsafe "dbus_bus_get"
+  bus_get :: CInt -> ErrorP -> IO ConnectionP
+-- |Connect to a standard bus.
+busGet :: BusType -> IO Connection
+busGet bt = withErrorP (bus_get (toInt bt)) >>= connectionPTOConnection where
+  toInt Session = #{const DBUS_BUS_SESSION}
+  toInt System  = #{const DBUS_BUS_SYSTEM}
+  toInt Starter = #{const DBUS_BUS_STARTER}
+
+data RequestNameReply = PrimaryOwner | InQueue | Exists | AlreadyOwner
+foreign import ccall unsafe "dbus_bus_request_name"
+  bus_request_name :: ConnectionP -> CString -> CInt -> ErrorP -> IO CInt
+busRequestName :: Connection -> String -> [Int] -> IO RequestNameReply
+busRequestName conn name flags =
+  withForeignPtr conn $ \conn -> do
+    withCString name $ \cname -> do
+      ret <- withErrorP (bus_request_name conn cname 2)
+      return $ fromInt ret where
+  fromInt #{const DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER} = PrimaryOwner
+  fromInt #{const DBUS_REQUEST_NAME_REPLY_IN_QUEUE}      = InQueue
+  fromInt #{const DBUS_REQUEST_NAME_REPLY_EXISTS}        = Exists
+  fromInt #{const DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER} = AlreadyOwner
+
+-- |Close a connection.  A connection must be closed before its last
+-- reference disappears.
+foreign import ccall unsafe "dbus_connection_close"
+  connection_close :: ConnectionP -> IO ()
+close :: Connection -> IO ()
+close conn = withForeignPtr conn connection_close
+
+-- |Open a connection and run an IO action, ensuring it is properly closed when
+-- you're done.
+withConnection :: BusType -> (Connection -> IO a) -> IO a
+withConnection bt = bracket (busGet bt) close
+
+foreign import ccall unsafe "dbus_connection_send"
+  connection_send :: ConnectionP -> MessageP -> Ptr Word32 -> IO Bool
+
+-- |Adds a 'Message' to the outgoing message queue.
+send :: Connection -> Message
+     -> Word32    -- ^Serial.
+     -> IO Word32 -- ^Returned serial.
+send conn msg serial =
+  withForeignPtr conn $ \conn -> do
+    withForeignPtr msg $ \msg -> do
+      with serial $ \serial -> do
+        catchOom $ connection_send conn msg serial
+        peek serial
+
+type PendingCallTag = ()
+type PendingCallP = Ptr PendingCallTag
+type PendingCall = ForeignPtr PendingCallTag
+
+foreign import ccall unsafe "dbus_connection_send_with_reply"
+  connection_send_with_reply :: ConnectionP -> MessageP
+                             -> Ptr PendingCallP -> IO Bool
+foreign import ccall unsafe "&dbus_pending_call_unref"
+  pending_call_unref :: FunPtr (PendingCallP -> IO ())
+
+sendWithReply :: Connection -> Message
+              -> Maybe Int -- ^Optional timeout in milliseconds.
+              -> IO PendingCall
+-- XXX a NULL PendingCall lets us track timeout errors
+sendWithReply conn msg timeout = do
+  withForeignPtr conn $ \conn -> do
+    withForeignPtr msg $ \msg -> do
+      with (nullPtr :: PendingCallP) $ \ppcp -> do
+          catchOom $ connection_send_with_reply conn msg ppcp
+          throwIfNull "null PPendingCall" (return ppcp)
+          pcp <- peek ppcp
+          throwIfNull "null PendingCall" (return pcp)
+          newForeignPtr pending_call_unref pcp
+
+foreign import ccall unsafe "dbus_connection_send_with_reply_and_block"
+  connection_send_with_reply_and_block :: ConnectionP -> MessageP -> Int -> ErrorP -> IO MessageP
+
+sendWithReplyAndBlock :: Connection -> Message
+                      -> Int -- ^Timeout in milliseconds.
+                      -> IO Message
+sendWithReplyAndBlock conn msg timeout =
+  withForeignPtr conn $ \conn -> do
+    withForeignPtr msg $ \msg -> do
+      ret <- withErrorP $ connection_send_with_reply_and_block conn msg timeout
+      messagePToMessage ret False
+
+foreign import ccall unsafe "dbus_connection_flush"
+  connection_flush :: ConnectionP -> IO ()
+-- |Block until all pending messages have been sent.
+flush :: Connection -> IO ()
+flush conn = withForeignPtr conn connection_flush
+
+foreign import ccall "dbus_connection_read_write_dispatch"
+  connection_read_write_dispatch :: ConnectionP -> Int -> IO Bool
+-- |Block until a message is read or written, then return True unless a
+-- disconnect message is received.
+readWriteDispatch :: Connection
+                  -> Int -- ^Timeout, in milliseconds.
+                  -> IO Bool
+readWriteDispatch conn timeout = do
+  withForeignPtr conn $ \conn ->
+    connection_read_write_dispatch conn timeout
+
+-- "a" here is the type of the callback function.
+data FreeClosure a = FreeClosure { fcCallback :: FunPtr a,
+                                   fcFree :: FunPtr (FreeFunction a) }
+type FreeFunction a = StablePtr (FreeClosure a) -> IO ()
+foreign import ccall "wrapper"
+  wrapFreeFunction :: FreeFunction a -> IO (FunPtr (FreeFunction a))
+
+mkFreeClosure :: FunPtr a -> IO (FreeClosure a)
+mkFreeClosure callback = do
+  freef <- wrapFreeFunction freeFunction
+  return $ FreeClosure callback freef
+  where
+    freeFunction :: FreeFunction a
+    freeFunction sptr = do
+      (FreeClosure cb freef) <- deRefStablePtr sptr
+      freeStablePtr sptr
+      freeHaskellFunPtr cb
+      freeHaskellFunPtr freef  -- XXX we are freeing ourselves.
+                               -- XXX this is officially not ok,
+                               -- XXX but it seems like it'll do.
+
+type HandleMessageFunction = ConnectionP -> MessageP -> Ptr () -> IO CInt
+
+foreign import ccall "wrapper"
+  wrapHandleMessageFunction :: HandleMessageFunction
+                            -> IO (FunPtr HandleMessageFunction)
+
+foreign import ccall "dbus_connection_add_filter"
+  connection_add_filter :: ConnectionP
+                        -> FunPtr HandleMessageFunction -> StablePtr a
+                        -> FunPtr (StablePtr a -> IO ()) -> IO Bool
+addFilter :: Connection
+          -> (Message -> IO Bool) -- ^A callback that returns True if
+                                  --  the message has been handled.
+          -> IO ()
+addFilter conn callback = do
+  withForeignPtr conn $ \conn -> do
+    hmf <- wrapHandleMessageFunction handleMessageFunction
+    closure <- mkFreeClosure hmf
+    pclosure <- newStablePtr closure
+    catchOom $ connection_add_filter conn hmf pclosure (fcFree closure)
+    where
+    handleMessageFunction :: HandleMessageFunction
+    handleMessageFunction connp messagep datap = do
+      message <- messagePToMessage messagep True
+      res <- callback message
+      if res then return #{const DBUS_HANDLER_RESULT_HANDLED}
+             else return #{const DBUS_HANDLER_RESULT_NOT_YET_HANDLED}
+
+
+foreign import ccall "dbus_bus_add_match"
+  bus_add_match :: ConnectionP -> CString -> ErrorP -> IO ()
+addMatch :: Connection
+         -> Bool -- ^Whether to block waiting for a response, allowing
+                 -- us to raise an exception if a response never comes.
+         -> String -> IO ()
+addMatch conn block rule =
+  withForeignPtr conn $ \conn ->
+    withCString rule $ \rule -> do
+      if block
+        then withErrorP $ bus_add_match conn rule
+        else bus_add_match conn rule nullPtr
+
+-- vim: set ts=2 sw=2 tw=72 et ft=haskell :
diff --git a/DBus/Internal.hsc b/DBus/Internal.hsc
new file mode 100644
--- /dev/null
+++ b/DBus/Internal.hsc
@@ -0,0 +1,62 @@
+-- HDBus -- Haskell bindings for D-Bus.
+-- Copyright (C) 2006 Evan Martin <martine@danga.com>
+
+-- tell Haddock not to doc this module:
+-- #hide
+
+#define DBUS_API_SUBJECT_TO_CHANGE
+#include "dbus/dbus.h"
+
+module DBus.Internal where
+
+import Control.Exception (throwDyn)
+import Control.Monad (when)
+import DBus (Error(..))
+import Foreign
+import Foreign.C.String
+
+type MessageTag = ()
+type MessageP = Ptr MessageTag
+type ConnectionTag = ()
+type ConnectionP = Ptr ConnectionTag
+
+allocInit :: Int -> (Ptr a -> IO ()) -> (Ptr a -> IO b) -> IO b
+allocInit size init cont = allocaBytes size $ \obj -> do init obj; cont obj
+
+-- Sometimes functions claim they can only fail in oom conditions.
+-- What else can we do but die?
+catchOom :: IO Bool -> IO ()
+catchOom action = throwIf_ (== False) (const "Out of memory") action
+
+foreign import ccall unsafe "dbus_message_ref"
+  message_ref :: MessageP -> IO ()
+foreign import ccall unsafe "&dbus_message_unref"
+  message_unref :: FunPtr (MessageP -> IO ())
+messagePToMessage msg addref = do
+  throwIfNull "null message" (return msg)
+  when addref $ message_ref msg
+  newForeignPtr message_unref msg
+
+type ErrorTag = ()
+type ErrorP = Ptr ErrorTag
+
+foreign import ccall unsafe "dbus_error_init"
+  error_init :: ErrorP -> IO ()
+foreign import ccall unsafe "dbus_error_is_set"
+  error_is_set :: ErrorP -> IO Bool
+foreign import ccall unsafe "dbus_error_free"
+  error_free :: ErrorP -> IO ()
+
+withErrorP :: (ErrorP -> IO a) -> IO a
+withErrorP f =
+  allocInit #{size DBusError} error_init $ \err -> do
+    ret <- f err
+    has_err <- error_is_set err
+    if not has_err
+      then return ret
+      else do name <- #{peek DBusError, name} err >>= peekCString
+              msg  <- #{peek DBusError, message} err >>= peekCString
+              error_free err
+              throwDyn $ Error name msg
+
+-- vim: set ts=2 sw=2 tw=72 et ft=haskell :
diff --git a/DBus/Message.hsc b/DBus/Message.hsc
new file mode 100644
--- /dev/null
+++ b/DBus/Message.hsc
@@ -0,0 +1,398 @@
+{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, TypeSynonymInstances #-}
+-- HDBus -- Haskell bindings for D-Bus.
+-- Copyright (C) 2006 Evan Martin <martine@danga.com>
+
+#define DBUS_API_SUBJECT_TO_CHANGE
+#include "dbus/dbus.h"
+
+module DBus.Message (
+  -- * Messages
+  Message,
+  newSignal, newMethodCall,
+  -- * Accessors
+  Type(..),
+  getType, getSignature,
+  getPath, getInterface, getMember, getErrorName,
+  getDestination, getSender,
+
+  -- * Arguments
+  Arg(..),
+  args, addArgs,
+  -- ** Dictionaries
+  -- | D-Bus functions that expect a dictionary must be passed a 'Dict',
+  -- which is trivially constructable from an appropriate list.
+  Dict, dict,
+  -- ** Variants
+  -- | Some D-Bus functions allow variants, which are similar to
+  -- 'Data.Dynamic' dynamics but restricted to D-Bus data types.
+  Variant, variant
+) where
+
+import Control.Monad (when)
+import Data.Int
+import Data.Word
+import Data.Dynamic
+import Foreign
+import Foreign.C.String
+import Foreign.C.Types (CInt)
+
+import DBus.Internal
+import DBus.Shared
+
+type Message = ForeignPtr MessageTag
+
+foreign import ccall unsafe "dbus_message_new_signal"
+  message_new_signal :: CString -> CString -> CString -> IO MessageP
+foreign import ccall unsafe "dbus_message_new_method_call"
+  message_new_method_call :: CString -> CString -> CString -> CString -> IO MessageP
+
+newSignal :: PathName      -- ^Path.
+          -> InterfaceName -- ^Interface.
+          -> String        -- ^Method name.
+          -> IO Message
+newSignal path iface name =
+  withCString path $ \cpath ->
+    withCString iface $ \ciface ->
+      withCString name $ \cname -> do
+        msg <- message_new_signal cpath ciface cname
+        messagePToMessage msg False
+
+newMethodCall :: ServiceName   -- ^Bus name.
+              -> PathName      -- ^Path.
+              -> InterfaceName -- ^Interface.
+              -> String        -- ^Method name.
+              -> IO Message
+newMethodCall busname path iface method =
+  withCString busname $ \cbusname ->
+    withCString path $ \cpath ->
+      withCString iface $ \ciface ->
+        withCString method $ \cmethod -> do
+          msg <- message_new_method_call cbusname cpath ciface cmethod
+          messagePToMessage msg False
+
+data Type = MethodCall | MethodReturn | Error | Signal
+          | Other Int deriving Show
+instance Enum Type where
+  toEnum #{const DBUS_MESSAGE_TYPE_METHOD_CALL}   = MethodCall
+  toEnum #{const DBUS_MESSAGE_TYPE_METHOD_RETURN} = MethodReturn
+  toEnum #{const DBUS_MESSAGE_TYPE_ERROR}         = Error
+  toEnum #{const DBUS_MESSAGE_TYPE_SIGNAL}        = Signal
+  toEnum x = Other x
+  fromEnum = error "not implemented"
+foreign import ccall unsafe "dbus_message_get_type"
+  message_get_type :: MessageP -> IO Int
+getType :: Message -> IO Type
+getType msg = withForeignPtr msg message_get_type >>= return . toEnum
+
+getOptionalString :: (MessageP -> IO CString) -> Message -> IO (Maybe String)
+getOptionalString getter msg =
+  withForeignPtr msg getter >>= maybePeek peekCString
+
+foreign import ccall unsafe dbus_message_get_path :: MessageP -> IO CString
+foreign import ccall unsafe dbus_message_get_interface :: MessageP -> IO CString
+foreign import ccall unsafe dbus_message_get_member :: MessageP -> IO CString
+foreign import ccall unsafe dbus_message_get_error_name :: MessageP -> IO CString
+foreign import ccall unsafe dbus_message_get_sender :: MessageP -> IO CString
+foreign import ccall unsafe dbus_message_get_signature :: MessageP -> IO CString
+foreign import ccall unsafe dbus_message_get_destination :: MessageP -> IO CString
+getPath, getInterface, getMember, getErrorName, getDestination, getSender
+  :: Message -> IO (Maybe String)
+getPath        = getOptionalString dbus_message_get_path
+getInterface   = getOptionalString dbus_message_get_interface
+getMember      = getOptionalString dbus_message_get_member
+getErrorName   = getOptionalString dbus_message_get_error_name
+getDestination = getOptionalString dbus_message_get_destination
+getSender      = getOptionalString dbus_message_get_sender
+getSignature :: Message -> IO String
+getSignature msg =
+  withForeignPtr msg dbus_message_get_signature >>= peekCString
+
+type IterTag = ()
+type Iter = Ptr IterTag
+
+class Show a => Arg a where
+  toIter :: a -> Iter -> IO ()
+  fromIter :: Iter -> IO a
+  signature :: a -> String
+
+  -- for collection types, this does from/to inside the collection's iter
+  toIterInternal   :: a -> Iter -> IO ()
+  toIterInternal   = toIter
+  fromIterInternal :: Iter -> IO a
+  fromIterInternal = fromIter
+
+assertArgType iter expected_type = do
+  arg_type <- message_iter_get_arg_type iter
+  when (arg_type /= expected_type) $
+    fail $ "Expected arg type " ++ show expected_type ++
+           " but got " ++ show arg_type
+
+putBasic iter typ val = catchOom (message_iter_append_basic iter typ val)
+withContainer iter typ sig f =
+  withIter $ \sub -> do
+    catchOom $ (message_iter_open_container iter typ sig sub)
+    f sub
+    catchOom $ (message_iter_close_container iter sub)
+
+instance Arg () where
+  toIter _ _ = return ()
+  fromIter _ = return ()
+  signature _ = "()" -- not really correct, but we should never need this.
+
+instance Arg String where
+  fromIter iter = do
+    assertArgType iter #{const DBUS_TYPE_STRING}
+    alloca $ \str -> do
+      message_iter_get_basic iter str
+      peek str >>= peekCString
+  toIter arg iter =
+    -- we need a pointer to a CString (which itself is Ptr CChar)
+    withCString arg $ \cstr ->
+      with cstr $ putBasic iter #{const DBUS_TYPE_STRING}
+  signature _ = "s"
+
+instance Arg Int32 where
+  fromIter iter = do
+    assertArgType iter #{const DBUS_TYPE_INT32}
+    alloca $ \int -> do
+      message_iter_get_basic iter int
+      peek int
+  toIter arg iter = with arg $ putBasic iter #{const DBUS_TYPE_INT32}
+  signature _ = "i"
+instance Arg Word32 where
+  fromIter iter = do
+    assertArgType iter #{const DBUS_TYPE_UINT32}
+    alloca $ \int -> do
+      message_iter_get_basic iter int
+      peek int
+  toIter arg iter = with arg $ putBasic iter #{const DBUS_TYPE_UINT32}
+  signature _ = "u"
+
+data Variant = forall a. Arg a => Variant a
+variant :: Arg a => a -> Variant
+variant = Variant
+instance Show Variant where
+  show (Variant a) = "[variant]" ++ show a
+instance Arg Variant where
+  fromIter iter = do
+    assertArgType iter #{const DBUS_TYPE_VARIANT}
+    elem_type <- message_iter_get_element_type iter
+    withIter $ \sub -> do
+      message_iter_recurse iter sub
+      variantFromIterType sub elem_type where
+    -- XXX there ought to be a more clever way to do this.
+    variantFromIterType iter #{const DBUS_TYPE_STRING} = do
+      (v :: String) <- fromIter iter; return $ Variant v
+    variantFromIterType iter #{const DBUS_TYPE_INT32} = do
+      (v :: Int32)  <- fromIter iter; return $ Variant v
+    variantFromIterType iter #{const DBUS_TYPE_UINT32} = do
+      (v :: Word32) <- fromIter iter; return $ Variant v
+  toIter (Variant arg) iter = do
+    withIter $ \sub ->
+      withCString (signature arg) $ \sig ->
+        withContainer iter #{const DBUS_TYPE_VARIANT} sig $ \sub ->
+          toIter arg sub where
+  signature _ = "v"
+
+instance Arg a => Arg [a] where
+  fromIter iter = do
+    assertArgType iter #{const DBUS_TYPE_ARRAY}
+    len <- message_iter_get_array_len iter
+    if len > 0
+      then withIter $ \sub -> do
+             message_iter_recurse iter sub
+             array <- getArray sub
+             return array
+      else return [] where
+    getArray sub = do x <- fromIter sub
+                      has_next <- message_iter_next sub
+                      if has_next
+                        then do xs <- getArray sub
+                                return (x:xs)
+                        else return [x]
+  toIter arg iter =
+    withIter $ \sub ->
+      withCString (signature (undefined :: a)) $ \sig ->
+        withContainer iter #{const DBUS_TYPE_ARRAY} sig $ \sub ->
+          mapM_ (\v -> toIter v sub) arg
+  signature a = "a" ++ signature (undefined :: a)
+
+-- instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g,Show h) => Show (a,b,c,d,e,f,g,h) where
+--   show _ = "[show not implemented]"
+
+newtype DictEntry a b = DictEntry (a,b)
+instance (Show a, Show b) => Show (DictEntry a b) where
+  show (DictEntry pair) = "[DictEntry] " ++ show pair
+instance (Arg a, Arg b) => Arg (DictEntry a b) where
+  toIter (DictEntry pair) iter =
+    withContainer iter #{const DBUS_TYPE_DICT_ENTRY} nullPtr $ \sub -> do
+      toIterInternal pair sub
+  fromIter iter = do
+    pair <- fromIter iter
+    return (DictEntry pair)
+  signature _ =
+    "{" ++ signature (undefined :: a) ++ signature (undefined :: b) ++ "}"
+
+type Dict a b = [DictEntry a b]
+dict :: (Arg a, Arg b) => [(a, b)] -> Dict a b
+dict = map DictEntry
+
+-- tuple instances generated by codegen/TupleInstances.hs
+instance (Arg a,Arg b) => Arg (a,b) where
+  toIter arg iter =
+    withContainer iter #{const DBUS_TYPE_STRUCT} nullPtr $ \sub -> do
+    toIterInternal arg sub
+  fromIter iter =
+    withIter $ \sub -> do
+      message_iter_recurse iter sub
+      fromIterInternal sub
+  signature _ =
+    "{" ++ signature (undefined :: a) ++ signature (undefined :: b) ++ "}"
+  toIterInternal (a,b) iter = do
+    toIter a iter; toIter b iter
+    return ()
+  fromIterInternal iter = do
+    a <- fromIter iter; next <- message_iter_next iter
+    b <- fromIter iter; next <- message_iter_next iter
+    return (a,b)
+
+instance (Arg a,Arg b,Arg c,Arg d,Arg e,Arg f,Arg g,Arg h) => Arg (a,b,c,d,e,f,g,h) where
+  toIter arg iter =
+    withContainer iter #{const DBUS_TYPE_STRUCT} nullPtr $ \sub -> do
+    toIterInternal arg sub
+  fromIter iter =
+    withIter $ \sub -> do
+      message_iter_recurse iter sub
+      fromIterInternal sub
+  signature _ =
+    "{" ++ signature (undefined :: a) ++ signature (undefined :: b) ++ signature (undefined :: c) ++ signature (undefined :: d) ++ signature (undefined :: e) ++ signature (undefined :: f) ++ signature (undefined :: g) ++ signature (undefined :: h) ++ "}"
+  toIterInternal (a,b,c,d,e,f,g,h) iter = do
+    toIter a iter; toIter b iter; toIter c iter; toIter d iter; toIter e iter; toIter f iter; toIter g iter; toIter h iter
+    return ()
+  fromIterInternal iter = do
+    a <- fromIter iter; next <- message_iter_next iter
+    b <- fromIter iter; next <- message_iter_next iter
+    c <- fromIter iter; next <- message_iter_next iter
+    d <- fromIter iter; next <- message_iter_next iter
+    e <- fromIter iter; next <- message_iter_next iter
+    f <- fromIter iter; next <- message_iter_next iter
+    g <- fromIter iter; next <- message_iter_next iter
+    h <- fromIter iter; next <- message_iter_next iter
+    return (a,b,c,d,e,f,g,h)
+
+dynTag :: Dynamic -> Int32
+dynTag x =
+  case fromDynamic x of
+    Just (i :: Int32) -> #{const DBUS_TYPE_INT32}
+    Nothing ->
+      case fromDynamic x of
+        Just (word :: Word32) -> #{const DBUS_TYPE_UINT32}
+        Nothing ->
+          case fromDynamic x of
+            Just (s :: String) -> #{const DBUS_TYPE_STRING}
+            Nothing ->
+              case fromDynamic x of
+                Just (arr :: [Dynamic]) -> #{const DBUS_TYPE_ARRAY}
+                Nothing ->
+                  case fromDynamic x of
+                    Just (a :: [Dynamic], b :: [Dynamic]) -> #{const DBUS_TYPE_DICT_ENTRY}
+                    Nothing ->
+                      case fromDynamic x of
+                        Just (b :: Bool) -> #{const DBUS_TYPE_BOOLEAN}
+                        Nothing -> #{const DBUS_TYPE_INVALID}
+
+instance Arg [Dynamic] where
+  fromIter iter =
+    let loop list False = return (reverse list)
+        loop list True = do
+          argt <- message_iter_get_arg_type iter
+          let next x = do {
+            valid <- message_iter_next iter;
+            loop (x:list) valid }
+          -- putStr $ "argt is " ++ show argt ++ "\n"
+          case argt of
+            #{const DBUS_TYPE_INVALID} -> return (reverse list)
+            #{const DBUS_TYPE_UINT32} -> do
+              (word :: Word32) <- fromIter iter
+              next (toDyn word)
+            #{const DBUS_TYPE_INT32} -> do
+              (i :: Int32) <- fromIter iter
+              next (toDyn i)
+            #{const DBUS_TYPE_STRING} -> do
+              (s :: String) <- fromIter iter
+              next (toDyn s)
+            #{const DBUS_TYPE_ARRAY} -> do
+              (arr :: [[Dynamic]]) <- fromIter iter -- this could be better
+              next (toDyn arr)
+            #{const DBUS_TYPE_DICT_ENTRY} -> do
+              (DictEntry (a :: [Dynamic], b :: [Dynamic])) <- fromIter iter
+              next (toDyn (a,b))
+            #{const DBUS_TYPE_STRUCT} -> do
+              withIter $ \sub -> do
+                message_iter_recurse iter sub
+                (inner :: [Dynamic]) <- fromIter sub
+                next (toDyn inner)
+            #{const DBUS_TYPE_BOOLEAN} -> do
+              (b :: Bool) <- alloca $ \int -> do {
+                               message_iter_get_basic iter int;
+                               peek int }
+              next (toDyn b)
+            #{const DBUS_TYPE_VARIANT} -> do
+              withIter $ \sub -> do
+                message_iter_recurse iter sub
+                (inner :: [Dynamic]) <- fromIter sub
+                next (toDyn inner)
+    in loop [] True
+  toIter list iter =
+    let loop [] iter = return ()
+        loop (x:xs) iter = do
+          case dynTag x of
+            #{const DBUS_TYPE_INVALID} -> fail $ "Unsupported dynamic value: " ++ show x
+            #{const DBUS_TYPE_UINT32} -> toIter (fromDyn x (0 :: Word32)) iter
+            #{const DBUS_TYPE_INT32} -> toIter (fromDyn x (0 :: Int32)) iter
+            #{const DBUS_TYPE_STRING} -> toIter (fromDyn x ("" :: String)) iter
+          loop xs iter
+    in loop list iter
+  signature _ = "d"
+
+foreign import ccall unsafe "dbus_message_iter_init"
+  message_iter_init :: MessageP -> Iter -> IO Bool
+foreign import ccall unsafe "dbus_message_iter_init_append"
+  message_iter_init_append :: MessageP -> Iter -> IO ()
+foreign import ccall unsafe "dbus_message_iter_get_arg_type"
+  message_iter_get_arg_type :: Iter -> IO Int
+foreign import ccall unsafe "dbus_message_iter_get_element_type"
+  message_iter_get_element_type :: Iter -> IO Int
+foreign import ccall unsafe "dbus_message_iter_get_basic"
+  message_iter_get_basic :: Iter -> Ptr a -> IO ()
+foreign import ccall unsafe "dbus_message_iter_get_array_len"
+  message_iter_get_array_len :: Iter -> IO CInt
+foreign import ccall unsafe "dbus_message_iter_recurse"
+  message_iter_recurse :: Iter -> Iter -> IO ()
+foreign import ccall unsafe "dbus_message_iter_next"
+  message_iter_next :: Iter -> IO Bool
+foreign import ccall unsafe "dbus_message_iter_append_basic"
+  message_iter_append_basic :: Iter -> CInt -> Ptr a -> IO Bool
+foreign import ccall unsafe "dbus_message_iter_open_container"
+  message_iter_open_container :: Iter -> CInt -> CString -> Iter -> IO Bool
+foreign import ccall unsafe "dbus_message_iter_close_container"
+  message_iter_close_container :: Iter -> Iter -> IO Bool
+
+withIter = allocaBytes #{size DBusMessageIter}
+
+-- |Retrieve the arguments from a message.
+args :: (Arg a) => Message -> IO a
+args msg =
+  withForeignPtr msg $ \msg -> do
+    withIter $ \iter -> do
+      has_args <- message_iter_init msg iter
+      fromIter iter
+
+-- |Add arguments to a message.
+addArgs :: (Arg a) => Message -> a -> IO ()
+addArgs msg arg =
+  withForeignPtr msg $ \msg ->
+    allocInit #{size DBusMessageIter} (message_iter_init_append msg) $ \iter ->
+      toIterInternal arg iter
+
+-- vim: set ts=2 sw=2 tw=72 et ft=haskell :
diff --git a/DBus/Shared.hsc b/DBus/Shared.hsc
new file mode 100644
--- /dev/null
+++ b/DBus/Shared.hsc
@@ -0,0 +1,36 @@
+-- HDBus -- Haskell bindings for D-Bus.
+-- Copyright (C) 2006 Evan Martin <martine@danga.com>
+
+-- tell Haddock not to doc this module:
+-- #hide
+
+#define DBUS_API_SUBJECT_TO_CHANGE
+#include "dbus/dbus.h"
+
+module DBus.Shared (
+  -- * Constants
+  -- |Well-known service, path, and interface names.
+  ServiceName, PathName, InterfaceName,
+  serviceDBus,
+  pathDBus, pathLocal,
+  interfaceDBus, interfaceIntrospectable, interfaceLocal,
+  
+) where
+
+import Foreign
+import Foreign.C.String
+
+type ServiceName = String
+type PathName = FilePath
+type InterfaceName = String
+serviceDBus :: ServiceName
+pathDBus, pathLocal :: PathName
+interfaceDBus, interfaceIntrospectable, interfaceLocal :: InterfaceName
+serviceDBus = #{const_str DBUS_SERVICE_DBUS}
+pathDBus    = #{const_str DBUS_PATH_DBUS}
+pathLocal   = #{const_str DBUS_PATH_LOCAL}
+interfaceDBus = #{const_str DBUS_INTERFACE_DBUS}
+interfaceIntrospectable = #{const_str DBUS_INTERFACE_INTROSPECTABLE}
+interfaceLocal = #{const_str DBUS_INTERFACE_LOCAL}
+
+-- vim: set ts=2 sw=2 tw=72 et ft=haskell :
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,23 @@
+Copyright (c) 2006 Evan Martin <martine@danga.com>
+All rights reserved.
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * The name of the author may not be used to endorse or promote products
+      derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,25 @@
+HDBus -- Haskell bindings for D-Bus.
+Copyright (C) 2006 Evan Martin <martine@danga.com>
+
+== About
+"D-Bus is a message bus system, a simple way for applications to talk to one
+another."  It's particularly popular on free software desktops (Gnome, KDE).
+See http://www.freedesktop.org/wiki/Software/dbus for details.
+
+== Installation
+You must have the D-Bus headers and libraries installed.
+Install on Debian-based systems with:
+  apt-get install libdbus-1-dev
+Check your installation with:
+  pkg-config --modversion dbus-1
+
+The module code is in module/, and it's the standard series of cabal steps:
+  runhaskell Setup.lhs configure
+  runhaskell Setup.lhs build
+  runhaskell Setup.lhs install
+
+== How to Use it
+See demo/Demo.hs for some example calls.
+
+== License
+BSD.  See module/LICENSE for details.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/runhaskell
+> import Distribution.Simple
+> main = defaultMainWithHooks autoconfUserHooks
diff --git a/configure.ac b/configure.ac
new file mode 100644
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,5 @@
+AC_INIT([HDBus], [0.1], [martine@danga.com], [HDBus])
+AC_CONFIG_SRCDIR([DBus.cabal])
+PKG_CHECK_MODULES(DBUS, [dbus-1])
+AC_CONFIG_FILES([DBus.buildinfo])
+AC_OUTPUT
diff --git a/demo/Demo.hs b/demo/Demo.hs
new file mode 100644
--- /dev/null
+++ b/demo/Demo.hs
@@ -0,0 +1,84 @@
+{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances #-}
+-- HDBus -- Haskell bindings for DBus.
+-- Copyright (C) 2006 Evan Martin <martine@danga.com>
+
+import qualified DBus
+import qualified DBus.Connection
+import qualified DBus.Message
+import Control.Exception
+import Data.Int
+import Data.Word
+
+main :: IO ()
+main = do
+  DBus.Connection.withConnection DBus.Connection.Session $ \bus -> do
+    (t1 :: [String]) <- testMethodCall bus DBus.serviceDBus DBus.pathDBus
+                                       DBus.interfaceDBus "ListNames" ()
+    (t2 :: String) <- testMethodCall bus DBus.serviceDBus DBus.pathDBus
+                      DBus.interfaceIntrospectable "Introspect" ()
+
+    --testGaim bus
+    --testBmp bus
+    testNotify bus
+
+    signalTest bus
+
+testGaim bus = do
+  accounts <- gaimCall "GaimAccountsGetAll" ()
+  let account :: Int32 = head accounts
+  username <- gaimCall "GaimAccountGetUsername" account
+  putStrLn $ "First account is " ++ username ++ "." where
+    gaimCall :: (DBus.Message.Arg a, DBus.Message.Arg b) => String -> a -> IO b
+    gaimCall = testMethodCall bus "net.sf.gaim.GaimService"
+                              "/net/sf/gaim/GaimObject"
+                              "net.sf.gaim.GaimInterface"
+
+testBmp bus = do
+  bmpCall "VolumeGet" []
+  bmpCall "VolumeSet" [50 :: Int32] where
+    bmpCall = testMethodCall bus "org.beepmediaplayer.bmp" "/SystemControl" "org.beepmediaplayer.bmp"
+
+testNotify bus = do
+  -- For details on this API, see the desktop notification spec at
+  -- http://www.galago-project.org/specs/notification/
+  let args = ("hdbus",
+              0 :: Word32,   -- don't replace anybody
+              "",  -- no icon
+              "hdbus calling",
+              "This message was sent via hdbus.",
+              [] :: [String],
+              [] :: DBus.Message.Dict String DBus.Message.Variant,
+              3*1000 :: Int32  -- timeout
+              )
+  () <- notifyCall "Notify" args
+  return () where
+    notifyCall = testMethodCall bus "org.freedesktop.Notifications"
+                                "/org/freedesktop/Notifications"
+                                "org.freedesktop.Notifications"
+
+showArgs :: DBus.Message.Arg a => a -> String
+showArgs args = show args ++ " (sig: " ++ DBus.Message.signature args ++ ")"
+
+testMethodCall :: (DBus.Message.Arg a, DBus.Message.Arg b)
+               => DBus.Connection.Connection
+               -> DBus.ServiceName -> DBus.PathName -> DBus.InterfaceName
+               -> String -> a -> IO b
+testMethodCall bus name path iface method args = do
+  putStrLn ""
+  putStrLn $ "Calling: " ++ show [name, path, iface, method]
+  putStrLn $ "  with args:" ++ showArgs args
+  do
+    msg   <- DBus.Message.newMethodCall name path iface method
+    DBus.Message.addArgs msg args
+    reply <- DBus.Connection.sendWithReplyAndBlock bus msg 2000
+    replyargs <- DBus.Message.args reply
+    putStrLn $ "Result: " ++ showArgs replyargs
+    return replyargs
+  `catchDyn` (\(e :: DBus.Error) -> do print e; fail "fatal: dbus error")
+
+signalTest bus = do
+  msg <- DBus.Message.newSignal "/org/neugierig/HDBusTest" "org.neugierg.HDBus" "Test"
+  ret <- DBus.Connection.send bus msg 0
+  print ret
+
+-- vim: set ts=2 sw=2 et ft=haskell :
diff --git a/demo/Monitor.hs b/demo/Monitor.hs
new file mode 100644
--- /dev/null
+++ b/demo/Monitor.hs
@@ -0,0 +1,132 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+--  ghc --make -ldbus-1 -o monitor Monitor.hs
+
+import qualified DBus
+import qualified DBus.Connection
+import qualified DBus.Message
+import Control.Exception(catchDyn)
+import Data.Int
+import Data.Word
+import Data.Dynamic
+import DBus.Message(Arg, variant)
+import DBus.Connection(withConnection, readWriteDispatch, addFilter, addMatch, BusType(Session))
+
+
+type Variant = DBus.Message.Variant
+type Bus = DBus.Connection.Connection
+type NotifyArgs = (String, Word32, String, String, String,
+                   [String], DBus.Message.Dict String Variant, Int32)
+
+
+main :: IO ()
+main = do
+  let loop bus = (readWriteDispatch bus (-1) >> loop bus)
+  withConnection Session $ \bus -> do
+    addFilter bus $ \msg -> do
+      path <- DBus.Message.getPath msg
+      iface <- DBus.Message.getInterface msg
+      member <- DBus.Message.getMember msg
+      src <- DBus.Message.getSender msg
+      dst <- DBus.Message.getDestination msg
+      errname <- DBus.Message.getErrorName msg
+      sig <- DBus.Message.getSignature msg
+      t <- DBus.Message.getType msg
+      let cstr (Just s) = s
+          cstr (Nothing) = "null"
+      let s = "sender="++ cstr src ++ " -> dest="++cstr dst ++ " sig=" ++ sig
+      let ms = s ++ " path=" ++ cstr path ++ "; interface="++ cstr iface
+                 ++ "; member=" ++ cstr member ++ "\n"
+      case t of
+        DBus.Message.MethodCall -> putStr $ "Call " ++ ms
+        DBus.Message.MethodReturn -> putStr $ "Return " ++ s ++ "\n"
+        DBus.Message.Error -> putStr $ "Error " ++ s ++ " errname=" ++ cstr errname ++ "\n"
+        DBus.Message.Signal -> putStr $ "Signal " ++ ms
+        DBus.Message.Other x -> putStr $ "Other: " ++ (show x) ++ ms
+      vars <- variantArgs msg
+      mapM_ (\var -> do
+               putStr "\t"
+               print var)
+            vars
+      return True
+    addMatch bus False "type='method_call'"
+    addMatch bus False "type='method_return'"
+    addMatch bus False "type='error'"
+    addMatch bus False "type='signal'"
+    loop bus
+
+data Tagged = I32 Int32 | W32 Word32 | S String | A [Dynamic] | B Bool | E [Dynamic] [Dynamic] | Invalid
+
+tag :: Dynamic -> Tagged
+tag dyn =
+  case fromDynamic dyn of
+    Just (i :: Int32) -> I32 i
+    Nothing ->
+      case fromDynamic dyn of
+        Just (word :: Word32) -> W32 word
+        Nothing ->
+          case fromDynamic dyn of
+            Just (s :: String) -> S s 
+            Nothing ->
+              case fromDynamic dyn of
+                Just (arr :: [Dynamic]) -> A arr
+                Nothing ->
+                  case fromDynamic dyn of
+                    Just (b :: Bool) -> B b
+                    Nothing ->
+                      case fromDynamic dyn of
+                        Just (a, b) -> E a b
+                        Nothing -> Invalid
+
+toVariant :: Dynamic -> Variant
+toVariant dyn =
+  case tag dyn of
+    I32 i -> variant i
+    W32 w -> variant w
+    S   s -> variant s
+    A arr -> variant (map toVariant arr)
+    B   b -> variant (if b then (1 :: Int32) else 0)
+    E a b -> variant (map toVariant a, map toVariant b)
+    Invalid -> variant "<invalid>"
+
+variantArgs msg = do
+  (args :: [Dynamic]) <- DBus.Message.args msg
+  return $ map toVariant args
+
+{-
+variantArgs msg =
+  let load msg =
+        do args <- DBus.Message.args msg;
+           return args
+      try cmp els =
+        catch (do val <- cmp
+                  return $ DBus.Message.variant val)
+              (\err -> els)
+  in try ((load msg) :: IO [Dynamic]) $
+     try ((load msg) :: IO Int32) $
+     try ((load msg) :: IO Word32) $
+     try ((load msg) :: IO String) $
+     try ((load msg) :: IO ()) $
+     try ((load msg) :: IO [Int32]) $
+     try ((load msg) :: IO [Word32]) $
+     try ((load msg) :: IO [String]) $
+     try ((load msg) :: IO [()]) $
+     try ((load msg) :: IO NotifyArgs) $
+     try ((load msg) :: IO Variant)
+         (putStr "variantArgs failed\n" >> fail "Cannot figure out the type\n")
+-}
+
+{-
+snoop :: Arg a => DBus.Message.Message -> IO a
+snoop msg = do
+  args <- DBus.Message.args msg
+  print (DBus.Message.variant args)
+  return args
+
+eat :: IO a -> IO ()
+eat cmp = cmp >> return ()
+
+try :: IO a -> IO () -> IO ()
+try cmp els =
+  catch (eat cmp) (\err -> els)
+-}
diff --git a/doc-prologue.txt b/doc-prologue.txt
new file mode 100644
--- /dev/null
+++ b/doc-prologue.txt
@@ -0,0 +1,12 @@
+See the HDBus home page (<http://neugierig.org/software/hdbus/>) for details.
+
+This documentation assumes you already know how the D-Bus API works.
+
+* See the D-Bus wiki
+  (<http://www.freedesktop.org/wiki/Software/dbus>) for an overview.
+
+* See the D-Bus low-level API tutorial
+  (<http://www.matthew.ath.cx/misc/dbus>) for more detail.
+
+* See the D-Bus API reference
+ (<http://dbus.freedesktop.org/doc/api/html/>) for per-function documentation.