diff --git a/System/USB/IDDB.hs b/System/USB/IDDB.hs --- a/System/USB/IDDB.hs +++ b/System/USB/IDDB.hs @@ -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 or -. +file or directly from or . 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 diff --git a/System/USB/IDDB/Base.hs b/System/USB/IDDB/Base.hs --- a/System/USB/IDDB/Base.hs +++ b/System/USB/IDDB/Base.hs @@ -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) + + diff --git a/System/USB/IDDB/LinuxUsbIdRepo.hs b/System/USB/IDDB/LinuxUsbIdRepo.hs --- a/System/USB/IDDB/LinuxUsbIdRepo.hs +++ b/System/USB/IDDB/LinuxUsbIdRepo.hs @@ -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 -- . diff --git a/System/USB/IDDB/UsbDotOrg.hs b/System/USB/IDDB/UsbDotOrg.hs --- a/System/USB/IDDB/UsbDotOrg.hs +++ b/System/USB/IDDB/UsbDotOrg.hs @@ -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) diff --git a/usb-id-database.cabal b/usb-id-database.cabal --- a/usb-id-database.cabal +++ b/usb-id-database.cabal @@ -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