{-# LINE 1 "hs/DBus/Types/Internal.cpphs" #-}# 1 "hs/DBus/Types/Internal.cpphs"# 1 "<built-in>"# 1 "<command-line>"# 10 "<command-line>"# 1 "./dist/build/autogen/cabal_macros.h" 1# 10 "<command-line>" 2# 1 "hs/DBus/Types/Internal.cpphs"-- 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/>.{-# LANGUAGE OverloadedStrings #-}{-# LANGUAGE TypeSynonymInstances #-}moduleDBus.Types.InternalwhereimportData.Text.Lazy(Text)importqualifiedData.Text.LazyasTLimportData.Word(Word8,Word16,Word32,Word64)importData.Int(Int16,Int32,Int64)importqualifiedData.TextasTimportData.Ord(comparing)importData.Text.Encoding(decodeUtf8)importqualifiedData.ByteString.UnsafeasBimportqualifiedForeignasFimportSystem.IO.Unsafe(unsafePerformIO)importData.Text.Lazy.Encoding(encodeUtf8)importDBus.Util(mkUnsafe)importqualifiedData.StringasStringimportText.ParserCombinators.Parsec((<|>))importqualifiedText.ParserCombinators.ParsecasPimportDBus.Util(checkLength,parseMaybe)importData.List(intercalate)importControl.Monad(unless)importControl.Arrow((***))importqualifiedData.MapasMapimportControl.Monad(forM)importqualifiedData.ByteStringasBimportqualifiedData.ByteString.Char8asB8importqualifiedData.ByteString.LazyasBLimportqualifiedData.ByteString.Char8asBL8dataType=DBusBoolean|DBusByte|DBusInt16|DBusInt32|DBusInt64|DBusWord16|DBusWord32|DBusWord64|DBusDouble|DBusString|DBusSignature|DBusObjectPath|DBusVariant|DBusArrayType|DBusDictionaryTypeType|DBusStructure[Type]deriving(Show,Eq)-- | \"Atomic\" types are any which can't contain any other types. Only-- atomic types may be used as dictionary keys.isAtomicType::Type->BoolisAtomicTypeDBusBoolean=TrueisAtomicTypeDBusByte=TrueisAtomicTypeDBusInt16=TrueisAtomicTypeDBusInt32=TrueisAtomicTypeDBusInt64=TrueisAtomicTypeDBusWord16=TrueisAtomicTypeDBusWord32=TrueisAtomicTypeDBusWord64=TrueisAtomicTypeDBusDouble=TrueisAtomicTypeDBusString=TrueisAtomicTypeDBusSignature=TrueisAtomicTypeDBusObjectPath=TrueisAtomicType_=False-- | Every type has an associated type code; a textual representation of-- the type, useful for debugging.typeCode::Type->TexttypeCodet=TL.fromChunks[decodeUtf8$typeCodeBt]typeCodeB::Type->B.ByteStringtypeCodeBDBusBoolean="b"typeCodeBDBusByte="y"typeCodeBDBusInt16="n"typeCodeBDBusInt32="i"typeCodeBDBusInt64="x"typeCodeBDBusWord16="q"typeCodeBDBusWord32="u"typeCodeBDBusWord64="t"typeCodeBDBusDouble="d"typeCodeBDBusString="s"typeCodeBDBusSignature="g"typeCodeBDBusObjectPath="o"typeCodeBDBusVariant="v"typeCodeB(DBusArrayt)=B8.cons'a'$typeCodeBttypeCodeB(DBusDictionarykv)=B.concat["a{",typeCodeBk,typeCodeBv,"}"]typeCodeB(DBusStructurets)=B.concat$["("]++maptypeCodeBts++[")"]-- | 'Variant's may contain any other built-in D-Bus value. Besides-- representing native @VARIANT@ values, they allow type-safe storage and-- deconstruction of heterogeneous collections.dataVariant=VarBoxBoolBool|VarBoxWord8Word8|VarBoxInt16Int16|VarBoxInt32Int32|VarBoxInt64Int64|VarBoxWord16Word16|VarBoxWord32Word32|VarBoxWord64Word64|VarBoxDoubleDouble|VarBoxStringText|VarBoxSignatureSignature|VarBoxObjectPathObjectPath|VarBoxVariantVariant|VarBoxArrayArray|VarBoxDictionaryDictionary|VarBoxStructureStructurederiving(Eq)classVariableawheretoVariant::a->VariantfromVariant::Variant->MaybeainstanceShowVariantwhereshowsPrecdvar=showParen(d>10)fullwherefull=s"Variant ".showscode.s" ".valueStrcode=typeCode$variantTypevars=showStringvalueStr=showsPrecVar11varshowsPrecVar::Int->Variant->ShowSshowsPrecVardvar=casevarof(VarBoxBoolx)->showsPrecdx(VarBoxWord8x)->showsPrecdx(VarBoxInt16x)->showsPrecdx(VarBoxInt32x)->showsPrecdx(VarBoxInt64x)->showsPrecdx(VarBoxWord16x)->showsPrecdx(VarBoxWord32x)->showsPrecdx(VarBoxWord64x)->showsPrecdx(VarBoxDoublex)->showsPrecdx(VarBoxStringx)->showsPrecdx(VarBoxSignaturex)->showsPrecdx(VarBoxObjectPathx)->showsPrecdx(VarBoxVariantx)->showsPrecdx(VarBoxArrayx)->showsPrecdx(VarBoxDictionaryx)->showsPrecdx(VarBoxStructurex)->showsPrecdx-- | Every variant is strongly-typed; that is, the type of its contained-- value is known at all times. This function retrieves that type, so that-- the correct cast can be used to retrieve the value.variantType::Variant->TypevariantTypevar=casevarof(VarBoxBool_)->DBusBoolean(VarBoxWord8_)->DBusByte(VarBoxInt16_)->DBusInt16(VarBoxInt32_)->DBusInt32(VarBoxInt64_)->DBusInt64(VarBoxWord16_)->DBusWord16(VarBoxWord32_)->DBusWord32(VarBoxWord64_)->DBusWord64(VarBoxDouble_)->DBusDouble(VarBoxString_)->DBusString(VarBoxSignature_)->DBusSignature(VarBoxObjectPath_)->DBusObjectPath(VarBoxVariant_)->DBusVariant(VarBoxArrayx)->DBusArray(arrayTypex)(VarBoxDictionaryx)->letkeyT=dictionaryKeyTypexvalueT=dictionaryValueTypexinDBusDictionarykeyTvalueT(VarBoxStructurex)->letStructureitems=xinDBusStructure(mapvariantTypeitems)variantSignature::Variant->MaybeSignaturevariantSignature=mkBytesSignature.typeCodeB.variantTypeinstanceVariableVariantwhere{toVariant=VarBoxVariant;fromVariant(VarBoxVariantx)=Justx;fromVariant_=Nothing}instanceVariableBoolwhere{toVariant=VarBoxBool;fromVariant(VarBoxBoolx)=Justx;fromVariant_=Nothing}instanceVariableWord8where{toVariant=VarBoxWord8;fromVariant(VarBoxWord8x)=Justx;fromVariant_=Nothing}instanceVariableInt16where{toVariant=VarBoxInt16;fromVariant(VarBoxInt16x)=Justx;fromVariant_=Nothing}instanceVariableInt32where{toVariant=VarBoxInt32;fromVariant(VarBoxInt32x)=Justx;fromVariant_=Nothing}instanceVariableInt64where{toVariant=VarBoxInt64;fromVariant(VarBoxInt64x)=Justx;fromVariant_=Nothing}instanceVariableWord16where{toVariant=VarBoxWord16;fromVariant(VarBoxWord16x)=Justx;fromVariant_=Nothing}instanceVariableWord32where{toVariant=VarBoxWord32;fromVariant(VarBoxWord32x)=Justx;fromVariant_=Nothing}instanceVariableWord64where{toVariant=VarBoxWord64;fromVariant(VarBoxWord64x)=Justx;fromVariant_=Nothing}instanceVariableDoublewhere{toVariant=VarBoxDouble;fromVariant(VarBoxDoublex)=Justx;fromVariant_=Nothing}instanceVariableTL.TextwheretoVariant=VarBoxStringfromVariant(VarBoxStringx)=JustxfromVariant_=NothinginstanceVariableT.TextwheretoVariant=toVariant.TL.fromChunks.(:[])fromVariant=fmap(T.concat.TL.toChunks).fromVariantinstanceVariableStringwheretoVariant=toVariant.TL.packfromVariant=fmapTL.unpack.fromVariantinstanceVariableSignaturewhere{toVariant=VarBoxSignature;fromVariant(VarBoxSignaturex)=Justx;fromVariant_=Nothing}dataSignature=Signature{signatureTypes::[Type]}deriving(Eq)instanceShowSignaturewhereshowsPrecdx=showParen(d>10)$showString"Signature ".shows(strSignaturex)bytesSignature::Signature->B.ByteStringbytesSignature(Signaturets)=B.concat$maptypeCodeBtsstrSignature::Signature->TextstrSignature(Signaturets)=TL.concat$maptypeCodetsinstanceOrdSignaturewherecompare=comparingstrSignaturemkBytesSignature::B.ByteString->MaybeSignaturemkBytesSignature=unsafePerformIO.flipB.unsafeUseAsCStringLeniowhereparseAtomcyesno=casecof0x62->yesDBusBoolean0x79->yesDBusByte0x6E->yesDBusInt160x69->yesDBusInt320x78->yesDBusInt640x71->yesDBusWord160x75->yesDBusWord320x74->yesDBusWord640x64->yesDBusDouble0x73->yesDBusString0x67->yesDBusSignature0x6F->yesDBusObjectPath_->nofastc=parseAtomc(\t->Just(Signature[t]))$casecof0x76->Just(Signature[DBusVariant])_->Nothingslow::F.PtrWord8->Int->IO(MaybeSignature)slowbuflen=loop[]0whereloopaccii|ii>=len=return.Just.Signature$reverseaccloopaccii=doc<-F.peekElemOffbufiiletnextt=loop(t:acc)(ii+1)parseAtomcnext$casecof0x76->nextDBusVariant-- '('0x28->domt<-structurebuflen(ii+1)casemtofJust(ii',t)->loop(t:acc)ii'Nothing->returnNothing-- 'a'0x61->domt<-arraybuflen(ii+1)casemtofJust(ii',t)->loop(t:acc)ii'Nothing->returnNothing_->returnNothingstructure::F.PtrWord8->Int->Int->IO(Maybe(Int,Type))structurebuflen=loop[]whereloop_ii|ii>=len=returnNothingloopaccii=doc<-F.peekElemOffbufiiletnextt=loop(t:acc)(ii+1)parseAtomcnext$casecof0x76->nextDBusVariant-- '('0x28->domt<-structurebuflen(ii+1)casemtofJust(ii',t)->loop(t:acc)ii'Nothing->returnNothing-- ')'0x29->return$Just$(ii+1,DBusStructure(reverseacc))-- 'a'0x61->domt<-arraybuflen(ii+1)casemtofJust(ii',t)->loop(t:acc)ii'Nothing->returnNothing_->returnNothingarray::F.PtrWord8->Int->Int->IO(Maybe(Int,Type))array_lenii|ii>=len=returnNothingarraybuflenii=doc<-F.peekElemOffbufiiletnextt=return$Just(ii+1,DBusArrayt)parseAtomcnext$casecof0x76->nextDBusVariant-- '('0x28->domt<-structurebuflen(ii+1)casemtofJust(ii',t)->return$Just(ii',DBusArrayt)Nothing->returnNothing-- '{'0x7B->dictbuflen(ii+1)-- 'a'0x61->domt<-arraybuflen(ii+1)casemtofJust(ii',t)->return$Just(ii',DBusArrayt)Nothing->returnNothing_->returnNothingdict::F.PtrWord8->Int->Int->IO(Maybe(Int,Type))dict_lenii|ii+1>=len=returnNothingdictbuflenii=doc1<-F.peekElemOffbufiic2<-F.peekElemOffbuf(ii+1)letmt1=parseAtomc1JustNothingletnextt=return$Just(ii+2,t)mt2<-parseAtomc2next$casec2of0x76->nextDBusVariant-- '('0x28->structurebuflen(ii+2)-- 'a'0x61->arraybuflen(ii+2)_->returnNothingcasemt2ofNothing->returnNothingJust(ii',t2)->ifii'>=lenthenreturnNothingelsedoc3<-F.peekElemOffbufii'return$doifc3==0x7DthenJust()elseNothingt1<-mt1Just(ii'+1,DBusDictionaryt1t2)io(cstr,len)=caselenof0->return$Just$Signature[]1->fmapfast$F.peekcstr_|len<=255->slow(F.castPtrcstr)len_->returnNothingmkSignature::Text->MaybeSignaturemkSignature=mkBytesSignature.B.concat.BL.toChunks.encodeUtf8mkSignature_::Text->SignaturemkSignature_=mkUnsafe"signature"mkSignatureinstanceString.IsStringSignaturewherefromString=mkUnsafe"signature"mkBytesSignature.BL8.packmaybeValidType::Type->Maybe()maybeValidTypet=ifB.length(typeCodeBt)>255thenNothingelseJust()instanceVariableObjectPathwhere{toVariant=VarBoxObjectPath;fromVariant(VarBoxObjectPathx)=Justx;fromVariant_=Nothing}newtypeObjectPath=ObjectPath{strObjectPath::Text}deriving(Eq,Ord)instanceShowObjectPathwhereshowsPrecd(ObjectPathx)=showParen(d>10)$showString"ObjectPath ".showsxinstanceString.IsStringObjectPathwherefromString=mkObjectPath_.TL.packmkObjectPath::Text->MaybeObjectPathmkObjectPaths=parseMaybepath'(TL.unpacks)wherec=P.oneOf$['a'..'z']++['A'..'Z']++['0'..'9']++"_"path=P.char'/'>>=P.optional.P.sepBy(P.many1c).P.charpath'=path>>P.eof>>return(ObjectPaths)mkObjectPath_::Text->ObjectPathmkObjectPath_=mkUnsafe"object path"mkObjectPathinstanceVariableArraywhere{toVariant=VarBoxArray;fromVariant(VarBoxArrayx)=Justx;fromVariant_=Nothing}dataArray=VariantArrayType[Variant]|ByteArrayBL.ByteStringderiving(Eq)-- | This is the type contained within the array, not the type of the array-- itself.arrayType::Array->TypearrayType(VariantArrayt_)=tarrayType(ByteArray_)=DBusBytearrayItems::Array->[Variant]arrayItems(VariantArray_xs)=xsarrayItems(ByteArrayxs)=maptoVariant$BL.unpackxsinstanceShowArraywhereshowsPrecdarray=showParen(d>10)$s"Array ".showSig.s" [".svalueString.s"]"wheres=showStringshowSig=shows.typeCode.arrayType$arrayshowVarvar=showsPrecVar0var""valueString=intercalate", "$mapshowVar$arrayItemsarrayarrayFromItems::Type->[Variant]->MaybeArrayarrayFromItemsDBusBytevs=fmap(ByteArray.BL.pack)(mapMfromVariantvs)arrayFromItemstvs=domaybeValidTypetifall(\x->variantTypex==t)vsthenJust$VariantArraytvselseNothingtoArray::Variablea=>Type->[a]->MaybeArraytoArrayt=arrayFromItemst.maptoVariantfromArray::Variablea=>Array->Maybe[a]fromArray=mapMfromVariant.arrayItemsarrayToBytes::Array->MaybeBL.ByteStringarrayToBytes(ByteArrayx)=JustxarrayToBytes_=NothingarrayFromBytes::BL.ByteString->ArrayarrayFromBytes=ByteArrayinstanceVariableBL.ByteStringwheretoVariant=toVariant.arrayFromBytesfromVariantx=fromVariantx>>=arrayToBytesinstanceVariableB.ByteStringwheretoVariantx=toVariant.arrayFromBytes$BL.fromChunks[x]fromVariant=fmap(B.concat.BL.toChunks).fromVariantinstanceVariableDictionarywhere{toVariant=VarBoxDictionary;fromVariant(VarBoxDictionaryx)=Justx;fromVariant_=Nothing}dataDictionary=Dictionary{dictionaryKeyType::Type,dictionaryValueType::Type,dictionaryItems::[(Variant,Variant)]}deriving(Eq)instanceShowDictionarywhereshowsPrecd(Dictionaryktvtpairs)=showParen(d>10)$s"Dictionary ".showSig.s" {".svalueString.s"}"wheres=showStringshowSig=shows$TL.append(typeCodekt)(typeCodevt)valueString=intercalate", "$mapshowPairpairsshowPair(k,v)=(showsPrecVar0k.showString" -> ".showsPrecVar0v)""dictionaryFromItems::Type->Type->[(Variant,Variant)]->MaybeDictionarydictionaryFromItemsktvtpairs=dounless(isAtomicTypekt)NothingmaybeValidTypektmaybeValidTypevtletsameType(k,v)=variantTypek==kt&&variantTypev==vtifallsameTypepairsthenJust$DictionaryktvtpairselseNothingtoDictionary::(Variablea,Variableb)=>Type->Type->Map.Mapab->MaybeDictionarytoDictionaryktvt=dictionaryFromItemsktvt.pairswherepairs=map(toVariant***toVariant).Map.toListfromDictionary::(Variablea,Orda,Variableb)=>Dictionary->Maybe(Map.Mapab)fromDictionary(Dictionary__vs)=dopairs<-forMvs$\(k,v)->dok'<-fromVariantkv'<-fromVariantvreturn(k',v')return$Map.fromListpairsdictionaryToArray::Dictionary->ArraydictionaryToArray(Dictionaryktvtitems)=arraywhereJustarray=toArrayitemTypestructsitemType=DBusStructure[kt,vt]structs=[Structure[k,v]|(k,v)<-items]arrayToDictionary::Array->MaybeDictionaryarrayToDictionaryarray=dolettoPairx=dostruct<-fromVariantxcasestructofStructure[k,v]->Just(k,v)_->Nothing(kt,vt)<-casearrayTypearrayofDBusStructure[kt,vt]->Just(kt,vt)_->Nothingpairs<-mapMtoPair$arrayItemsarraydictionaryFromItemsktvtpairsinstanceVariableStructurewhere{toVariant=VarBoxStructure;fromVariant(VarBoxStructurex)=Justx;fromVariant_=Nothing}dataStructure=Structure[Variant]deriving(Show,Eq)# 587 "hs/DBus/Types/Internal.cpphs"newtypeBusName=BusName{strBusName::Text}deriving(Eq,Ord);instanceShowBusNamewhere{showsPrecd(BusNamex)=showParen(d>10)$showString"BusName ".showsx};instanceString.IsStringBusNamewhere{fromString=mkBusName_.TL.pack};instanceVariableBusNamewhere{toVariant=toVariant.strBusName;fromVariant=(mkBusName=<<).fromVariant};mkBusName_::Text->BusName;mkBusName_=mkUnsafe"bus name"mkBusNamemkBusName::Text->MaybeBusNamemkBusNames=checkLength255(TL.unpacks)>>=parseMaybeparserwherec=['a'..'z']++['A'..'Z']++"_-"c'=c++['0'..'9']parser=(unique<|>wellKnown)>>P.eof>>return(BusNames)unique=P.char':'>>elemsc'wellKnown=elemscelemsstart=elem'start>>P.many1(P.char'.'>>elem'start)elem'start=P.oneOfstart>>P.many(P.oneOfc')newtypeInterfaceName=InterfaceName{strInterfaceName::Text}deriving(Eq,Ord);instanceShowInterfaceNamewhere{showsPrecd(InterfaceNamex)=showParen(d>10)$showString"InterfaceName ".showsx};instanceString.IsStringInterfaceNamewhere{fromString=mkInterfaceName_.TL.pack};instanceVariableInterfaceNamewhere{toVariant=toVariant.strInterfaceName;fromVariant=(mkInterfaceName=<<).fromVariant};mkInterfaceName_::Text->InterfaceName;mkInterfaceName_=mkUnsafe"interface name"mkInterfaceNamemkInterfaceName::Text->MaybeInterfaceNamemkInterfaceNames=checkLength255(TL.unpacks)>>=parseMaybeparserwherec=['a'..'z']++['A'..'Z']++"_"c'=c++['0'..'9']element=P.oneOfc>>P.many(P.oneOfc')name=element>>P.many1(P.char'.'>>element)parser=name>>P.eof>>return(InterfaceNames)newtypeErrorName=ErrorName{strErrorName::Text}deriving(Eq,Ord);instanceShowErrorNamewhere{showsPrecd(ErrorNamex)=showParen(d>10)$showString"ErrorName ".showsx};instanceString.IsStringErrorNamewhere{fromString=mkErrorName_.TL.pack};instanceVariableErrorNamewhere{toVariant=toVariant.strErrorName;fromVariant=(mkErrorName=<<).fromVariant};mkErrorName_::Text->ErrorName;mkErrorName_=mkUnsafe"error name"mkErrorNamemkErrorName::Text->MaybeErrorNamemkErrorName=fmap(ErrorName.strInterfaceName).mkInterfaceNamenewtypeMemberName=MemberName{strMemberName::Text}deriving(Eq,Ord);instanceShowMemberNamewhere{showsPrecd(MemberNamex)=showParen(d>10)$showString"MemberName ".showsx};instanceString.IsStringMemberNamewhere{fromString=mkMemberName_.TL.pack};instanceVariableMemberNamewhere{toVariant=toVariant.strMemberName;fromVariant=(mkMemberName=<<).fromVariant};mkMemberName_::Text->MemberName;mkMemberName_=mkUnsafe"member name"mkMemberNamemkMemberName::Text->MaybeMemberNamemkMemberNames=checkLength255(TL.unpacks)>>=parseMaybeparserwherec=['a'..'z']++['A'..'Z']++"_"c'=c++['0'..'9']name=P.oneOfc>>P.many(P.oneOfc')parser=name>>P.eof>>return(MemberNames)