diff --git a/PrettyDevList.hs b/PrettyDevList.hs --- a/PrettyDevList.hs +++ b/PrettyDevList.hs @@ -8,25 +8,90 @@ , ppDevices ) where -import Prelude hiding ( catch ) +-- ansi-wl-pprint +import Text.PrettyPrint.ANSI.Leijen ( Doc, Pretty, SimpleDoc(..) + , (<+>), (<$>), (<>) + , align, char, dquotes, empty, fill, hcat + , hsep, indent, int, pretty, punctuate + , renderPretty, text, vcat + , bold, cyan, dullred, green, magenta + , oncyan, ongreen, onmagenta, onyellow, red + , underline, white, yellow + ) -import Control.Arrow ( (>>>) ) -import Control.Exception ( catch ) -import Control.Monad ( liftM, mapM ) -import Data.ByteString.Char8 ( ByteString, unpack ) -import Data.Char ( toLower ) -import Data.List ( intersperse, partition, transpose ) -import Data.Word ( Word8, Word16 ) -import Prelude.Unicode ( (∘), (⋅) ) -import System.USB -import System.USB.IDDB ( IDDB - , vendorName, productName - , className, subClassName, protocolName - , langName, subLangName - ) -import Text.PrettyPrint.ANSI.Leijen -import Text.Printf ( PrintfArg, printf ) +-- base +import Control.Arrow ( (>>>) ) +import Control.Exception ( catch ) +import Control.Monad ( fmap, liftM, mapM, return ) +import Data.Bool ( Bool(False, True) ) +import Data.Char ( String, toLower ) +import Data.Function ( ($), id ) +import Data.Int ( Int ) +import Data.List ( intersperse, length, map, maximum + , partition, transpose, zipWith + ) +import Data.Maybe ( maybe ) +import Data.Word ( Word8, Word16 ) +import Prelude ( (+), fromIntegral ) +import System.IO ( IO ) +import Text.Printf ( PrintfArg, printf ) +import Text.Show ( Show, show ) +-- base-unicode-symbols +import Prelude.Unicode ( (∘), (⋅), (≡) ) + +-- bytestring +import Data.ByteString.Char8 ( ByteString, unpack ) + +-- usb +import System.USB.Descriptors ( DeviceDesc + , deviceClass, deviceConfigs + , deviceManufacturerStrIx + , deviceMaxPacketSize0, deviceNumConfigs + , deviceProductId, deviceProductStrIx + , deviceProtocol, deviceReleaseNumber + , deviceSerialNumberStrIx, deviceSubClass + , deviceUSBSpecReleaseNumber, deviceVendorId + , BCD4 + , ConfigDesc + , configAttribs, configInterfaces + , configMaxPower, configNumInterfaces + , configStrIx, configValue + , DeviceStatus + , remoteWakeup, selfPowered + , InterfaceDesc + , interfaceAltSetting, interfaceClass + , interfaceEndpoints, interfaceNumber + , interfaceProtocol, interfaceStrIx + , interfaceSubClass + , EndpointDesc + , endpointAddress, endpointAttribs + , endpointInterval, endpointMaxPacketSize + , endpointRefresh, endpointSynchAddress + , EndpointAddress + , endpointNumber, transferDirection + , TransferDirection(In, Out) + , TransferType(Isochronous) + , Synchronization(NoSynchronization) + , Usage + , MaxPacketSize + , maxPacketSize, transactionOpportunities + , TransactionOpportunities(Zero, One, Two) + , LangId, StrIx + ) +import System.USB.Safe ( with, getStrDescFirstLang, getLanguages ) +import System.USB.Enumeration ( Device + , deviceDesc, busNumber, deviceAddress + ) +import System.USB.Exceptions ( USBException ) + +-- usb-id-database +import System.USB.IDDB ( IDDB + , vendorName, productName + , className, subClassName, protocolName + , langName, subLangName + ) + ------------------------------------------------------------------------------- -- Pretty printing styles @@ -139,7 +204,7 @@ ppStringDesc ∷ PPStyle → Device → StrIx → IO Doc ppStringDesc _ _ 0 = return empty ppStringDesc style dev ix = catchUSBException - ( withDeviceHandle dev $ \devH → + ( with dev $ \devH → liftM (descrStyle style) $ getStrDescFirstLang devH ix @@ -208,7 +273,7 @@ ppLanguageList ∷ PPStyle → IDDB → Device → IO Doc ppLanguageList style db dev = - catchUSBException ( withDeviceHandle dev + catchUSBException ( with dev $ fmap (hsep ∘ punctuate (text ", ") ∘ map (ppLanguage style db)) ∘ getLanguages ) @@ -233,8 +298,8 @@ busDoc = ppAddr style $ busNumber dev devAddrDoc = ppAddr style $ deviceAddress dev - return $ text "Bus" <+> busDoc - <+> text "Device" <+> devAddrDoc <> char ':' + return $ text "Bus" <+> busDoc + <+> text "Address" <+> devAddrDoc <> char ':' <+> text "ID" <+> (usbNumStyle style) (ppId vid) <> char ':' <> (usbNumStyle style) (ppId pid) @@ -351,8 +416,8 @@ classDoc = ppClass style db classId subClassDoc = ppSubClass style db classId subClassId protocolDoc = ppProtocol style db classId subClassId protocolId - (inEndpts, outEndpts) = - partition ((==) In ∘ transferDirection ∘ endpointAddress) + (inEndpts, outEndpts) = + partition ((In ≡) ∘ transferDirection ∘ endpointAddress) $ interfaceEndpoints ifDesc strDesc ← ppStringDesc style dev stringIx diff --git a/ls-usb.cabal b/ls-usb.cabal --- a/ls-usb.cabal +++ b/ls-usb.cabal @@ -1,5 +1,5 @@ name: ls-usb -version: 0.1.0.2 +version: 0.1.0.3 cabal-version: >= 1.6 build-type: Simple stability: experimental @@ -14,13 +14,14 @@ A small utility that lists USB devices connected to your system. executable ls-usb - build-depends: ansi-wl-pprint >= 0.5.1 && < 0.6 - , base >= 4.0 && < 4.2 - , bytestring >= 0.9.1.4 && < 0.10 - , cmdargs == 0.1.* - , unicode-symbols == 0.1.* - , usb == 0.3.* - , usb-id-database == 0.4.* + build-depends: ansi-wl-pprint >= 0.5.1 && < 0.6 + , base >= 4.0 && < 4.3 + , base-unicode-symbols == 0.1.* + , bytestring >= 0.9.1.4 && < 0.10 + , cmdargs == 0.1.* + , usb == 0.3.* + , usb-safe == 0.4.* + , usb-id-database == 0.4.* ghc-options: -Wall -fno-warn-orphans main-is: ls-usb.hs other-modules: PrettyDevList diff --git a/ls-usb.hs b/ls-usb.hs --- a/ls-usb.hs +++ b/ls-usb.hs @@ -3,16 +3,51 @@ module Main where +-- ansi-wl-pprint +import Text.PrettyPrint.ANSI.Leijen ( putDoc, plain ) + +-- base +import Control.Monad ( (=<<) ) +import Data.Bool ( Bool(False, True), otherwise ) +import Data.Data ( Data ) +import Data.Function ( ($), const, id ) +import Data.Int ( Int ) +import Data.List ( filter, foldr, map ) +import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) -import Prelude.Unicode ( (∘), (∧), (∨), (≡)) +import Prelude ( fromIntegral ) +import System.IO ( IO, putStrLn ) +import Text.Show ( Show ) + +-- base-unicode-symbols +import Prelude.Unicode ( (∘), (∧), (∨), (≡) ) + +-- CmdArgs +import System.Console.CmdArgs ( Mode + , (&), (&=) + , mode, def, explicit, flag, typ, text + , prog, helpSuffix, cmdArgs, isLoud + ) + +-- ls-usb (this program) import PrettyDevList ( ppDevices , brightStyle, darkStyle ) -import System.Console.CmdArgs -import System.USB + +-- usb +import System.USB.Initialization ( newCtx ) +import System.USB.Enumeration ( Device + , getDevices, deviceDesc + , busNumber, deviceAddress + ) +import System.USB.Descriptors ( VendorId, ProductId + , deviceVendorId, deviceProductId + ) + +-- usb-id-database import System.USB.IDDB.LinuxUsbIdRepo ( staticDb ) -import Text.PrettyPrint.ANSI.Leijen ( putDoc, plain ) + ------------------------------------------------------------------------------- -- Main @@ -43,7 +78,7 @@ & helpSuffix ["Please ensure you have sufficient rights before running with higher verbosity"] main ∷ IO () -main = do opts ← cmdArgs "ls-usb 0.1.0.1, (C) Roel van Dijk 2009" +main = do opts ← cmdArgs "ls-usb 0.1.0.3, (C) Roel van Dijk 2009" [defaultOpts] verbose ← isLoud db ← staticDb @@ -51,7 +86,7 @@ let style | darker opts = darkStyle | otherwise = brightStyle (putDoc ∘ if nocolour opts then plain else id) - =<< ppDevices style db verbose + =<< ppDevices style db verbose ∘ filter (filterFromOpts opts) =<< getDevices ctx putStrLn "" @@ -63,7 +98,7 @@ , map (matchBus ∘ fromIntegral) ∘ bus , map (matchDevAddr ∘ fromIntegral) ∘ address ] - + ------------------------------------------------------------------------------- -- Filters