1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
-- | This module is an IRC plugin that generates and kills ducks
module Hsbot.Plugin.Duck
( duck
, theDuck
) where
import Control.Concurrent
import qualified Data.List as L
import Control.Monad.Reader
import qualified Network.IRC as IRC
import Prelude hiding (catch)
import System.Random
import Hsbot.Message
import Hsbot.Types
import Hsbot.Utils
-- | The duck plugin identity
duck :: PluginId
duck = PluginId
{ pluginName = "duck"
, pluginEp = theDuck "" 11 }
-- | An IRC plugin that generates and kills ducks
theDuck :: String -> Int -> Plugin (Env IO) ()
theDuck channel seconds = do
env <- lift ask
pEnv <- ask
secondsMVar <- liftIO $ newMVar seconds
killMVar <- liftIO newEmptyMVar
(liftIO . forkIO $ runReaderT (runReaderT (duckSpawner channel secondsMVar killMVar) pEnv) env) >>= lift . addThreadIdToQuitMVar
forever $ readMsg >>= eval
where
eval :: Message -> Plugin (Env IO) ()
eval (IncomingMsg msg)
| IRC.msg_command msg == "PRIVMSG" = answerMsg msg . isThereADuckToKillInThere . concat $ IRC.msg_params msg
| otherwise = return ()
eval _ = return ()
-- | Regularly spawns ducks on a channel, just waiting to be shot
duckSpawner :: String -> MVar Int -> MVar Int -> Plugin (Env IO) ()
duckSpawner channel secondsMVar killMVar = forever $ do
nbDucks <- liftIO . getStdRandom $ randomR (1,4)
liftIO $ putMVar killMVar nbDucks
thoseDucks <- liftIO $ someRandomDucks nbDucks ""
writeMsg . OutgoingMsg $ IRC.Message Nothing "PRIVMSG" [channel, thoseDucks]
secs <- liftIO $ readMVar secondsMVar
liftIO $ threadDelay (3000000 * secs)
-- | Shoot as many times are there are ducks in the initial string
isThereADuckToKillInThere :: String -> String
isThereADuckToKillInThere = concat . concatMap (\y -> map (\x -> if x `L.isInfixOf` y then "PAN! " else "") ducks) . words
someRandomDucks :: Int -> String -> IO String
someRandomDucks 0 theDucks = return theDucks
someRandomDucks nbDucks theDucks = do
whatDuck <- getStdRandom $ randomR (1,length ducks)
let thisDuck = ducks !! whatDuck
someRandomDucks (nbDucks -1 ) $ concat [thisDuck, " ", theDucks]
-- | There are many ways to hide as a duck, this function tries to cover most of them
ducks :: [String]
ducks = [ x : y : z | x <- nose, y <- face, z <- ["__/", "_/", "/"] ]
++ [ L.reverse $ x : y : z | x <- nose, y <- face, z <- ["__\\", "_\\", "\\"] ]
where
nose :: String
nose = "<>="
face :: String
face = "oO°@©®ð*òôóø"
|
