summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Plugin/Duck.hs39
-rw-r--r--hsbot.cabal3
2 files changed, 33 insertions, 9 deletions
diff --git a/Hsbot/Plugin/Duck.hs b/Hsbot/Plugin/Duck.hs
index 7e8c521..4a09d28 100644
--- a/Hsbot/Plugin/Duck.hs
+++ b/Hsbot/Plugin/Duck.hs
@@ -4,26 +4,32 @@ module Hsbot.Plugin.Duck
, theDuck
) where
-import Control.Concurrent.Chan ()
+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 }
+ , pluginEp = theDuck "" 11 }
-- | An IRC plugin that generates and kills ducks
-theDuck :: Plugin (Env IO) ()
-theDuck = forever $ do
- msg <- readMsg
- eval msg
+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)
@@ -31,17 +37,34 @@ theDuck = forever $ do
| 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 :: [Char]
+ nose :: String
nose = "<>="
- face :: [Char]
+ face :: String
face = "oO°@©®ð*òôóø"
diff --git a/hsbot.cabal b/hsbot.cabal
index e60d115..ecbffe1 100644
--- a/hsbot.cabal
+++ b/hsbot.cabal
@@ -1,5 +1,5 @@
Name: hsbot
-Version: 0.4.9
+Version: 0.4.10
Cabal-version: >=1.2
Synopsis: A multipurposes IRC bot
Description:
@@ -39,6 +39,7 @@ Library
irc,
mtl,
network,
+ random,
tls >= 0.6.1,
tls-extra >= 0.2.0