Added -v option to specify tags from command line.

1 files changed, 24 insertions, 12 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 4b5a1fd7..e95fa366 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -351,6 +351,9 @@ clientSession0 s sock cnum h = do
                                 else throwIO e
 
 
+parseDebugTag :: String -> Maybe DebugTag
+parseDebugTag s' = readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s')
+
 clientSession :: Session -> t1 -> t -> ClientHandle -> IO ()
 clientSession s@Session{..} sock cnum h = do
     line <- dropWhile isSpace <$> hGetClientLine h
@@ -638,7 +641,7 @@ clientSession s@Session{..} sock cnum h = do
                 hPutClient h ""
 
         ("quiet",s) | s' <- strp s
-                    , Just (tag::DebugTag) <- readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s')
+                    , Just (tag::DebugTag) <- parseDebugTag s'
                     -> cmd0 $ do
                 setQuiet tag
                 hPutClient h $ "Suppressing " ++ show tag ++ " messages."
@@ -658,7 +661,7 @@ clientSession s@Session{..} sock cnum h = do
                 showDebugTags
 
         ("verbose",s) | s' <- strp s
-                    , Just (tag::DebugTag) <- readMaybe ('X':map toUpper (take 1 s') ++ drop 1 s')
+                    , Just (tag::DebugTag) <- parseDebugTag s'
                     -> cmd0 $ do
                 setVerbose tag
                 hPutClient h $ "Showing " ++ show tag ++ " messages."
@@ -1291,19 +1294,21 @@ data Options = Options
     --
     --   [ 2 ] Log all stanzas, even pings.
     , verbosity :: Int
+    , verboseTags :: [DebugTag]
     }
  deriving (Eq,Show)
 
 sensibleDefaults :: Options
 sensibleDefaults = Options
-    { portbt    = "6881"
-    , porttox   = "33445"
-    , portxmpp  = "5222"
-    , portxmppS = "5269"
-    , ip6bt     = True
-    , ip6tox    = True
-    , dhtkey    = Nothing
-    , verbosity = 2
+    { portbt      = "6881"
+    , porttox     = "33445"
+    , portxmpp    = "5222"
+    , portxmppS   = "5269"
+    , ip6bt       = True
+    , ip6tox      = True
+    , dhtkey      = Nothing
+    , verbosity   = 2
+    , verboseTags = [XMisc]
     }
 
 -- bt=<port>,tox=<port>
@@ -1317,6 +1322,14 @@ parseArgs ("--dht-key":k:args) opts = parseArgs args opts
 parseArgs ("-4":args) opts         = parseArgs args opts
     { ip6bt  = False
     , ip6tox = False }
+parseArgs ("-v":tags:args) opts     = parseArgs args opts
+    { verboseTags = let gs = groupBy (const (/= ',')) tags
+                        ss = map (dropWhile (==',')) gs
+                        (ds0,as0) = partition (\s -> last (' ':s) == '-') ss
+                        as = mapMaybe parseDebugTag as0
+                        ds = mapMaybe (parseDebugTag . init) ds0
+                    in (verboseTags opts `union` as) \\ ds
+    }
 parseArgs (arg:args) opts          = parseArgs args opts
     { portbt    = fromMaybe (portbt opts)  $ Prelude.lookup "bt"  ports
     , porttox   = fromMaybe (porttox opts) $ Prelude.lookup "tox" ports
@@ -1434,8 +1447,7 @@ main = do
 
     -- Default: quiet all tags (except XMisc).
     forM [minBound .. maxBound] setQuiet
-    -- Default: verbose XMisc
-    setVerbose XMisc
+    forM (verboseTags opts) setVerbose
 
     (quitBt,btdhts,btips,baddrs) <- case portbt opts of
         "" -> return (return (), Map.empty,return [],[])