#line 22 "src/name-reservation.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 23 "src/name-reservation.anansi"
{-# LANGUAGE OverloadedStrings #-}
module DBus.NameReservation
	( RequestNameFlag (..)
	, RequestNameReply (..)
	, ReleaseNameReply (..)
	, requestName
	, releaseName
	, mkRequestNameReply
	, mkReleaseNameReply
	) where
import Data.Word (Word32)
import Data.Bits ((.|.))
import qualified Data.Set as Set
import qualified DBus.Types as T
import qualified DBus.Message as M
import qualified DBus.Constants as C
import DBus.Util (maybeIndex)

#line 43 "src/name-reservation.anansi"
data RequestNameFlag
	= AllowReplacement
	| ReplaceExisting
	| DoNotQueue
	deriving (Show)

#line 51 "src/name-reservation.anansi"
encodeFlags :: [RequestNameFlag] -> Word32
encodeFlags = foldr (.|.) 0 . map flagValue where
	flagValue AllowReplacement = 0x1
	flagValue ReplaceExisting  = 0x2
	flagValue DoNotQueue       = 0x4

#line 62 "src/name-reservation.anansi"

#line 144 "src/api-docs.anansi"
-- | Build a 'M.MethodCall' for requesting a registered bus name.

#line 63 "src/name-reservation.anansi"
requestName :: T.BusName -> [RequestNameFlag] -> M.MethodCall
requestName name flags = M.MethodCall
	{ M.methodCallPath = C.dbusPath
	, M.methodCallInterface = Just C.dbusInterface
	, M.methodCallDestination = Just C.dbusName
	, M.methodCallFlags = Set.empty
	, M.methodCallMember = "RequestName"
	, M.methodCallBody =
		[ T.toVariant name
		, T.toVariant . encodeFlags $ flags]
	}

#line 77 "src/name-reservation.anansi"
data RequestNameReply
	= PrimaryOwner
	| InQueue
	| Exists
	| AlreadyOwner
	deriving (Show)

#line 86 "src/name-reservation.anansi"
mkRequestNameReply :: M.MethodReturn -> Maybe RequestNameReply
mkRequestNameReply msg =
	maybeIndex (M.messageBody msg) 0 >>=
	T.fromVariant >>=
	decodeRequestReply

#line 94 "src/name-reservation.anansi"
decodeRequestReply :: Word32 -> Maybe RequestNameReply
decodeRequestReply 1 = Just PrimaryOwner
decodeRequestReply 2 = Just InQueue
decodeRequestReply 3 = Just Exists
decodeRequestReply 4 = Just AlreadyOwner
decodeRequestReply _ = Nothing

#line 103 "src/name-reservation.anansi"

#line 148 "src/api-docs.anansi"
-- | Build a 'M.MethodCall' for releasing a registered bus name.

#line 104 "src/name-reservation.anansi"
releaseName :: T.BusName -> M.MethodCall
releaseName name = M.MethodCall
	{ M.methodCallPath = C.dbusPath
	, M.methodCallInterface = Just C.dbusInterface
	, M.methodCallDestination = Just C.dbusName
	, M.methodCallFlags = Set.empty
	, M.methodCallMember = "ReleaseName"
	, M.methodCallBody = [T.toVariant name]
	}

#line 116 "src/name-reservation.anansi"
data ReleaseNameReply
	= Released
	| NonExistent
	| NotOwner
	deriving (Show)

#line 124 "src/name-reservation.anansi"
mkReleaseNameReply :: M.MethodReturn -> Maybe ReleaseNameReply
mkReleaseNameReply msg =
	maybeIndex (M.messageBody msg) 0 >>=
	T.fromVariant >>=
	decodeReleaseReply

#line 132 "src/name-reservation.anansi"
decodeReleaseReply :: Word32 -> Maybe ReleaseNameReply
decodeReleaseReply 1 = Just Released
decodeReleaseReply 2 = Just NonExistent
decodeReleaseReply 3 = Just NotOwner
decodeReleaseReply _ = Nothing