usb-id-database 0.2 → 0.2.1
raw patch · 5 files changed
+165/−72 lines, 5 filesnew-component:exe:example
Files
- System/USB/IDDB.hs +11/−9
- System/USB/IDDB/Base.hs +50/−11
- System/USB/IDDB/LinuxUsbIdRepo.hs +69/−24
- System/USB/IDDB/UsbDotOrg.hs +1/−0
- usb-id-database.cabal +34/−28
System/USB/IDDB.hs view
@@ -1,10 +1,7 @@-{-# LANGUAGE CPP #-}- {-| A database of USB identifiers. Databases with vendor names and identifiers can be loaded from string,-file or directly from <http://www.usb.org> or-<http://linux-usb.sourceforge.net>.+file or directly from <http://www.usb.org> or <http://linux-usb.org>. Example usage: @@ -15,7 +12,7 @@ import Text.Printf main :: IO ()-main = do -- Load a snapshot from the linux-usb.sourceforget.net database.+main = do -- Load a snapshot from the linux-usb.org database. db <- 'staticDb' -- Print the name of vendor 0x1d6b 'putStrLn' $ 'maybe' \"unknown VID!\" 'unpack'@@ -45,11 +42,13 @@ module System.USB.IDDB ( -- *Types IDDB- , VendorID- , VendorName- , ProductID- , ProductName + , VendorID, VendorName+ , ProductID, ProductName+ , ClassID, ClassName+ , SubClassID, SubClassName+ , ProtocolID, ProtocolName+ , emptyDb -- *Query database@@ -57,6 +56,9 @@ , vendorId , productName , productId+ , className+ , subClassName+ , protocolName ) where
System/USB/IDDB/Base.hs view
@@ -1,14 +1,23 @@+{-# LANGUAGE CPP #-}+ module System.USB.IDDB.Base ( IDDB(..)- , VendorID, VendorName- , ProductID, ProductName + , VendorID, VendorName, VendorDB+ , ProductID, ProductName, ProductDB+ , ClassID, ClassName, ClassDB+ , SubClassID, SubClassName, SubClassDB+ , ProtocolID, ProtocolName, ProtocolDB+ , emptyDb , vendorName , vendorId , productName , productId+ , className+ , subClassName+ , protocolName , getDataFileName )@@ -30,23 +39,39 @@ -- Types ------------------------------------------------------------------------------- -type VendorID = Int-type ProductID = Int+type ID = Int+type Name = ByteString -type VendorName = ByteString-type ProductName = ByteString+type VendorID = ID+type ProductID = ID+type ClassID = ID+type SubClassID = ID+type ProtocolID = ID +type VendorName = Name+type ProductName = Name+type ClassName = Name+type SubClassName = Name+type ProtocolName = Name +type VendorDB = BM.Bimap VendorID VendorName+type ProductDB = BM.Bimap ProductID ProductName+type ClassDB = MP.Map ClassID (ClassName, SubClassDB)+type SubClassDB = MP.Map SubClassID (SubClassName, ProtocolDB)+type ProtocolDB = MP.Map ProtocolID ProtocolName+ -- |A database of USB identifiers. Contains both vendor identifiers -- and product identifiers.-data IDDB = IDDB { dbVendors :: BM.Bimap VendorID VendorName- , dbProducts :: MP.Map VendorID (BM.Bimap ProductID ProductName)+data IDDB = IDDB { dbVendors :: VendorDB+ , dbProducts :: MP.Map VendorID ProductDB+ , dbClasses :: ClassDB } --- |An empty database.+-- |An empty database./ emptyDb :: IDDB emptyDb = IDDB { dbVendors = BM.empty , dbProducts = MP.empty+ , dbClasses = MP.empty } -------------------------------------------------------------------------------@@ -54,13 +79,27 @@ ------------------------------------------------------------------------------- vendorName :: IDDB -> VendorID -> Maybe VendorName-vendorName db vid = BM.lookup vid (dbVendors db)+vendorName db vid = BM.lookup vid $ dbVendors db vendorId :: IDDB -> VendorName -> Maybe VendorID-vendorId db name = BM.lookupR name (dbVendors db)+vendorId db name = BM.lookupR name $ dbVendors db productName :: IDDB -> VendorID -> ProductID -> Maybe ProductName productName db vid pid = BM.lookup pid =<< MP.lookup vid (dbProducts db) productId :: IDDB -> VendorID -> ProductName -> Maybe ProductID productId db vid name = BM.lookupR name =<< MP.lookup vid (dbProducts db)++className :: IDDB -> ClassID -> Maybe ClassName+className db cid = fmap fst $ MP.lookup cid $ dbClasses db++subClassName :: IDDB -> ClassID -> SubClassID -> Maybe SubClassName+subClassName db cid scid = fmap fst $ MP.lookup scid . snd+ =<< MP.lookup cid (dbClasses db)++protocolName :: IDDB -> ClassID -> SubClassID -> ProtocolID -> Maybe ProtocolName+protocolName db cid scid protId = MP.lookup protId . snd+ =<< MP.lookup scid . snd+ =<< MP.lookup cid (dbClasses db)++
System/USB/IDDB/LinuxUsbIdRepo.hs view
@@ -16,11 +16,7 @@ import Parsimony import Parsimony.Char (char, hexDigit, spaces, tab) import System.IO (FilePath)-import System.USB.IDDB.Base ( IDDB(..)- , VendorID, VendorName- , ProductID, ProductName- , getDataFileName- )+import System.USB.IDDB.Base import System.USB.IDDB.Misc (BSParser, eitherMaybe, restOfLine) import qualified Codec.Binary.UTF8.String as UTF8 (encode)@@ -28,7 +24,7 @@ import qualified Data.ByteString as BS (ByteString, pack, readFile) import qualified Data.Encoding.ISO88591 as Enc (ISO88591(..)) import qualified Data.Encoding.UTF8 as Enc (UTF8(..))-import qualified Data.Map as MP (fromList)+import qualified Data.Map as MP (Map, fromList) -- |Construct a database from a string in the format used by@@ -37,13 +33,20 @@ parseDb = eitherMaybe . parse dbParser dbParser :: BSParser IDDB-dbParser = do- spaces >> many (lexeme comment)- xs <- many vendorParser- return IDDB { dbVendors = BM.fromList [(vid, name) | (vid, name, _) <- xs]- , dbProducts = MP.fromList [(vid, pdb) | (vid, _, pdb) <- xs]- }+dbParser = do spaces+ comments+ (vendorDB, productDB) <- lexeme vendorSection+ comments+ classDB <- classSection++ return IDDB { dbVendors = vendorDB+ , dbProducts = productDB+ , dbClasses = classDB+ } where+ utf8BS :: String -> BS.ByteString+ utf8BS = BS.pack . UTF8.encode+ lexeme :: BSParser a -> BSParser a lexeme p = do x <- p spaces@@ -52,27 +55,69 @@ comment :: BSParser String comment = char '#' >> restOfLine - hexId :: Num n => BSParser n- hexId = do ds <- count 4 hexDigit- case readHex ds of- [(n, _)] -> return n- _ -> error "impossible"+ comments :: BSParser [String]+ comments = many $ lexeme comment + hexId :: Num n => Int -> BSParser n+ hexId d = do ds <- count d hexDigit+ case readHex ds of+ [(n, _)] -> return n+ _ -> error "impossible"++ vendorSection :: BSParser (VendorDB, MP.Map VendorID ProductDB)+ vendorSection = do xs <- lexeme $ many vendorParser+ return ( BM.fromList [(vid, name) | (vid, name, _) <- xs]+ , MP.fromList [(vid, pdb) | (vid, _, pdb) <- xs]+ )+ vendorParser :: BSParser (VendorID, VendorName, BM.Bimap ProductID ProductName)- vendorParser = do vid <- hexId- spaces+ vendorParser = do vid <- hexId 4+ count 2 $ char ' ' name <- restOfLine- products <- many (tab >> productParser)+ products <- many productParser return ( vid- , BS.pack $ UTF8.encode name+ , utf8BS name , BM.fromList products ) productParser :: BSParser (ProductID, ProductName)- productParser = do pid <- hexId- spaces+ productParser = do tab+ pid <- hexId 4+ count 2 $ char ' ' name <- restOfLine- return (pid, BS.pack $ UTF8.encode name)+ return (pid, utf8BS name)++ classSection :: BSParser ClassDB+ classSection = do xs <- lexeme $ many classParser+ return $ MP.fromList xs++ classParser :: BSParser (ClassID, (ClassName, SubClassDB))+ classParser = do char 'C'+ char ' '+ cid <- hexId 2+ count 2 $ char ' '+ name <- restOfLine+ subClasses <- many subClassParser+ return ( cid+ , (utf8BS name, MP.fromList subClasses)+ )++ subClassParser :: BSParser (SubClassID, (SubClassName, ProtocolDB))+ subClassParser = do tab+ scid <- hexId 2+ count 2 $ char ' '+ name <- restOfLine+ protocols <- many (try protocolParser)+ return ( scid+ , (utf8BS name, MP.fromList protocols)+ )++ protocolParser :: BSParser (ProtocolID, ProtocolName)+ protocolParser = do count 2 tab+ protId <- hexId 2+ count 2 $ char ' '+ name <- restOfLine+ return (protId, utf8BS name) -- |Construct a database from the data available at -- <http://linux-usb.org/usb.ids>.
System/USB/IDDB/UsbDotOrg.hs view
@@ -32,6 +32,7 @@ staticDbParser = do vendors <- many vendorParser return IDDB { dbVendors = BM.fromList vendors , dbProducts = MP.empty+ , dbClasses = MP.empty } where vendorParser :: BSParser (VendorID, VendorName)
usb-id-database.cabal view
@@ -1,25 +1,29 @@-Name: usb-id-database-Version: 0.2-Cabal-Version: >=1.6-Build-Type: Simple-Stability: provisional-Author: Roel van Dijk-Maintainer: vandijk.roel@gmail.com-Copyright: (c) 2009 Roel van Dijk-License: BSD3-License-File: LICENSE-Category: System-Synopsis: A database of USB identifiers-Description:+name: usb-id-database+version: 0.2.1+cabal-version: >=1.6+build-type: Simple+stability: provisional+author: Roel van Dijk+maintainer: vandijk.roel@gmail.com+copyright: (c) 2009 Roel van Dijk+license: BSD3+license-file: LICENSE+category: System+synopsis: A database of USB identifiers+description: Functions to find the names associated with numerical vendor and product identifiers. -Extra-Source-Files: example.hs-Data-Files: usb_dot_org_db.txt+extra-source-files: example.hs+data-files: usb_dot_org_db.txt , usb_id_repo_db.txt -Library- Build-Depends: base >= 3 && < 4.2+flag example+ description: Build an example program+ default: False++library+ build-depends: base >= 3 && < 4.2 , bimap >= 0.2 && < 0.3 , bytestring >= 0.9 && < 1.0 , containers >= 0.2 && < 0.3@@ -27,19 +31,21 @@ , encoding >= 0.6.2 && < 0.7 , parsimony >= 1 && < 1.1 , utf8-string >= 0.3.5 && < 0.4- Extensions: CPP- GHC-Options: -Wall- CPP-Options: -DBUILD_WITH_CABAL- Exposed-Modules: System.USB.IDDB+ ghc-options: -Wall+ cpp-options: -DBUILD_WITH_CABAL+ exposed-modules: System.USB.IDDB , System.USB.IDDB.UsbDotOrg , System.USB.IDDB.LinuxUsbIdRepo- Other-Modules: Paths_usb_id_database+ other-modules: Paths_usb_id_database , System.USB.IDDB.Base , System.USB.IDDB.Misc --- Uncomment to build a small example program--- Executable example--- Extensions: CPP--- GHC-Options: -Wall--- CPP-Options: -DBUILD_WITH_CABAL--- Main-Is: example.hs+executable example+ extensions: CPP+ ghc-options: -Wall+ cpp-options: -DBUILD_WITH_CABAL+ main-is: example.hs+ if flag(example)+ buildable: True+ else+ buildable: False