{-# 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
    []        -> MessageHook -> Maybe MessageHook
forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"buffextras" Bool
False (Bool -> IrcMsg -> MessageResult
remap Bool
False))
    [Text
"debug"] -> MessageHook -> Maybe MessageHook
forall a. a -> Maybe a
Just (Text -> Bool -> (IrcMsg -> MessageResult) -> MessageHook
MessageHook Text
"buffextras" Bool
False (Bool -> IrcMsg -> MessageResult
remap Bool
True))
    [Text]
_         -> Maybe MessageHook
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) Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"*buffextras"
  , Right IrcMsg
newMsg <- Parser IrcMsg -> Text -> Either String IrcMsg
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) Identifier -> Identifier -> Bool
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
""
    [Parser IrcMsg] -> Parser IrcMsg
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Source -> Identifier -> Text -> Text -> IrcMsg
Join Source
src Identifier
chan Text
"" Text
"" IrcMsg -> Parser Text () -> Parser IrcMsg
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text ()
skipToken Text
"joined"
      , Source -> Maybe Text -> IrcMsg
Quit Source
src (Maybe Text -> IrcMsg) -> (Text -> Maybe Text) -> Text -> IrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
filterEmpty (Text -> IrcMsg) -> Parser Text () -> Parser Text (Text -> IrcMsg)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text ()
skipToken Text
"quit:" Parser Text (Text -> IrcMsg) -> Parser Text Text -> Parser IrcMsg
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
P.takeText
      , Source -> Identifier -> Maybe Text -> IrcMsg
Part Source
src Identifier
chan (Maybe Text -> IrcMsg) -> (Text -> Maybe Text) -> Text -> IrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
filterEmpty (Text -> IrcMsg) -> Parser Text () -> Parser Text (Text -> IrcMsg)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text ()
skipToken Text
"parted:" Parser Text (Text -> IrcMsg) -> Parser Text Text -> Parser IrcMsg
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
P.takeText
      , Source -> Identifier -> IrcMsg
Nick Source
src (Identifier -> IrcMsg) -> (Text -> Identifier) -> Text -> IrcMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
mkId (Text -> IrcMsg) -> Parser Text () -> Parser Text (Text -> IrcMsg)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text ()
skipToken Text
"is now known as" Parser Text (Text -> IrcMsg) -> Parser Text Text -> Parser IrcMsg
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
simpleTokenParser
      , Source -> Identifier -> [Text] -> IrcMsg
Mode Source
src Identifier
chan ([Text] -> IrcMsg)
-> Parser Text () -> Parser Text ([Text] -> IrcMsg)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text ()
skipToken Text
"set mode:" Parser Text ([Text] -> IrcMsg)
-> Parser Text [Text] -> Parser IrcMsg
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [Text]
allTokens
      , Source -> Identifier -> Identifier -> Text -> IrcMsg
Kick Source
src Identifier
chan (Identifier -> Text -> IrcMsg)
-> Parser Text () -> Parser Text (Identifier -> Text -> IrcMsg)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text ()
skipToken Text
"kicked" Parser Text (Identifier -> Text -> IrcMsg)
-> Parser Text Identifier -> Parser Text (Text -> IrcMsg)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Identifier
parseId Parser Text (Text -> IrcMsg)
-> Parser Text () -> Parser Text (Text -> IrcMsg)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text ()
skipToken Text
"with reason:" Parser Text (Text -> IrcMsg) -> Parser Text Text -> Parser IrcMsg
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
P.takeText
      , Source -> Identifier -> Text -> IrcMsg
Topic Source
src Identifier
chan (Text -> IrcMsg) -> Parser Text () -> Parser Text (Text -> IrcMsg)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text ()
skipToken Text
"changed the topic to:" Parser Text (Text -> IrcMsg) -> Parser Text Text -> Parser IrcMsg
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
P.takeText
      ]

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

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

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

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