diff --git a/PrettyDevList.hs b/PrettyDevList.hs --- a/PrettyDevList.hs +++ b/PrettyDevList.hs @@ -10,7 +10,7 @@ , ppDevices ) where --- ansi-wl-pprint +-- from ansi-wl-pprint: import Text.PrettyPrint.ANSI.Leijen ( Doc, Pretty, SimpleDoc(..) , (<+>), (<$>), (<>) , align, char, dquotes, empty, fill, hcat @@ -21,7 +21,7 @@ , underline, white, yellow ) --- base +-- from base: import Control.Exception ( catch ) import Control.Monad ( (>>=), fail, liftM, mapM, return ) import Data.Bool ( Bool(False, True) ) @@ -40,16 +40,16 @@ import Text.Printf ( PrintfArg, printf ) import Text.Show ( Show, show ) --- base-unicode-symbols +-- from base-unicode-symbols: import Control.Arrow.Unicode ( (⋙) ) import Data.Function.Unicode ( (∘) ) import Data.Eq.Unicode ( (≡) ) import Prelude.Unicode ( (⋅) ) --- bytestring +-- from bytestring: import Data.ByteString.Char8 ( ByteString, unpack ) --- usb +-- from usb: import System.USB.Descriptors ( DeviceDesc , deviceClass, deviceConfigs , deviceManufacturerStrIx @@ -85,19 +85,25 @@ , 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 +-- from usb-id-database: import System.USB.IDDB ( IDDB , vendorName, productName , className, subClassName, protocolName , langName, subLangName ) +-- from usb-safe: +import System.USB.Safe ( withDevice + , getStrDescFirstLang + , getLanguages + ) + + ------------------------------------------------------------------------------- -- Pretty printing styles @@ -210,7 +216,7 @@ ppStringDesc ∷ PPStyle → Device → StrIx → IO Doc ppStringDesc _ _ 0 = return empty ppStringDesc style dev ix = catchUSBException - ( with dev $ \devH → + ( withDevice dev $ \devH → fmap (descrStyle style) $ getStrDescFirstLang devH ix @@ -279,7 +285,7 @@ ppLanguageList ∷ PPStyle → IDDB → Device → IO Doc ppLanguageList style db dev = - catchUSBException ( with dev + catchUSBException ( withDevice dev $ fmap (hsep ∘ punctuate (text ", ") ∘ map (ppLanguage style db)) ∘ getLanguages ) 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.5 +version: 0.1.0.6 cabal-version: >= 1.6 build-type: Simple stability: beta @@ -22,9 +22,9 @@ , base >= 4.0 && < 4.3 , base-unicode-symbols >= 0.1.1 && < 0.3 , bytestring >= 0.9.1 && < 0.10 - , cmdargs == 0.1.* - , usb == 0.3.* - , usb-safe >= 0.4 && < 0.7 + , cmdargs == 0.3.* + , usb == 0.5.* + , usb-safe == 0.8.* , usb-id-database >= 0.4.0.2 && < 0.5 ghc-options: -Wall -fno-warn-orphans main-is: ls-usb.hs diff --git a/ls-usb.hs b/ls-usb.hs --- a/ls-usb.hs +++ b/ls-usb.hs @@ -2,51 +2,50 @@ module Main where --- ansi-wl-pprint -import Text.PrettyPrint.ANSI.Leijen ( putDoc, plain ) +-- from ansi-wl-pprint: +import Text.PrettyPrint.ANSI.Leijen ( putDoc, plain ) --- base -import Control.Monad ( (>>=), (>>), (=<<), fail ) -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 ( fromIntegral ) -import System.IO ( IO, putStrLn ) -import Text.Show ( Show ) +-- from base: +import Control.Monad ( (>>=), (>>), (=<<), fail ) +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 ( fromIntegral ) +import System.IO ( IO, putStrLn ) +import Text.Show ( Show ) --- base-unicode-symbols -import Data.Function.Unicode ( (∘) ) -import Data.Bool.Unicode ( (∧), (∨) ) -import Data.Eq.Unicode ( (≡) ) +-- from base-unicode-symbols: +import Data.Function.Unicode ( (∘) ) +import Data.Bool.Unicode ( (∧), (∨) ) +import Data.Eq.Unicode ( (≡) ) --- CmdArgs -import System.Console.CmdArgs ( Mode - , (&), (&=) - , mode, def, explicit, flag, typ, text - , prog, helpSuffix, cmdArgs, isLoud - ) +-- from cmdargs: +import System.Console.CmdArgs.Implicit ( (&=) + , cmdArgs, def, details, explicit, help + , isLoud, name, summary, typ, verbosity + ) --- ls-usb (this program) -import PrettyDevList ( ppDevices - , brightStyle, darkStyle - ) +-- from ls-usb (this package): +import PrettyDevList ( ppDevices + , brightStyle, darkStyle + ) --- usb -import System.USB.Initialization ( newCtx ) -import System.USB.Enumeration ( Device - , getDevices, deviceDesc - , busNumber, deviceAddress - ) -import System.USB.Descriptors ( VendorId, ProductId - , deviceVendorId, deviceProductId - ) +-- from 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 ) +-- from usb-id-database: +import System.USB.IDDB.LinuxUsbIdRepo ( staticDb ) ------------------------------------------------------------------------------- @@ -60,27 +59,27 @@ , darker ∷ Bool } deriving (Show, Data, Typeable) -defaultOpts ∷ Mode Options -defaultOpts = mode Options - { vid = def &= explicit & flag "vid" & typ "VID" - & text "List devices with this VID" - , pid = def &= explicit & flag "pid" & typ "PID" - & text "List devices with this PID" - , bus = def &= explicit & flag "b" & flag "bus" & typ "BUS" - & text "List devices on this BUS" - , address = def &= explicit & flag "a" & flag "address" & typ "ADDR" - & text "List devices with this ADDRESS" - , nocolour = def &= explicit & flag "nc" & flag "nocolour" & flag "nocolor" - & text "Don't colour the output" - , darker = def &= explicit & flag "dark" - & text "Use darker colours (for bright backgrounds)" - } &= prog "ls-usb" - & text "Lists connected USB devices" - & helpSuffix ["Please ensure you have sufficient rights before running with higher verbosity"] +defaultOpts ∷ Options +defaultOpts = Options + { vid = def &= explicit &= name "vid" &= typ "VID" + &= help "List devices with this VID" + , pid = def &= explicit &= name "pid" &= typ "PID" + &= help "List devices with this PID" + , bus = def &= explicit &= name "b" &= name "bus" &= typ "BUS" + &= help "List devices on this BUS" + , address = def &= explicit &= name "a" &= name "address" &= typ "ADDR" + &= help "List devices with this ADDRESS" + , nocolour = def &= explicit &= name "nc" &= name "nocolour" &= name "nocolor" + &= help "Don't colour the output" + , darker = def &= explicit &= name "dark" + &= help "Use darker colours (for bright backgrounds)" + } &= verbosity + &= help "Lists connected USB devices" + &= summary "ls-usb 0.1.0.5, (C) Roel van Dijk 2009-2010" + &= details ["Please ensure you have sufficient rights before running with higher verbosity"] main ∷ IO () -main = do opts ← cmdArgs "ls-usb 0.1.0.5, (C) Roel van Dijk 2009-2010" - [defaultOpts] +main = do opts ← cmdArgs defaultOpts verbose ← isLoud db ← staticDb ctx ← newCtx