{-# Language OverloadedStrings #-}

{-|
Module      : Client.Hook.Znc.Buffextras
Description : Hook to remap znc buffextras messages
Copyright   : (c) Dan Doel, 2016
License     : ISC
Maintainer  : dan.doel@gmail.com

This hook remaps output from the znc buffextras plugin to the
actual IRC commands they represent, so that they can show up
normally in the client output.

-}

module Client.Hook.Znc.Buffextras
  ( buffextrasHook
  ) where

import Client.Hook (MessageHook(MessageHook), MessageResult(..))
import Data.Attoparsec.Text as P
import Data.Text as Text (Text, null, words)
import Irc.Identifier (Identifier, mkId)
import Irc.Message (IrcMsg(Topic, Privmsg, Join, Quit, Part, Nick, Mode, Kick), Source(Source, srcUser))
import Irc.RawIrcMsg (prefixParser, simpleTokenParser)
import Irc.UserInfo (UserInfo(userNick))

-- | Map ZNC's buffextras messages to native client messages.
-- Set debugging to pass through buffextras messages that
-- the hook doesn't understand.
buffextrasHook :: [Text] {- ^ arguments -} -> Maybe MessageHook
buffextrasHook :: [Text] -> Maybe MessageHook
buffextrasHook [Text]
args =
  case [Text]
args of
    []        -> forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"buffextras" Bool
False (Bool -> IrcMsg -> MessageResult
remap Bool
False))
    [Text
"debug"] -> forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"buffextras" Bool
False (Bool -> IrcMsg -> MessageResult
remap Bool
True))
    [Text]
_         -> forall a. Maybe a
Nothing

remap ::
  Bool {- ^ enable debugging -} ->
  IrcMsg -> MessageResult
remap :: Bool -> IrcMsg -> MessageResult
remap Bool
debug (Privmsg Source
user Identifier
chan Text
msg)
  | UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user) forall a. Eq a => a -> a -> Bool
== Identifier
"*buffextras"
  , Right IrcMsg
newMsg <- forall a. Parser a -> Text -> Either String a
parseOnly (Identifier -> Parser IrcMsg
prefixedParser Identifier
chan) Text
msg
  = IrcMsg -> MessageResult
RemapMessage IrcMsg
newMsg

  | UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user) forall a. Eq a => a -> a -> Bool
== Identifier
"*buffextras"
  , Bool -> Bool
not Bool
debug
  = MessageResult
OmitMessage

remap Bool
_ IrcMsg
_ = MessageResult
PassMessage

prefixedParser :: Identifier -> Parser IrcMsg
prefixedParser :: Identifier -> Parser IrcMsg
prefixedParser Identifier
chan = do
    UserInfo
pfx <- Parser UserInfo
prefixParser
    let src :: Source
src = UserInfo -> Text -> Source
Source UserInfo
pfx Text
""
    forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Source -> Identifier -> Text -> Text -> IrcMsg
Join Source
src Identifier
chan Text
"" Text
"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"joined"
      , Source -> Maybe Text -> IrcMsg
Quit Source
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
filterEmpty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"quit:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
P.takeText
      , Source -> Identifier -> Maybe Text -> IrcMsg
Part Source
src Identifier
chan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
filterEmpty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"parted:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
P.takeText
      , Source -> Identifier -> IrcMsg
Nick Source
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
mkId forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"is now known as" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
simpleTokenParser
      , Source -> Identifier -> [Text] -> IrcMsg
Mode Source
src Identifier
chan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"set mode:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Text]
allTokens
      , Source -> Identifier -> Identifier -> Text -> IrcMsg
Kick Source
src Identifier
chan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"kicked" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Identifier
parseId forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser ()
skipToken Text
"with reason:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
P.takeText
      , Source -> Identifier -> Text -> IrcMsg
Topic Source
src Identifier
chan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
skipToken Text
"changed the topic to:" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
P.takeText
      ]

allTokens :: Parser [Text]
allTokens :: Parser [Text]
allTokens = Text -> [Text]
Text.words forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
P.takeText

skipToken :: Text -> Parser ()
skipToken :: Text -> Parser ()
skipToken Text
m = Text -> Parser Text
string Text
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
P.skipWhile (forall a. Eq a => a -> a -> Bool
==Char
' ')

parseId :: Parser Identifier
parseId :: Parser Identifier
parseId = Text -> Identifier
mkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
simpleTokenParser

filterEmpty :: Text -> Maybe Text
filterEmpty :: Text -> Maybe Text
filterEmpty Text
txt
  | Text -> Bool
Text.null Text
txt = forall a. Maybe a
Nothing
  | Bool
otherwise     = forall a. a -> Maybe a
Just Text
txt