Added many identifiers, removed Binary instance, updated documentation

Ignore-this: e7bcbb3b5da6ff165abb845643e02f3f darcs-hash:20091001183814-b004c-35c87363677925f8867ec6c6eae7dd034d8f046e.gz
basvandijk · Oct 1, 2009 · a7f1903 · a7f1903
1 parent 7049909
commit a7f1903
Show file tree

Hide file tree

Showing 7 changed files with 166 additions and 130 deletions.
diff --git a/System/USB/IDDB.hs b/System/USB/IDDB.hs
@@ -1,11 +1,14 @@
 {-| A database of USB identifiers.
 
-Databases with vendor names and identifiers can be loaded from string,
-file or directly from
+Databases with vendor names and identifiers can be loaded from string or file.
+
+To get the most up-to-date database download the files directly from
 <http://www.usb.org>
 or
 <http://linux-usb.org>.
 
+Each database's module contains an URL to the database file.
+
 Example usage:
 
 @
@@ -59,6 +62,14 @@ module System.USB.IDDB
     , subClassName
     , protocolName
     , audioClassTerminalTypeName
+    , videoClassTerminalTypeName
+    , hidDescTypeName
+    , hidDescItemName
+    , hidDescCountryCodeName
+    , hidUsagePageName
+    , hidUsageName
+    , physicalDescBiasName
+    , physicalDescItemName
     , langName
     , subLangName
     )

diff --git a/System/USB/IDDB/Base.hs b/System/USB/IDDB/Base.hs
@@ -16,15 +16,21 @@ module System.USB.IDDB.Base
     , subClassName
     , protocolName
     , audioClassTerminalTypeName
+    , videoClassTerminalTypeName
+    , hidDescTypeName
+    , hidDescItemName
+    , hidDescCountryCodeName
+    , hidUsagePageName
+    , hidUsageName
+    , physicalDescBiasName
+    , physicalDescItemName
     , langName
     , subLangName
 
     , getDataFileName
     )
     where
 
-import Data.Binary ( Binary(..), Get )
-
 import qualified Data.IntMap as IM
 import qualified Data.Map    as MP
 
@@ -45,16 +51,22 @@ type ProductDB  = ( MP.Map String Int
 type ClassDB    = IM.IntMap (String, SubClassDB)
 type SubClassDB = IM.IntMap (String, ProtocolDB)
 type ProtocolDB = IM.IntMap String
-type LanguageDB = IM.IntMap (String, IM.IntMap String)
 
 -- |A database of USB identifiers. Contains both vendor identifiers
 -- and product identifiers.
 data IDDB = IDDB { dbVendorNameId :: MP.Map String Int
                  , dbVendorIdName :: IM.IntMap String
                  , dbProducts     :: IM.IntMap ProductDB
                  , dbClasses      :: ClassDB
-                 , dbACT          :: IM.IntMap String
-                 , dbLanguages    :: LanguageDB
+                 , dbAudioCTType  :: IM.IntMap String
+                 , dbVideoCTType  :: IM.IntMap String
+                 , dbHIDDescType  :: IM.IntMap String
+                 , dbHIDDescItem  :: IM.IntMap String
+                 , dbHIDDescCCode :: IM.IntMap String
+                 , dbHIDUsage     :: IM.IntMap (String, IM.IntMap String)
+                 , dbPhysDescBias :: IM.IntMap String
+                 , dbPhysDescItem :: IM.IntMap String
+                 , dbLanguages    :: IM.IntMap (String, IM.IntMap String)
                  }
 
 -- |An empty database.
@@ -63,100 +75,119 @@ emptyDb = IDDB { dbVendorNameId = MP.empty
                , dbVendorIdName = IM.empty
                , dbProducts     = IM.empty
                , dbClasses      = IM.empty
-               , dbACT          = IM.empty
+               , dbAudioCTType  = IM.empty
+               , dbVideoCTType  = IM.empty
+               , dbHIDDescType  = IM.empty
+               , dbHIDDescItem  = IM.empty
+               , dbHIDDescCCode = IM.empty
+               , dbHIDUsage     = IM.empty
+               , dbPhysDescBias = IM.empty
+               , dbPhysDescItem = IM.empty
                , dbLanguages    = IM.empty
                }
 
--------------------------------------------------------------------------------
--- Binary serialisation
--------------------------------------------------------------------------------
-
-instance Binary IDDB where
-    put db = put ( dbVendorNameId db
-                 , dbVendorIdName db
-                 , dbProducts     db
-                 , dbClasses      db
-                 , dbACT          db
-                 , dbLanguages    db
-                 )
-
-    get = do (a, b, c, d, e, f) <- get'
-             return IDDB { dbVendorNameId = a
-                         , dbVendorIdName = b
-                         , dbProducts     = c
-                         , dbClasses      = d
-                         , dbACT          = e
-                         , dbLanguages    = f
-                         }
-        where get' :: Get ( MP.Map String Int
-                          , IM.IntMap String
-                          , IM.IntMap ProductDB
-                          , ClassDB
-                          , IM.IntMap String
-                          , LanguageDB
-                          )
-              get' = get
-
 -------------------------------------------------------------------------------
 -- Query database
 -------------------------------------------------------------------------------
 
-vendorName :: IDDB
-           -> Int -- ^Vendor Id
+vendorName :: IDDB -- ^Database
+           -> Int  -- ^Vendor identifier
            -> Maybe String
 vendorName db vid = IM.lookup vid $ dbVendorIdName db
 
-vendorId :: IDDB
+vendorId :: IDDB   -- ^Database
          -> String -- ^Vendor name
          -> Maybe Int
 vendorId db name = MP.lookup name $ dbVendorNameId db
 
-productName :: IDDB
-            -> Int -- ^Vendor Id
-            -> Int -- ^Product Id
+productName :: IDDB -- ^Database
+            -> Int  -- ^Vendor identifier
+            -> Int  -- ^Product identifier
             -> Maybe String
 productName db vid pid = IM.lookup pid . snd =<< IM.lookup vid (dbProducts db)
 
-productId :: IDDB
-          -> Int    -- ^Vendor Id
+productId :: IDDB   -- ^Database
+          -> Int    -- ^Vendor identifier
           -> String -- ^Product name
           -> Maybe Int
 productId db vid name = MP.lookup name . fst =<< IM.lookup vid (dbProducts db)
 
-className :: IDDB
-          -> Int -- ^Class Id
+className :: IDDB -- ^Database
+          -> Int  -- ^Class identifier
           -> Maybe String
 className db cid = fmap fst . IM.lookup cid $ dbClasses db
 
-subClassName :: IDDB
-             -> Int -- ^Class Id
-             -> Int -- ^Sub class Id
+subClassName :: IDDB -- ^Database
+             -> Int  -- ^Class identifier
+             -> Int  -- ^Sub class identifier
              -> Maybe String
 subClassName db cid scid = fmap fst $   IM.lookup scid . snd
                                     =<< IM.lookup cid (dbClasses db)
 
-protocolName :: IDDB
-             -> Int -- ^Class Id
-             -> Int -- ^Sub class Id
-             -> Int -- ^Protocol Id
+protocolName :: IDDB -- ^Database
+             -> Int  -- ^Class identifier
+             -> Int  -- ^Sub class identifier
+             -> Int  -- ^Protocol identifier
              -> Maybe String
 protocolName db cid scid protId =   IM.lookup protId . snd
                                 =<< IM.lookup scid   . snd
                                 =<< IM.lookup cid (dbClasses db)
 
-audioClassTerminalTypeName :: IDDB
-                           -> Int -- ^Audio class terminal type Id
+audioClassTerminalTypeName :: IDDB -- ^Database
+                           -> Int  -- ^Audio class terminal type identifier
                            -> Maybe String
-audioClassTerminalTypeName db actid = IM.lookup actid (dbACT db)
+audioClassTerminalTypeName db actid = IM.lookup actid (dbAudioCTType db)
+
+videoClassTerminalTypeName :: IDDB -- ^Database
+                           -> Int  -- ^Video class terminal type identifier
+                           -> Maybe String
+videoClassTerminalTypeName db actid = IM.lookup actid (dbVideoCTType db)
+
+hidDescTypeName :: IDDB -- ^Database
+                -> Int  -- ^HID descriptor type identifier
+                -> Maybe String
+hidDescTypeName db hidid = IM.lookup hidid (dbHIDDescType db)
+
+hidDescItemName :: IDDB -- ^Database
+                -> Int  -- ^HID descriptor item identifier
+                -> Maybe String
+hidDescItemName db hidid = IM.lookup hidid (dbHIDDescItem db)
+
+hidDescCountryCodeName :: IDDB -- ^Database
+                       -> Int  -- ^HID descriptor country code identifier
+                       -> Maybe String
+hidDescCountryCodeName db hidid = IM.lookup hidid (dbHIDDescCCode db)
+
+hidUsagePageName :: IDDB -- ^Database
+                 -> Int  -- ^HID usage page identifier
+                 -> Maybe String
+hidUsagePageName db upid = fmap fst $ IM.lookup upid (dbHIDUsage db)
+
+hidUsageName :: IDDB -- ^Database
+             -> Int  -- ^HID usage page identifier
+             -> Int  -- ^HID usage identifier
+             -> Maybe String
+hidUsageName db upid uid =   IM.lookup uid . snd
+                         =<< IM.lookup upid (dbHIDUsage db)
+
+physicalDescBiasName :: IDDB -- ^Database
+                     -> Int  -- ^Physical descriptor bias identifier
+                     -> Maybe String
+physicalDescBiasName db phyid = IM.lookup phyid (dbPhysDescBias db)
+
+physicalDescItemName :: IDDB -- ^Database
+                     -> Int  -- ^Physical descriptor item identifier
+                     -> Maybe String
+physicalDescItemName db phyid = IM.lookup phyid (dbPhysDescItem db)
 
-langName :: IDDB
-         -> Int -- ^Primary language Id
+langName :: IDDB -- ^Database
+         -> Int  -- ^Primary language identifier
          -> Maybe String
 langName db lid = fmap fst . IM.lookup lid $ dbLanguages db
 
-subLangName :: IDDB
-            -> Int -- ^Primary language Id
-            -> Int -- ^Sub language Id
+subLangName :: IDDB -- ^Database
+            -> Int  -- ^Primary language identifier
+            -> Int  -- ^Sub language identifier
             -> Maybe String
 subLangName db lid slid =   IM.lookup slid . snd
                         =<< IM.lookup lid (dbLanguages db)
diff --git a/System/USB/IDDB/LinuxUsbIdRepo.hs b/System/USB/IDDB/LinuxUsbIdRepo.hs
@@ -1,3 +1,5 @@
+{-| Functions to acquire a database from <http://linux-usb.org>. -}
+
 module System.USB.IDDB.LinuxUsbIdRepo
     ( parseDb
     , staticDb
@@ -30,39 +32,46 @@ stripBoring :: String -> String
 stripBoring = unlines
             . filter (\xs -> not (isComment xs) && not (isEmpty xs))
             . lines
-    where
-      isComment :: String -> Bool
-      isComment = isPrefixOf "#"
 
-      isEmpty :: String -> Bool
-      isEmpty = all isSpace
+isComment :: String -> Bool
+isComment = isPrefixOf "#"
+
+isEmpty :: String -> Bool
+isEmpty = all isSpace
 
 dbParser :: Parser String IDDB
 dbParser = do (vendorNameId, vendorIdName, productDB) <- vendorSection
               classDB <- genericSection (label "C") 2 id
                          . genericSection tab 2 id
                            . genericSection (count 2 tab) 2 fst
                              $ return ()
-              actDB   <- simpleSection "AT" 4
-              _       <- simpleSection "HID" 2
-              _       <- simpleSection "R" 2
-              _       <- simpleSection "BIAS" 1
-              _       <- simpleSection "PHY" 2
-              _       <- genericSection (label "HUT") 2 id
+              at      <- simpleSection "AT" 4
+              hid     <- simpleSection "HID" 2
+              r       <- simpleSection "R" 2
+              bias    <- simpleSection "BIAS" 1
+              phy     <- simpleSection "PHY" 2
+              hut     <- genericSection (label "HUT") 2 id
                          . genericSection tab 3 fst
                            $ return ()
-              langDB  <- genericSection (label "L") 4 id
+              l       <- genericSection (label "L") 4 id
                          . genericSection tab 2 fst
                            $ return ()
-              _       <- simpleSection "HCC" 2
-              _       <- simpleSection "VT" 4
+              hcc     <- simpleSection "HCC" 2
+              vt      <- simpleSection "VT" 4
 
               return IDDB { dbVendorNameId = vendorNameId
                           , dbVendorIdName = vendorIdName
                           , dbProducts     = productDB
                           , dbClasses      = classDB
-                          , dbACT          = actDB
-                          , dbLanguages    = langDB
+                          , dbAudioCTType  = at
+                          , dbVideoCTType  = vt
+                          , dbHIDDescType  = hid
+                          , dbHIDDescItem  = r
+                          , dbHIDDescCCode = hcc
+                          , dbHIDUsage     = hut
+                          , dbPhysDescBias = bias
+                          , dbPhysDescItem = phy
+                          , dbLanguages    = l
                           }
     where
       hexId :: Num n => Int -> Parser String n
@@ -131,18 +140,22 @@ dbParser = do (vendorNameId, vendorIdName, productDB) <- vendorSection
                          name <- restOfLine
                          return (pid, name)
 
--- |Load a vendor database from file. If the file can not be read for some
--- reason an error will be thrown.
+-- |Load a database from file. If the file can not be read for some reason an
+-- error will be thrown.
 fromFile :: FilePath -> IO (Maybe IDDB)
 fromFile = fmap parseDb . readFile
 
 -- |Load a database from a snapshot of the linux-usb.org database which is
 --  supplied with the package.
 staticDb :: IO IDDB
 staticDb = getDataFileName staticDbPath >>= fmap fromJust . fromFile
+    where
+      staticDbPath :: FilePath
+      staticDbPath = "usb_id_repo_db.txt"
 
-staticDbPath :: FilePath
-staticDbPath = "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 :: String
 dbURL = "http://linux-usb.org/usb.ids"