{-# LANGUAGE TypeFamilies #-}

-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

-- | Simple wrapper over privmsg to get time information via the CTCP
module Lambdabot.Plugin.IRC.Localtime (localtimePlugin) where

import Lambdabot.Plugin
import Lambdabot.Bot (ircPrivmsg')
import qualified Data.Map as M

type TimeMap = M.Map Nick  -- the person who's time we requested
                    [Nick] -- a list of targets waiting on this time

localtimePlugin :: Module TimeMap
localtimePlugin :: Module TimeMap
localtimePlugin = Module TimeMap
forall st. Module st
newModule
    { moduleDefState :: LB TimeMap
moduleDefState = TimeMap -> LB TimeMap
forall (m :: * -> *) a. Monad m => a -> m a
return TimeMap
forall k a. Map k a
M.empty

    , moduleCmds :: ModuleT TimeMap LB [Command (ModuleT TimeMap LB)]
moduleCmds = [Command (ModuleT TimeMap LB)]
-> ModuleT TimeMap LB [Command (ModuleT TimeMap LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"time")
            { aliases :: [String]
aliases = [String
"localtime"]
            , help :: Cmd (ModuleT TimeMap LB) ()
help = String -> Cmd (ModuleT TimeMap LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"time <user>. Print a user's local time. User's client must support ctcp pings."
            , process :: String -> Cmd (ModuleT TimeMap LB) ()
process = String -> Cmd (ModuleT TimeMap LB) ()
forall (m :: * -> *).
(MonadLBState m, LBState m ~ TimeMap) =>
String -> Cmd m ()
doLocalTime
            }
        , (String -> Command Identity
command String
"localtime-reply")
            { help :: Cmd (ModuleT TimeMap LB) ()
help = String -> Cmd (ModuleT TimeMap LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"time <user>. Print a user's local time. User's client must support ctcp pings."
            , process :: String -> Cmd (ModuleT TimeMap LB) ()
process = String -> Cmd (ModuleT TimeMap LB) ()
forall (m :: * -> *).
(MonadLBState m, LBState m ~ TimeMap) =>
String -> Cmd m ()
doReply
            }
        ]
    } :: Module TimeMap

-- record this person as a callback, for when we (asynchronously) get a result
doLocalTime :: (MonadLBState m, LBState m ~ M.Map Nick [Nick]) =>
               [Char] -> Cmd m ()
doLocalTime :: String -> Cmd m ()
doLocalTime [] = do
    Nick
n <- Cmd m Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    String -> Cmd m ()
forall (m :: * -> *).
(MonadLBState m, LBState m ~ TimeMap) =>
String -> Cmd m ()
doLocalTime (Nick -> String
nName Nick
n)

doLocalTime String
rawWho = do
    Nick
whoAsked <- Cmd m Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
    Nick
whoToPing <- String -> Cmd m Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick (String -> Cmd m Nick) -> String -> Cmd m Nick
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
rawWho
    Nick
me <- Cmd m Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
    if Nick
whoToPing Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
/= Nick
me
        then do
            (LBState (Cmd m) -> LBState (Cmd m)) -> Cmd m ()
forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS ((LBState (Cmd m) -> LBState (Cmd m)) -> Cmd m ())
-> (LBState (Cmd m) -> LBState (Cmd m)) -> Cmd m ()
forall a b. (a -> b) -> a -> b
$ \LBState (Cmd m)
st -> ([Nick] -> [Nick] -> [Nick])
-> Nick -> [Nick] -> TimeMap -> TimeMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Nick] -> [Nick] -> [Nick]
forall a. [a] -> [a] -> [a]
(++) Nick
whoToPing [Nick
whoAsked] TimeMap
LBState (Cmd m)
st
            -- this is a CTCP time call, which returns a NOTICE
            LB () -> Cmd m ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd m ()) -> LB () -> Cmd m ()
forall a b. (a -> b) -> a -> b
$ Nick -> String -> LB ()
ircPrivmsg' Nick
whoToPing (String
"\^ATIME\^A")     -- has to be raw
        else String -> Cmd m ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"I live on the internet, do you expect me to have a local time?"

-- the Base module caught the NOTICE TIME, mapped it to a PRIVMGS, and here it is :)
doReply :: (MonadLBState m, LBState m ~ M.Map Nick [Nick]) =>
           [Char] -> Cmd m ()
doReply :: String -> Cmd m ()
doReply String
text = do
    let (String
whoGotPinged', String
time') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
text
        time :: String
time = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
time'
    Nick
whoGotPinged <- String -> Cmd m Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
whoGotPinged'

    [Nick]
targets <- (LBState (Cmd m) -> (LBState (Cmd m) -> Cmd m ()) -> Cmd m [Nick])
-> Cmd m [Nick]
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (Cmd m) -> (LBState (Cmd m) -> Cmd m ()) -> Cmd m [Nick])
 -> Cmd m [Nick])
-> (LBState (Cmd m)
    -> (LBState (Cmd m) -> Cmd m ()) -> Cmd m [Nick])
-> Cmd m [Nick]
forall a b. (a -> b) -> a -> b
$ \LBState (Cmd m)
st LBState (Cmd m) -> Cmd m ()
set -> do
        case Nick -> TimeMap -> Maybe [Nick]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Nick
whoGotPinged TimeMap
LBState (Cmd m)
st of
            Maybe [Nick]
Nothing -> [Nick] -> Cmd m [Nick]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just [Nick]
xs -> do LBState (Cmd m) -> Cmd m ()
set (Nick -> [Nick] -> TimeMap -> TimeMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Nick
whoGotPinged [] TimeMap
LBState (Cmd m)
st) -- clear the callback state
                          [Nick] -> Cmd m [Nick]
forall (m :: * -> *) a. Monad m => a -> m a
return [Nick]
xs
    String
whoGotPinged'' <- Nick -> Cmd m String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick Nick
whoGotPinged
    let txt :: String
txt = String
"Local time for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
whoGotPinged'' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
time
    LB () -> Cmd m ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd m ()) -> LB () -> Cmd m ()
forall a b. (a -> b) -> a -> b
$ ((Nick -> LB ()) -> [Nick] -> LB ())
-> [Nick] -> (Nick -> LB ()) -> LB ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Nick -> LB ()) -> [Nick] -> LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Nick]
targets ((Nick -> LB ()) -> LB ()) -> (Nick -> LB ()) -> LB ()
forall a b. (a -> b) -> a -> b
$ (Nick -> String -> LB ()) -> String -> Nick -> LB ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Nick -> String -> LB ()
ircPrivmsg' String
txt