glirc 2.23 → 2.24
raw patch · 5 files changed
+96/−22 lines, 5 filesdep ~vty
Dependency ranges changed: vty
Files
- ChangeLog.md +5/−0
- glirc.cabal +2/−2
- src/Client/Commands.hs +59/−8
- src/Client/Commands/Arguments/Parser.hs +1/−1
- test/Main.hs +29/−11
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for glirc2 +## 2.24++* `/query` now takes a message parameter and tab-completes+ like `/msg`.+ ## 2.23 * CONFIGURATION FILE CHANGE: Relative paths are now resolved
glirc.cabal view
@@ -1,5 +1,5 @@ name: glirc-version: 2.23+version: 2.24 synopsis: Console IRC client description: Console IRC client .@@ -154,7 +154,7 @@ unix >=2.7 && <2.8, unordered-containers >=0.2.7 && <0.3, vector >=0.11 && <0.13,- vty >=5.11.1 && <5.16+ vty >=5.11.1 && <5.18 test-suite test type: exitcode-stdio-1.0
src/Client/Commands.hs view
@@ -483,7 +483,35 @@ $ ClientCommand cmdFocus tabFocus , Command- ("query" :| ["c", "channel"])+ ("query" :| ["q"])+ (liftA2 (,) (simpleToken "target") (remainingArg "message"))+ "\^BParameters:\^B\n\+ \\n\+ \ target: Focus name\n\+ \ message: Optional message\n\+ \\n\+ \\^BDescription:\^B\n\+ \\n\+ \ This command switches the client focus to the given\n\+ \ target and optionally sends a message to that target.\n\+ \\n\+ \ Channel: \^_#channel\^_\n\+ \ Channel: \^_network\^_:\^_#channel\^_\n\+ \ User: \^_nick\^_\n\+ \ User: \^_network\^_:\^_nick\^_\n\+ \\n\+ \\^BExamples:\^B\n\+ \\n\+ \ /q fn:#haskell\n\+ \ /q #haskell\n\+ \ /q lambdabot @messages\n\+ \ /q irc_friend How are you?\n\+ \\n\+ \\^BSee also:\^B msg channel focus\n"+ $ ClientCommand cmdQuery simpleClientTab++ , Command+ ("c" :| ["channel"]) (simpleToken "focus") "\^BParameters:\^B\n\ \\n\@@ -510,7 +538,7 @@ \ /c *:\n\ \\n\ \\^BSee also:\^B focus\n"- $ ClientCommand cmdQuery tabQuery+ $ ClientCommand cmdChannel tabChannel , Command (pure "clear")@@ -1779,20 +1807,43 @@ commandSuccess $ changeFocus (ChannelFocus network channelId) st - -- | @/query@ command. Takes a channel or nickname and switches -- focus to that target on the current network.-cmdQuery :: ClientCommand String-cmdQuery st channel =+cmdQuery :: ClientCommand (String, String)+cmdQuery st (target, msg) =+ case parseFocus (views clientFocus focusNetwork st) target of+ Just (ChannelFocus net tgt)++ | null msg -> commandSuccess st'++ | Just cs <- preview (clientConnection net) st ->+ do let tgtTxt = idText tgt+ msgTxt = Text.pack msg+ sendMsg cs (ircPrivmsg tgtTxt msgTxt)+ chatCommand+ (\src tgt1 -> Privmsg src tgt1 msgTxt)+ tgtTxt cs st'+ where+ firstTgt = mkId (Text.takeWhile (','/=) (idText tgt))+ st' = changeFocus (ChannelFocus net firstTgt) st++ _ -> commandFailureMsg "Bad target" st+++-- | @/channel@ command. Takes a channel or nickname and switches+-- focus to that target on the current network.+cmdChannel :: ClientCommand String+cmdChannel st channel = case parseFocus (views clientFocus focusNetwork st) channel of Just focus -> commandSuccess (changeFocus focus st) Nothing -> commandFailureMsg "No current network" st --- | Tab completion for @/query@-tabQuery ::+-- | Tab completion for @/channel@. Tab completion uses pre-existing+-- windows.+tabChannel :: Bool {- ^ reversed order -} -> ClientCommand String-tabQuery isReversed st _ =+tabChannel isReversed st _ = simpleTabCompletion plainWordCompleteMode [] completions isReversed st where completions = currentNet <> allWindows
src/Client/Commands/Arguments/Parser.hs view
@@ -61,5 +61,5 @@ do xs <- get let (t, xs') = break (' '==) (dropWhile (' '==) xs) guard (not (null t))- put (drop 1 xs')+ put xs' return t
test/Main.hs view
@@ -2,7 +2,7 @@ {-| Module : Main Description : Tests for the glirc library-Copyright : (c) Eric Mertens, 2016+Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com @@ -11,7 +11,9 @@ -} module Main (main) where -import Client.Commands.Arguments+import Client.Commands.Arguments.Spec+import Client.Commands.Arguments.Parser+import Control.Applicative import System.Exit import Test.HUnit @@ -29,27 +31,43 @@ argumentParserTests = test [ assertEqual "no arg empty" (Just ())- (parseArguments NoArg "")+ (parse () (pure ()) "") , assertEqual "no arg white" (Just ())- (parseArguments NoArg " ")+ (parse () (pure ()) " ") , assertEqual "no arg fail" Nothing- (parseArguments NoArg " a")+ (parse () (pure ()) " a") , assertEqual "required"- (Just ("argument",()))- (parseArguments (ReqTokenArg "field" NoArg) " argument ")+ (Just "argument")+ (parse () (simpleToken "field") " argument ") , assertEqual "optional 1"- (Just (Just ("argument",())))- (parseArguments (OptTokenArg "field" NoArg) " argument ")+ (Just (Just "argument"))+ (parse () (optionalArg (simpleToken "field")) " argument ") , assertEqual "optional 2" (Just Nothing)- (parseArguments (OptTokenArg "field" NoArg) " ")+ (parse () (optionalArg (simpleToken "field")) " ") , assertEqual "remaining" (Just "some stuff ")- (parseArguments (RemainingArg "field") " some stuff ")+ (parse () (remainingArg "field") " some stuff ")++ , assertEqual "token and empty remaining"+ (Just ("some", ""))+ (parse () (liftA2 (,) (simpleToken "first") (remainingArg "second")) " some")++ , assertEqual "token and empty remaining 1"+ (Just ("some", ""))+ (parse () (liftA2 (,) (simpleToken "first") (remainingArg "second")) " some ")++ , assertEqual "token and remaining"+ (Just ("some", "text here"))+ (parse () (liftA2 (,) (simpleToken "first") (remainingArg "second")) " some text here")++ , assertEqual "extra whitespace token and remaining"+ (Just ("some", " text here"))+ (parse () (liftA2 (,) (simpleToken "first") (remainingArg "second")) " some text here") ]