module System.USB.IDDB.LinuxUsbIdRepo
( parseDb
, staticDb
, fromFile
, dbURL
) where
import Control.Arrow ( second )
import Control.Monad ( fmap )
import Data.Char ( isSpace )
import Data.List ( lines, unlines, isPrefixOf )
import Data.Maybe ( fromJust )
import Numeric ( readHex )
import Parsimony
import Parsimony.Char ( char, string, hexDigit, tab )
import System.IO ( FilePath, readFile )
import System.USB.IDDB.Base
import System.USB.IDDB.Misc ( eitherMaybe, swap, restOfLine )
import qualified Data.IntMap as IM
import qualified Data.Map as MP
parseDb :: String -> Maybe IDDB
parseDb = eitherMaybe . parse dbParser . stripBoring
stripBoring :: String -> String
stripBoring = unlines
. filter (\xs -> not (isComment xs) && not (isEmpty xs))
. lines
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 ()
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 ()
l <- genericSection (label "L") 4 id
. genericSection tab 2 fst
$ return ()
hcc <- simpleSection "HCC" 2
vt <- simpleSection "VT" 4
return IDDB { dbVendorNameId = vendorNameId
, dbVendorIdName = vendorIdName
, dbProducts = productDB
, dbClasses = classDB
, 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
hexId d = do ds <- count d hexDigit
case readHex ds of
[(n, _)] -> return n
_ -> error "impossible"
label :: String -> Parser String ()
label n = string n >> char ' ' >> return ()
simpleSection :: String -> Int -> Parser String (IM.IntMap String)
simpleSection sym idSize = genericSection (string sym >> char ' ')
idSize fst $ return ()
genericSection :: (Parser String p)
-> Int
-> ((String, s) -> r)
-> Parser String s
-> Parser String (IM.IntMap r)
genericSection prefix idSize convert =
fmap (IM.fromList . map (second convert))
. many . try . genericItem prefix idSize
genericItem :: (Parser String p)
-> Int
-> Parser String s
-> Parser String (Int, (String, s))
genericItem prefix idSize sub = do
_ <- prefix
itemId <- hexId idSize
_ <- count 2 $ char ' '
itemName <- restOfLine
s <- sub
return (itemId, (itemName, s))
vendorSection :: Parser String ( MP.Map String Int
, IM.IntMap String
, IM.IntMap ProductDB
)
vendorSection = do
xs <- many (try (vendorParser <?> "vendor"))
return ( MP.fromList [(name, vid) | (vid, name, _) <- xs]
, IM.fromList [(vid, name) | (vid, name, _) <- xs]
, IM.fromList [(vid, pdb) | (vid, _, pdb) <- xs]
)
vendorParser :: Parser String (Int, String, ProductDB)
vendorParser = do
vid <- hexId 4
_ <- count 2 $ char ' '
name <- restOfLine
products <- many (productParser <?> "product")
return ( vid
, name
, ( MP.fromList $ fmap swap products
, IM.fromList products
)
)
productParser :: Parser String (Int, String)
productParser = do _ <- tab
pid <- hexId 4
_ <- count 2 $ char ' '
name <- restOfLine
return (pid, name)
fromFile :: FilePath -> IO (Maybe IDDB)
fromFile = fmap parseDb . readFile
staticDb :: IO IDDB
staticDb = getDataFileName staticDbPath >>= fmap fromJust . fromFile
where
staticDbPath :: FilePath
staticDbPath = "usb_id_repo_db.txt"
dbURL :: String
dbURL = "http://linux-usb.org/usb.ids"