{-# 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

--}