{-# 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 (Map Nick [Nick])
localtimePlugin = forall st. Module st
newModule
    { moduleDefState :: LB (Map Nick [Nick])
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
M.empty

    , moduleCmds :: ModuleT
  (Map Nick [Nick]) LB [Command (ModuleT (Map Nick [Nick]) LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"time")
            { aliases :: [String]
aliases = [String
"localtime"]
            , help :: Cmd (ModuleT (Map Nick [Nick]) LB) ()
help = 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 (Map Nick [Nick]) LB) ()
process = forall (m :: * -> *).
(MonadLBState m, LBState m ~ Map Nick [Nick]) =>
String -> Cmd m ()
doLocalTime
            }
        , (String -> Command Identity
command String
"localtime-reply")
            { help :: Cmd (ModuleT (Map Nick [Nick]) LB) ()
help = 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 (Map Nick [Nick]) LB) ()
process = forall (m :: * -> *).
(MonadLBState m, LBState m ~ Map Nick [Nick]) =>
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 :: forall (m :: * -> *).
(MonadLBState m, LBState m ~ Map Nick [Nick]) =>
String -> Cmd m ()
doLocalTime [] = do
    Nick
n <- forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    forall (m :: * -> *).
(MonadLBState m, LBState m ~ Map Nick [Nick]) =>
String -> Cmd m ()
doLocalTime (Nick -> String
nName Nick
n)

doLocalTime String
rawWho = do
    Nick
whoAsked <- forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
    Nick
whoToPing <- forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
' ') String
rawWho
    Nick
me <- forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
    if Nick
whoToPing forall a. Eq a => a -> a -> Bool
/= Nick
me
        then do
            forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd m)
st -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) Nick
whoToPing [Nick
whoAsked] LBState (Cmd m)
st
            -- this is a CTCP time call, which returns a NOTICE
            forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ Nick -> String -> LB ()
ircPrivmsg' Nick
whoToPing (String
"\^ATIME\^A")     -- has to be raw
        else 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 :: forall (m :: * -> *).
(MonadLBState m, LBState m ~ Map Nick [Nick]) =>
String -> Cmd m ()
doReply String
text = do
    let (String
whoGotPinged', String
time') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
':') String
text
        time :: String
time = forall a. Int -> [a] -> [a]
drop Int
1 String
time'
    Nick
whoGotPinged <- forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
whoGotPinged'

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