{-# 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>. Example usage: @ module Main where import System.USB.IDDB import Data.ByteString.Char8 (pack, unpack) main :: IO () main = do -- Acquire the default database db <- 'vdbDefault' -- Print the name of vendor 0x1D6B 'putStrLn' $ 'maybe \"unknown ID!\" 'unpack' $ 'vendorName' db 0x1D6B -- Print the ID of \"The Linux Foundation\" 'putStrLn' $ 'maybe' \"unknown name!\" 'show' $ 'vendorID' db ('pack' \"The Linux Foundation\") @ EBNF grammar of the textual representation of a vendor database: > vendor database = {row}; > row = vendor id, "|", vendor name; > vendor id = natural number; > vendor name = ASCII string; > natural number = positive digit, {digit} > positive digit = "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"; > digit = "0" | positive digit; -} module System.USB.IDDB ( -- *Types VendorID , VendorName , VendorDB -- *Acquire database , vdbFromString , vdbFromFile , vdbFromUsbDotOrg , vdbDefault -- *Export database , vdbToString , vdbToFile -- *Query database , vendorName , vendorID ) where import Control.Arrow ((>>>)) import Control.Monad (liftM) import Data.Char (isSpace) import Data.Maybe (fromJust) import Network.Download (openURI) import System.IO (FilePath) import Text.Read (reads) import qualified Data.Bimap as BM import qualified Data.ByteString.Char8 as BS #ifdef BUILD_WITH_CABAL import Paths_usb_id_database (getDataFileName) #else getDataFileName :: FilePath -> IO FilePath getDataFileName = return #endif ------------------------------------------------------------------------------- -- Types ------------------------------------------------------------------------------- -- |A numerical identifier for a vendor. type VendorID = Int -- |The name of a company/entity which has acquired an official ID -- from the USB Implementors Forum. type VendorName = BS.ByteString -- |A database of USB vendors. Associates numerical vendor ID's with -- vendor names and vice versa. type VendorDB = BM.Bimap VendorID VendorName ------------------------------------------------------------------------------- -- Acquire database ------------------------------------------------------------------------------- -- |Construct a vendor database from a string. vdbFromString :: BS.ByteString -> Maybe VendorDB vdbFromString = strip >>> BS.lines >>> map parseLine >>> sequence >>> maybe Nothing (Just . BM.fromList) where parseLine :: BS.ByteString -> Maybe (VendorID, VendorName) parseLine line = let (vid, rest) = BS.break (== '|') line in if BS.null rest then Nothing else let name = BS.tail rest in case reads (BS.unpack vid) of [] -> Nothing ((vid',_):_) -> Just (vid', name) -- |Load a vendor database from file. If the file can not be read for -- some reason an error will be thrown. vdbFromFile :: FilePath -> IO (Maybe VendorDB) vdbFromFile = liftM vdbFromString . BS.readFile vdbUsbDotOrgUrl :: String vdbUsbDotOrgUrl = "http://www.usb.org/developers/tools/comp_dump" -- |Construct a vendor database from the list of companies available -- at <http://www.usb.org/developers/tools/comp_dump>. The website -- informs us that: /"Remember this list changes almost daily, be/ -- /sure to get a fresh copy when you use the tools"/. However, the -- list seems to be quite stable. Using this function more than once -- a day is probably overkill. vdbFromUsbDotOrg :: IO (Maybe VendorDB) vdbFromUsbDotOrg = liftM (either (const Nothing) vdbFromString) $ openURI vdbUsbDotOrgUrl vdbDataFile :: FilePath vdbDataFile = "usb_vendor_list.txt" -- |Load a vendor database from a static file which is supplied with -- the package. vdbDefault :: IO VendorDB vdbDefault = getDataFileName vdbDataFile >>= liftM fromJust . vdbFromFile ------------------------------------------------------------------------------- -- Export database ------------------------------------------------------------------------------- -- |Convert a vendor database to its textual representation. vdbToString :: VendorDB -> BS.ByteString vdbToString = BS.unlines . map row . BM.toAscList where row (vid, name) = BS.pack (show vid) `BS.append` BS.singleton '|' `BS.append` name -- |Write a database to a file. If this file is not accessible an -- error will be thrown. vdbToFile :: FilePath -> VendorDB -> IO () vdbToFile fp = BS.writeFile fp . vdbToString ------------------------------------------------------------------------------- -- Query database ------------------------------------------------------------------------------- -- |Retrieve the name of a vendor given its ID. vendorName :: VendorDB -> VendorID -> Maybe VendorName vendorName db i = BM.lookup i db -- |Retrieve the ID of a vendor given its name. vendorID :: VendorDB -> VendorName -> Maybe VendorID vendorID db name = BM.lookupR name db ------------------------------------------------------------------------------- -- Utility ------------------------------------------------------------------------------- stripL :: BS.ByteString -> BS.ByteString stripL = snd . BS.span isSpace stripR :: BS.ByteString -> BS.ByteString stripR = fst . BS.spanEnd isSpace strip :: BS.ByteString -> BS.ByteString strip = stripR . stripL ------------------------------------------------------------------------------- -- Properties ------------------------------------------------------------------------------- {-- -- |Converting a vendor DB to a string and back should yield the same DB. prop_toAndFromString :: VendorDB -> Bool prop_toAndFromString db = maybe False (== db) (vdbFromString $ vdbToString db) prop_fromAndToString :: String -> Bool prop_fromAndToString = maybe True prop_toAndFromString . vdbFromString --}