#line 31 "src/messages.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/messages.anansi"

#line 52 "src/introduction.anansi"
{-# LANGUAGE OverloadedStrings #-}

#line 33 "src/messages.anansi"
module DBus.Message.Internal where

#line 56 "src/introduction.anansi"
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as TL

#line 35 "src/messages.anansi"
import qualified Data.Set as S
import Data.Word (Word8, Word32)
import Data.Maybe (fromMaybe)
import qualified DBus.Types as T
import DBus.Util (maybeIndex)

#line 43 "src/messages.anansi"
class Message a where
	messageTypeCode     :: a -> Word8
	messageHeaderFields :: a -> [HeaderField]
	messageFlags        :: a -> S.Set Flag
	messageBody         :: a -> [T.Variant]

#line 62 "src/messages.anansi"
data Flag
	= NoReplyExpected
	| NoAutoStart
	deriving (Show, Eq, Ord)

#line 80 "src/messages.anansi"
data HeaderField
	= Path        T.ObjectPath
	| Interface   T.InterfaceName
	| Member      T.MemberName
	| ErrorName   T.ErrorName
	| ReplySerial Serial
	| Destination T.BusName
	| Sender      T.BusName
	| Signature   T.Signature
	deriving (Show, Eq)

#line 98 "src/messages.anansi"

#line 152 "src/api-docs.anansi"
-- | A value used to uniquely identify a particular message within a session.
-- 'Serial's are 32-bit unsigned integers, and eventually wrap.

#line 99 "src/messages.anansi"
newtype Serial = Serial { serialValue :: Word32 }
	deriving (Eq, Ord)

instance Show Serial where
	show (Serial x) = show x

instance T.Variable Serial where
	toVariant (Serial x) = T.toVariant x
	fromVariant = fmap Serial . T.fromVariant

#line 113 "src/messages.anansi"
firstSerial :: Serial
firstSerial = Serial 1

nextSerial :: Serial -> Serial
nextSerial (Serial x) = Serial (x + 1)

#line 138 "src/messages.anansi"
maybe' :: (a -> b) -> Maybe a -> [b]
maybe' f = maybe [] (\x' -> [f x'])

#line 145 "src/messages.anansi"
data MethodCall = MethodCall
	{ methodCallPath        :: T.ObjectPath
	, methodCallMember      :: T.MemberName
	, methodCallInterface   :: Maybe T.InterfaceName
	, methodCallDestination :: Maybe T.BusName
	, methodCallFlags       :: S.Set Flag
	, methodCallBody        :: [T.Variant]
	}
	deriving (Show, Eq)

instance Message MethodCall where
	messageTypeCode _ = 1
	messageFlags      = methodCallFlags
	messageBody       = methodCallBody
	messageHeaderFields m = concat
		[ [ Path    $ methodCallPath m
		  ,  Member $ methodCallMember m
		  ]
		, maybe' Interface . methodCallInterface $ m
		, maybe' Destination . methodCallDestination $ m
		]

#line 187 "src/messages.anansi"
data MethodReturn = MethodReturn
	{ methodReturnSerial      :: Serial
	, methodReturnDestination :: Maybe T.BusName
	, methodReturnBody        :: [T.Variant]
	}
	deriving (Show, Eq)

instance Message MethodReturn where
	messageTypeCode _ = 2
	messageFlags    _ = S.fromList [NoReplyExpected, NoAutoStart]
	messageBody       = methodReturnBody
	messageHeaderFields m = concat
		[ [ ReplySerial $ methodReturnSerial m
		  ]
		, maybe' Destination . methodReturnDestination $ m
		]

#line 221 "src/messages.anansi"
data Error = Error
	{ errorName        :: T.ErrorName
	, errorSerial      :: Serial
	, errorDestination :: Maybe T.BusName
	, errorBody        :: [T.Variant]
	}
	deriving (Show, Eq)

instance Message Error where
	messageTypeCode _ = 3
	messageFlags    _ = S.fromList [NoReplyExpected, NoAutoStart]
	messageBody       = errorBody
	messageHeaderFields m = concat
		[ [ ErrorName   $ errorName m
		  , ReplySerial $ errorSerial m
		  ]
		, maybe' Destination . errorDestination $ m
		]

#line 246 "src/messages.anansi"
errorMessage :: Error -> Text
errorMessage msg = fromMaybe "(no error message)" $ do
	field <- maybeIndex (errorBody msg) 0
	text <- T.fromVariant field
	if TL.null text
		then Nothing
		else return text

#line 273 "src/messages.anansi"
data Signal = Signal
	{ signalPath        :: T.ObjectPath
	, signalMember      :: T.MemberName
	, signalInterface   :: T.InterfaceName
	, signalDestination :: Maybe T.BusName
	, signalBody        :: [T.Variant]
	}
	deriving (Show, Eq)

instance Message Signal where
	messageTypeCode _ = 4
	messageFlags    _ = S.fromList [NoReplyExpected, NoAutoStart]
	messageBody       = signalBody
	messageHeaderFields m = concat
		[ [ Path      $ signalPath m
		  , Member    $ signalMember m
		  , Interface $ signalInterface m
		  ]
		, maybe' Destination . signalDestination $ m
		]

#line 318 "src/messages.anansi"
data Unknown = Unknown
	{ unknownType    :: Word8
	, unknownFlags   :: S.Set Flag
	, unknownBody    :: [T.Variant]
	}
	deriving (Show, Eq)

#line 339 "src/messages.anansi"

#line 157 "src/api-docs.anansi"
-- | Not an actual message type, but a wrapper around messages received from
-- the bus. Each value contains the message's 'Serial' and possibly the
-- origin's 'T.BusName'

#line 340 "src/messages.anansi"
data ReceivedMessage
	= ReceivedMethodCall   Serial (Maybe T.BusName) MethodCall
	| ReceivedMethodReturn Serial (Maybe T.BusName) MethodReturn
	| ReceivedError        Serial (Maybe T.BusName) Error
	| ReceivedSignal       Serial (Maybe T.BusName) Signal
	| ReceivedUnknown      Serial (Maybe T.BusName) Unknown
	deriving (Show, Eq)

#line 350 "src/messages.anansi"
receivedSerial :: ReceivedMessage -> Serial
receivedSerial (ReceivedMethodCall   s _ _) = s
receivedSerial (ReceivedMethodReturn s _ _) = s
receivedSerial (ReceivedError        s _ _) = s
receivedSerial (ReceivedSignal       s _ _) = s
receivedSerial (ReceivedUnknown      s _ _) = s

#line 359 "src/messages.anansi"
receivedSender :: ReceivedMessage -> Maybe T.BusName
receivedSender (ReceivedMethodCall   _ s _) = s
receivedSender (ReceivedMethodReturn _ s _) = s
receivedSender (ReceivedError        _ s _) = s
receivedSender (ReceivedSignal       _ s _) = s
receivedSender (ReceivedUnknown      _ s _) = s

#line 368 "src/messages.anansi"
receivedBody :: ReceivedMessage -> [T.Variant]
receivedBody (ReceivedMethodCall   _ _ x) = messageBody x
receivedBody (ReceivedMethodReturn _ _ x) = messageBody x
receivedBody (ReceivedError        _ _ x) = messageBody x
receivedBody (ReceivedSignal       _ _ x) = messageBody x
receivedBody (ReceivedUnknown      _ _ x) = unknownBody x