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.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 diff --git a/ls-usb.hs b/ls-usb.hs --- a/ls-usb.hs +++ b/ls-usb.hs @@ -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