module System.USB.IDDB.Base
( IDDB(..)
, ID, Name
, VendorID, VendorName
, ProductID, ProductName, ProductDB
, ClassID, ClassName, ClassDB
, SubClassID, SubClassName, SubClassDB
, ProtocolID, ProtocolName, ProtocolDB
, emptyDb
, vendorName
, vendorId
, productName
, productId
, className
, subClassName
, protocolName
, getDataFileName
)
where
import Data.Binary (Binary(..), Get)
import qualified Data.IntMap as IM
import qualified Data.Map as MP
#ifdef BUILD_WITH_CABAL
import Paths_usb_id_database (getDataFileName)
#else
getDataFileName :: FilePath -> IO FilePath
getDataFileName = return
#endif
type ID = Int
type Name = String
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 ProductDB = ( MP.Map ProductName ProductID
, IM.IntMap ProductName
)
type ClassDB = IM.IntMap (ClassName, SubClassDB)
type SubClassDB = IM.IntMap (SubClassName, ProtocolDB)
type ProtocolDB = IM.IntMap ProtocolName
data IDDB = IDDB { dbVendorNameId :: MP.Map VendorName VendorID
, dbVendorIdName :: IM.IntMap VendorName
, dbProducts :: IM.IntMap ProductDB
, dbClasses :: ClassDB
}
emptyDb :: IDDB
emptyDb = IDDB { dbVendorNameId = MP.empty
, dbVendorIdName = IM.empty
, dbProducts = IM.empty
, dbClasses = IM.empty
}
instance Binary IDDB where
put db = put ( dbVendorNameId db
, dbVendorIdName db
, dbProducts db
, dbClasses db
)
get = do (a, b, c, d) <- get :: Get ( MP.Map VendorName VendorID
, IM.IntMap VendorName
, IM.IntMap ProductDB
, ClassDB
)
return IDDB { dbVendorNameId = a
, dbVendorIdName = b
, dbProducts = c
, dbClasses = d
}
vendorName :: IDDB -> VendorID -> Maybe VendorName
vendorName db vid = IM.lookup vid $ dbVendorIdName db
vendorId :: IDDB -> VendorName -> Maybe VendorID
vendorId db name = MP.lookup name $ dbVendorNameId db
productName :: IDDB -> VendorID -> ProductID -> Maybe ProductName
productName db vid pid = IM.lookup pid . snd =<< IM.lookup vid (dbProducts db)
productId :: IDDB -> VendorID -> ProductName -> Maybe ProductID
productId db vid name = MP.lookup name . fst =<< IM.lookup vid (dbProducts db)
className :: IDDB -> ClassID -> Maybe ClassName
className db cid = fmap fst . IM.lookup cid $ dbClasses db
subClassName :: IDDB -> ClassID -> SubClassID -> Maybe SubClassName
subClassName db cid scid = fmap fst $ IM.lookup scid . snd
=<< IM.lookup cid (dbClasses db)
protocolName :: IDDB -> ClassID -> SubClassID -> ProtocolID -> Maybe ProtocolName
protocolName db cid scid protId = IM.lookup protId . snd
=<< IM.lookup scid . snd
=<< IM.lookup cid (dbClasses db)