{-# LANGUAGE CPP #-}{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE UnicodeSyntax #-}{-| Functions to acquire a database from <http://linux-usb.org>. -}moduleSystem.USB.IDDB.LinuxUsbIdRepo(-- * ParsingparseDb-- * Acquiring a database,staticDb,fromFile,dbURL)where--------------------------------------------------------------------------------- Imports--------------------------------------------------------------------------------- baseimportControl.Arrow(second)importControl.Monad((>>=),(>>),fail,fmap,return)importData.Bool(Bool,not)importData.Char(String,isSpace)importData.Function(($),id)importData.Int(Int)importData.List(all,filter,length,map,isPrefixOf,lines,unlines)importData.Maybe(Maybe,fromJust)importData.Tuple(fst)importNumeric(readHex)importPrelude(Num,error,fromInteger,seq)importSystem.IO(IO,FilePath)#if MIN_VERSION_base(4,2,0)importSystem.IO(IOMode(ReadMode),withFile,hSetEncoding,latin1,hGetContents)#elseimportSystem.IO(readFile)#endif-- base-unicode-symbolsimportData.Bool.Unicode((∧))importData.Function.Unicode((∘))-- containersimportqualifiedData.IntMapasIMimportqualifiedData.MapasMP-- parsimonyimportParsimonyimportParsimony.Char(char,string,hexDigit,tab)-- usb-id-databaseimportSystem.USB.IDDB.BaseimportSystem.USB.IDDB.Misc(eitherMaybe,swap,restOfLine)--------------------------------------------------------------------------------- Parsing--------------------------------------------------------------------------------- |Construct a database from a string in the format used by-- <http://linux-usb.org>.parseDb∷String→MaybeIDDBparseDb=eitherMaybe∘parsedbParser∘stripBoring-- |Remove comments and empty lines.stripBoring∷String→StringstripBoring=unlines∘filter(\xs→not(isCommentxs)∧not(isEmptyxs))∘linesisComment∷String→BoolisComment=isPrefixOf"#"isEmpty∷String→BoolisEmpty=allisSpacedbParser∷ParserStringIDDBdbParser=do(vendorNameId,vendorIdName,productDB)←vendorSectionclassDB←genericSection(label"C")2id∘genericSectiontab2id∘genericSection(count2tab)2fst$return()at←simpleSection"AT"4hid←simpleSection"HID"2r←simpleSection"R"2bias←simpleSection"BIAS"1phy←simpleSection"PHY"2hut←genericSection(label"HUT")2id∘genericSectiontab3fst$return()l←genericSection(label"L")4id∘genericSectiontab2fst$return()hcc←simpleSection"HCC"2vt←simpleSection"VT"4returnIDDB{dbVendorNameId=vendorNameId,dbVendorIdName=vendorIdName,dbProducts=productDB,dbClasses=classDB,dbAudioCTType=at,dbVideoCTType=vt,dbHIDDescType=hid,dbHIDDescItem=r,dbHIDDescCCode=hcc,dbHIDUsage=hut,dbPhysDescBias=bias,dbPhysDescItem=phy,dbLanguages=l}wherehexId∷Numn⇒Int→ParserStringnhexIdd=dods←countdhexDigitcasereadHexdsof[(n,_)]→returnn_→error"impossible"label∷String→ParserString()labeln=stringn>>char' '>>return()-- Top level section without subsections.simpleSection∷String→Int→ParserString(IM.IntMapString)simpleSectionsymidSize=genericSection(stringsym>>char' ')idSizefst$return()genericSection∷(ParserStringp)→Int→((String,s)→r)→ParserStrings→ParserString(IM.IntMapr)genericSectionprefixidSizeconvert=fmap(IM.fromList∘map(secondconvert))∘many∘try∘genericItemprefixidSizegenericItem∷(ParserStringp)→Int→ParserStrings→ParserString(Int,(String,s))genericItemprefixidSizesub=do_←prefixitemId←hexIdidSize_←count2$char' 'itemName←restOfLines←subreturn(itemId,(itemName,s))vendorSection∷ParserString(MP.MapStringInt,IM.IntMapString,IM.IntMapProductDB)vendorSection=doxs←many(try(vendorParser<?>"vendor"))return(MP.fromList[(name,vid)|(vid,name,_)←xs],IM.fromList[(vid,name)|(vid,name,_)←xs],IM.fromList[(vid,pdb)|(vid,_,pdb)←xs])vendorParser∷ParserString(Int,String,ProductDB)vendorParser=dovid←hexId4_←count2$char' 'name←restOfLineproducts←many(productParser<?>"product")return(vid,name,(MP.fromList$fmapswapproducts,IM.fromListproducts))productParser∷ParserString(Int,String)productParser=do_←tabpid←hexId4_←count2$char' 'name←restOfLinereturn(pid,name)--------------------------------------------------------------------------------- Acquiring a database--------------------------------------------------------------------------------- |Load a database from file. If the file can not be read for some reason an-- error will be thrown.fromFile∷FilePath→IO(MaybeIDDB)#if MIN_VERSION_base(4,2,0)fromFilefp=withFilefpReadMode$\h→dohSetEncodinghlatin1contents←hGetContentsh-- Bit ugly, but necessary to force the-- evaluation of contents before it is parsed-- as a database. Otherwise you'll get an-- empty database.lengthcontents`seq`(return$parseDbcontents)#elsefromFile=fmapparseDb∘readFile#endif-- |Load a database from a snapshot of the linux-usb.org database which is-- supplied with the package.staticDb∷IOIDDBstaticDb=getDataFileNamestaticDbPath>>=fmapfromJust∘fromFilewherestaticDbPath∷FilePathstaticDbPath="usb_id_repo_db.txt"-- |<http://linux-usb.org/usb.ids>---- The source of the database. Download this file for the most up-to-date-- version.dbURL∷StringdbURL="http://linux-usb.org/usb.ids"