{-# LANGUAGE MultiParamTypeClasses,TypeSynonymInstances,FlexibleInstances,DeriveDataTypeable #-}-- | This modules colelct utility routines related to the different-- incarnations of identifiers in the code. The basic identifier is-- always ASCII, but because of the self generated DescriptorProto-- data structures it is stored in 'Utf8' tagged lazy bytestrings.---- An 'identifier' is a non-empty ASCII string made of [a-zA-Z0-9_]-- where the first character is never in [0-9].---- A 'field' is a mangled identifer that is a valid Haskell name that-- begins with lower case, and which may have a single quote at the-- end if needed to avoid a reserved word. These may also start with-- '_', though just a "_" is mangled to "_'".---- A 'module' is a mangled identifier that is a valid Haskell name-- that begins with upper case. These never have a single quote. A-- leading '_' is replaced with a leading "U'_" to make a valid-- identifier.moduleText.ProtocolBuffers.Identifiers(unull,toString,fromString,IName(..),DIName(..),FIName(..),MName(..),FMName(..),PMName(..),FName(..),FFName(..),PFName(..),Dotted(..),Mangle(..),joinPM,joinPF,difi,splitDI,splitFI,splitFM,checkDIString,checkDIUtf8,promoteDI,promoteFI,promoteFM,promoteFF,dotFM,dotFF,fqAppend)whereimportqualifiedData.ByteString.Lazy.Char8asLCimportqualifiedData.ByteString.Lazy.UTF8asUimportData.CharimportData.ListimportData.MonoidimportData.Generics(Data)importData.Typeable(Typeable)importData.Set(Set)importqualifiedData.SetasSimportText.ProtocolBuffers.Basic-- basic utilities to exportunull::Utf8->Boolunull=LC.null.utf8toString::Utf8->StringtoString=U.toString.utf8fromString::String->Utf8fromString=Utf8.U.fromString-- | Contains one identifier namenewtypeINamea=IName{iName::a}deriving(Data,Typeable,Eq,Ord)-- | Contains one module name, non-emptynewtypeMNamea=MName{mName::a}deriving(Data,Typeable,Eq,Ord)-- | Contains one field name, non-emptynewtypeFNamea=FName{fName::a}deriving(Data,Typeable,Eq,Ord)-- | '.' separated identifier which may or may start with a dot. There-- are never two or more '.'s in a row. There is always at least one identifier.newtypeDINamea=DIName{diName::a}deriving(Data,Typeable,Eq,Ord)-- | Fully qualified identifier: repeated ('.' then identifier)newtypeFINamea=FIName{fiName::a}deriving(Data,Typeable,Eq,Ord)-- | Full Haskell module name: MNames separated by '.', ending with a modulenewtypeFMNamea=FMName{fmName::a}deriving(Data,Typeable,Eq,Ord)-- | Full Haskell field name: MNames separated by '.', ending with a fieldnewtypeFFNamea=FFName{ffName::a}deriving(Data,Typeable,Eq,Ord)-- | Parsed Haskell name ending with MName. Good contructor to use.dataPMNamea=PMName[MNamea](MNamea)deriving(Show,Data,Typeable,Read,Eq,Ord)-- | Parsed Haskell name ending with FName. Good constructor to use.dataPFNamea=PFName[MNamea](FNamea)deriving(Show,Data,Typeable,Read,Eq,Ord)app_prec,max_prec::Intapp_prec=10max_prec=11{-# INLINE readIt #-}readIt::(Reada)=>(a->a1)->String->Int->String->[(a1,String)]readItconnamed=readParen(d>app_prec)(\r->[(conm,t)|(name',s)<-lexr,name==name',(m,t)<-readsPrecmax_precs]){-# INLINE showIt #-}showIt::(Showa)=>Int->[Char]->a->String->StringshowItdnamea=showParen(d>app_prec)$(name++).(' ':).showsPrecmax_precainstanceReada=>Read(INamea)wherereadsPrec=readItIName"IName"instanceReada=>Read(MNamea)wherereadsPrec=readItMName"MName"instanceReada=>Read(FNamea)wherereadsPrec=readItFName"FName"instanceReada=>Read(DINamea)wherereadsPrec=readItDIName"DIName"instanceReada=>Read(FINamea)wherereadsPrec=readItFIName"FIName"instanceReada=>Read(FFNamea)wherereadsPrec=readItFFName"FFName"instanceReada=>Read(FMNamea)wherereadsPrec=readItFMName"FMName"instanceShowa=>Show(INamea)whereshowsPrecd(INamea)=showItd"IName"ainstanceShowa=>Show(MNamea)whereshowsPrecd(MNamea)=showItd"MName"ainstanceShowa=>Show(FNamea)whereshowsPrecd(FNamea)=showItd"FName"ainstanceShowa=>Show(DINamea)whereshowsPrecd(DINamea)=showItd"DIName"ainstanceShowa=>Show(FINamea)whereshowsPrecd(FINamea)=showItd"FIName"ainstanceShowa=>Show(FMNamea)whereshowsPrecd(FMNamea)=showItd"FMName"ainstanceShowa=>Show(FFNamea)whereshowsPrecd(FFNamea)=showItd"FFName"a-- | This is used to abstract over Utf8 and String. The important-- entry point is 'validDI'.class(Monoida)=>Dottedawhereuncons::a->Maybe(Char,a)cons::Char->a->adot::a->a->avalidI::a->Maybe(INamea)-- | 'validDI' ensures the DIName is validDI::a->Maybe(DINamea)-- | 'split' returns a list of non-empty 'a' with all '.' characters removedsplit::a->[a]-- These are also part of the external API, they are abstracted over-- Dotted.joinPM::Dotteda=>PMNamea->FMNameajoinPM(PMNamexs(MNamex))=FMName(foldrdotx.mapmName$xs)joinPF::Dotteda=>PFNamea->FFNameajoinPF(PFNamexs(FNamex))=FFName(foldrdotx.mapmName$xs)-- | 'difi' examines the 'DIName' and prepend a '.' if absent, promoting-- it to a 'FIName'.difi::Dotteda=>DINamea->FINameadifi(DINamea)=caseunconsaofJust('.',_)->FINamea_->FIName(cons'.'a)-- | Typed 'split'splitDI::Dotteda=>DINamea->[INamea]splitDI=mapIName.split.diName-- | Typed 'split'splitFI::Dotteda=>FINamea->[INamea]splitFI=mapIName.split.fiName-- | Typed 'split'splitFM::Dotteda=>FMNamea->[MNamea]splitFM=mapMName.split.fmNamepromoteDI::Dotteda=>INamea->DINameapromoteDI=DIName.iNamepromoteFI::Dotteda=>INamea->FINameapromoteFI=FIName.cons'.'.iNamepromoteFM::Dotteda=>MNamea->FMNameapromoteFM=FMName.mNamepromoteFF::Dotteda=>FNamea->FFNameapromoteFF=FFName.fNamedotFM::Dotteda=>FMNamea->FMNamea->FMNameadotFM(FMNamea)(FMNameb)=FMName(a`dot`b)dotFF::Dotteda=>FMNamea->FFNamea->FFNameadotFF(FMNamea)(FFNameb)=FFName(a`dot`b)fqAppend::Dotteda=>FINamea->[INamea]->FINameafqAppend(FINamebase)xs=FIName(foldl'dotbase.mapiName$xs)-- The two checkDI* functions give better error messages than validDI-- | Right (True,_) means the input is a FIName.-- Right (False,_) means the input is a DIName (without leading '.')---- This creates useful error messages for the user.checkDIString::String->EitherString(Bool,[INameString])checkDIString""=Left$"Invalid empty identifier: "++show""checkDIString"."=Left$"Invalid identifier of just a period: "++show"."checkDIStringxs|('.':ys)<-xs=fmap((,)True)$partsid(span('.'/=)ys)|otherwise=fmap((,)False)$partsid(span('.'/=)xs)whereparts_f("","")=Left$"Invalid identifier because it ends with a period: "++showxsparts_f("",_)=Left$"Invalid identifier because is contains two periods in a row: "++showxspartsf(a,"")=Right(f[INamea])partsf(a,b)=parts(f.(INamea:))(span('.'/=)(tailb))-- | Right (True,_) means the input is a FIName.-- Right (False,_) means the input is a DIName (without leading '.')---- This creates useful error messages for the user.checkDIUtf8::Utf8->EitherString(Bool,[INameUtf8])checkDIUtf8s@(Utf8xs)=caseU.unconsxsofNothing->Left$"Invalid empty identifier: "++show""Just('.',ys)|LC.nullys->Left$"Invalid identifier of just a period: "++show"."|otherwise->fmap((,)True)$partsid(U.span('.'/=)ys)Just_->fmap((,)False)$partsid(U.span('.'/=)xs)wherepartsf(a,b)=case(LC.nulla,LC.nullb)of(True,True)->Left$"Invalid identifier because it ends with a period: "++show(toStrings)(True,_)->Left$"Invalid identifier because is contains two periods in a row: "++show(toStrings)(_,True)->Right(f[IName(Utf8a)])_->parts(f.(IName(Utf8a):))(U.span('.'/=)(U.drop1b))-- | The 'mangle' transformation has instances for several combiantions-- of input and output. These allow one to construct the Haskell types-- of MName/FMName/PMName and FName/FFName/PFName out of the protobuf-- types IName/DIName/FIName. Currently, all the Haskell instances-- are for the String base type.classMangleabwheremangle::a->binstanceMangle(INameString)(MNameString)wheremangle(INames)=MName(fixUps)instanceMangle(INameUtf8)(MNameString)wheremangle(INames)=MName(fixUp.toString$s)instanceMangle(FNameString)(MNameString)wheremangle(FNames)=MName(fixUps)instanceMangle(INameString)(FNameString)wheremangle(INames)=FName(fixLows)instanceMangle(INameUtf8)(FNameString)wheremangle(INames)=FName(fixLow.toString$s)instanceMangle(MNameString)(FNameString)wheremangle(MNames)=FName(fixLows)instanceMangle(DINameUtf8)(PMNameString)wheremangles=letms=splitDIsinPMName(mapmangle$initms)(mangle$lastms)instanceMangle(FINameUtf8)(PMNameString)wheremangles=letms=splitFIsinPMName(mapmangle$initms)(mangle$lastms)instanceMangle(DINameUtf8)(PFNameString)wheremangles=letms=splitDIsinPFName(mapmangle$initms)(mangle$lastms)instanceMangle(FINameUtf8)(PFNameString)wheremangles=letms=splitFIsinPFName(mapmangle$initms)(mangle$lastms)-- implementation details followdotUtf8::Utf8->Utf8->Utf8dotUtf8(Utf8a)(Utf8b)=Utf8(LC.appenda(LC.cons'.'b))dotString::String->String->StringdotStringab=a++('.':b)-- | Return list of nonempty Utf8, with all '.' removedsplitUtf8::Utf8->[Utf8]splitUtf8=unfoldrs.utf8wheres::ByteString->Maybe(Utf8,ByteString)sy=caseLC.unconsyofNothing->NothingJust('.',xs)->sxs-- delete all '.' in the input_->Just(let(a,b)=U.span('.'/=)yin(Utf8a,b))-- | Return list of nonempty String, with all '.' removedsplitString::String->[String]splitString=unfoldrswheres[]=Nothings('.':xs)=sxs-- delete all '.' in the inputsxs=Just(span('.'/=)xs)validIUtf8::Utf8->Maybe(INameUtf8)validIUtf8xs|unullxs=NothingvalidIUtf8xs@(Utf8bs)=ifLC.all(`S.member`validISet)bsthenJust(INamexs)elseNothingvalidIString::String->Maybe(INameString)validIString[]=NothingvalidIStringxs=ifall(`S.member`validISet)xsthenJust(INamexs)elseNothingvalidDIUtf8::Utf8->Maybe(DINameUtf8)validDIUtf8xs|unullxs=NothingvalidDIUtf8xs@(Utf8bs)=ifLC.all(`S.member`validDISet)bs&&LC.any('.'/=)bs&&LC.lastbs/='.'&&(all(\(x,y)->'.'/=x||'.'/=y).(\x->zip(initx)(tailx)).toString$xs)thenJust(DINamexs)elseNothingvalidDIString::String->Maybe(DINameString)validDIString[]=NothingvalidDIStringxs=ifall(`S.member`validDISet)xs&&any('.'/=)xs&&lastxs/='.'&&all(\(x,y)->'.'/=x||'.'/=y)(zip(initxs)(tailxs))thenJust(DINamexs)elseNothingvalidISet::SetCharvalidISet=S.fromDistinctAscList"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"validDISet::SetCharvalidDISet=S.fromDistinctAscList".0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"instanceDottedUtf8whereunconsx=caseU.uncons(utf8x)ofNothing->NothingJust(c,b)->Just(c,Utf8b)consb(Utf8bs)|fromEnumb<128=Utf8(LC.consbbs)|otherwise=Utf8((U.fromString[b])`mappend`bs)dot=dotUtf8split=splitUtf8validI=validIUtf8validDI=validDIUtf8instanceDottedStringwhereuncons[]=Nothinguncons(x:xs)=Just(x,xs)cons=(:)dot=dotStringsplit=splitStringvalidI=validIStringvalidDI=validDIStringerr::String->aerrs=error("Text.ProtocolBuffers.ProtoCompile.Identifiers: "++s)-- make leading upper case letter, and leanding "_" becomes "U'_"fixUp::String->StringfixUpxs|lastxs=='\''=fixUp(initxs)-- in case this is mangling after "fixLow"fixUp('_':xs)="U'"++xsfixUpi@(x:xs)|isLowerx=letx'=toUpperxinifisLowerx'thenerr("fixUp: stubborn lower case"++showi)elsex':xsfixUpxs=xs-- make leading '_' or lower case letter, may end with added single quote.fixLow::String->StringfixLow[]=[]fixLow('U':'\'':xs@('_':_))=fixLowxsfixLowi@(x:xs)|i`S.member`reserved=i++"'"|isUpperx=letx'=toLowerxinifisUpperx'thenerr("fixLow: stubborn upper case: "++showi)elseleti'=(x':xs)inifi'`S.member`reservedtheni'++"'"elsei'|otherwise=i-- | 'reserved' is a set of strings which are Haskell keywords and-- should not be valid field names.---- I do not protect these values:-- "mdo","foreign","rec","proc" ( GHC manual section 8.3.16 )-- because I do not anticipate using these extensions in the generated-- Haskell code.reserved::SetStringreserved=S.fromDistinctAscList["_","case","class","data","default","deriving","do","else","forall"{- extension keyword -},"if","import","in","infix","infixl","infixr","instance","let","module","newtype","of","then","type","where"]