ls-usb 0.1.0.13 → 0.1.1
raw patch · 2 files changed
+81/−59 lines, 2 filesdep +cmdthelinedep −cmdargs
Dependencies added: cmdtheline
Dependencies removed: cmdargs
Files
- ls-usb.cabal +2/−2
- ls-usb.hs +79/−57
ls-usb.cabal view
@@ -1,5 +1,5 @@ name: ls-usb-version: 0.1.0.13+version: 0.1.1 cabal-version: >= 1.6 build-type: Simple stability: beta@@ -25,7 +25,7 @@ , base >= 4.0 && < 4.7 , base-unicode-symbols >= 0.1.1 && < 0.3 , text >= 0.1 && < 0.12- , cmdargs >= 0.3 && < 0.11+ , cmdtheline >= 0.2.1.1 && < 0.3 , usb >= 1.2 && < 1.3 , usb-id-database >= 0.4.0.2 && < 0.5 , vector >= 0.5 && < 0.11
ls-usb.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE UnicodeSyntax #-}@@ -18,32 +17,30 @@ -------------------------------------------------------------------------------- import "ansi-wl-pprint" Text.PrettyPrint.ANSI.Leijen ( putDoc, plain )+import "base" Control.Applicative ( (<$>), (<*>) ) import "base" Control.Monad ( (=<<) ) import "base" Data.Bool ( Bool(False, True), otherwise )-import "base" Data.Data ( Data ) import "base" Data.Function ( ($), const, id )-import "base" Data.Functor ( (<$>), fmap )+import "base" Data.Functor ( fmap ) import "base" Data.Int ( Int )-import "base" Data.List ( (++), foldr, map )-import "base" Data.Typeable ( Typeable )+import "base" Data.List ( foldr, map ) import "base" Data.Word ( Word8 ) import "base" Data.Version ( showVersion ) import "base" Prelude ( fromIntegral ) import "base" System.IO ( IO, putStrLn )-import "base" Text.Show ( Show ) #if __GLASGOW_HASKELL__ < 700 import "base" Control.Monad ( (>>=), (>>), fail ) #endif import "base-unicode-symbols" Data.Function.Unicode ( (∘) ) import "base-unicode-symbols" Data.Bool.Unicode ( (∧), (∨) ) import "base-unicode-symbols" Data.Eq.Unicode ( (≡) )-import "cmdargs" System.Console.CmdArgs.Implicit- ( (&=)- , cmdArgs, def, details, explicit, help- , isLoud, name, summary, typ, verbosity- )+import "cmdtheline" System.Console.CmdTheLine+ ( Term, TermInfo+ , defTI, flag, opt, optAll, optDoc, optInfo+ , optName, run, termName, termDoc, value, version+ ) import "this" PrettyDevList ( DescribedDevice(..), ppDevices, brightStyle, darkStyle )-import "this" Paths_ls_usb ( version )+import qualified "this" Paths_ls_usb as This ( version ) import "usb" System.USB.Initialization ( Verbosity(PrintNothing), newCtx, setDebug ) import "usb" System.USB.Enumeration@@ -53,64 +50,89 @@ import "usb-id-database" System.USB.IDDB.LinuxUsbIdRepo ( staticDb ) import qualified "vector" Data.Vector as V + -------------------------------------------------------------------------------- -- Main -------------------------------------------------------------------------------- -data Options = Options { vid ∷ [Int]- , pid ∷ [Int]- , bus ∷ [Int]- , address ∷ [Int]- , nocolour ∷ Bool- , darker ∷ Bool- } deriving (Show, Data, Typeable)+termInfo ∷ TermInfo+termInfo = defTI { termName = "ls-usb"+ , version = showVersion This.version+ , termDoc = "Lists connected USB devices."+ } -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 " ++ showVersion version ++ ", (C) Roel van Dijk 2009-2012")- &= details ["Please ensure you have sufficient rights before running with higher verbosity"]+verboseT ∷ Term Bool+verboseT = value $ flag (optInfo ["verbose", "V"])+ { optDoc = "Be verbose." } +colourT ∷ Term Bool+colourT = value $ opt True (optInfo ["colour", "c"])+ { optDoc = "Colour the output." }++darkerT ∷ Term Bool+darkerT = value $ flag (optInfo ["darker"])+ { optDoc = "Use darker colours (for bright backgrounds)." }++vidT ∷ Term [Int]+vidT = value $ optAll [] (optInfo ["vid", "v"])+ { optName = "VID"+ , optDoc = "List devices with this VID."+ }++pidT ∷ Term [Int]+pidT = value $ optAll [] (optInfo ["pid", "p"])+ { optName = "PID"+ , optDoc = "List devices with this PID."+ }++busT ∷ Term [Int]+busT = value $ optAll [] (optInfo ["bus", "b"])+ { optName = "BUS"+ , optDoc = "List devices on this BUS."+ }++addressT ∷ Term [Int]+addressT = value $ optAll [] (optInfo ["address", "a"])+ { optName = "ADDRESS"+ , optDoc = "List devices with this ADDRESS."+ }+ main ∷ IO ()-main = do opts ← cmdArgs defaultOpts- verbose ← isLoud- db ← staticDb- ctx ← newCtx- setDebug ctx PrintNothing+main = run (term, termInfo) - devs ← fmap (V.toList ∘ V.filter (filterFromOpts opts)) ∘- V.mapM (\dev -> DD dev <$> getDeviceDesc dev) =<<- getDevices ctx+term ∷ Term (IO ())+term = listUSB <$> verboseT+ <*> colourT+ <*> darkerT+ <*> vidT+ <*> pidT+ <*> busT+ <*> addressT - let style | darker opts = darkStyle- | otherwise = brightStyle+listUSB ∷ Bool → Bool → Bool → [Int] → [Int] → [Int] → [Int] → IO ()+listUSB verbose colour darker vs ps bs as = do+ db ← staticDb+ ctx ← newCtx+ setDebug ctx PrintNothing - (putDoc ∘ if nocolour opts then plain else id)- =<< ppDevices style db verbose devs+ devs ← fmap (V.toList ∘ V.filter filter) ∘+ V.mapM (\dev -> DD dev <$> getDeviceDesc dev) =<<+ getDevices ctx - putStrLn ""+ let style | darker = darkStyle+ | otherwise = brightStyle -filterFromOpts ∷ Options → F DescribedDevice-filterFromOpts opts = andF $ map (filterNonEmpty ∘ ($ opts))- [ map (matchVID ∘ fromIntegral) ∘ vid- , map (matchPID ∘ fromIntegral) ∘ pid- , map (matchBus ∘ fromIntegral) ∘ bus- , map (matchDevAddr ∘ fromIntegral) ∘ address- ]+ (putDoc ∘ if colour then id else plain) =<< ppDevices style db verbose devs + putStrLn ""+ where+ filter ∷ F DescribedDevice+ filter = andF $ map filterNonEmpty+ [ map (matchVID ∘ fromIntegral) vs+ , map (matchPID ∘ fromIntegral) ps+ , map (matchBus ∘ fromIntegral) bs+ , map (matchDevAddr ∘ fromIntegral) as+ ] -------------------------------------------------------------------------------- -- Filters