An IRC bot for learning, fun and collaboration in the Freepost community.

[[ 🗃 ^VvM9v funbot ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Commits]

Clone

HTTPS: git clone https://vervis.peers.community/repos/VvM9v

SSH: git clone USERNAME@vervis.peers.community:VvM9v

Branches

Tags

master :: src / FunBot /

KnownNicks.hs

{- This file is part of funbot.
 -
 - Written in 2015 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}

module FunBot.KnownNicks
    ( rememberNick
    , rememberNick'
    , rememberNicks
    , nickIsKnown
    , loadKnownNicks
    , mkSaveKnownNicks
    , saveKnownNicks
    )
where

import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON, ToJSON)
import Data.JsonState
import FunBot.Config (stateSaveInterval, configuration, nicksFilename)
import FunBot.Types
import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Bot.Types (Config (cfgStateRepo))
import Network.IRC.Fun.Types.Base (Channel, Nickname (..))

import qualified Data.HashMap.Lazy as M
import qualified Data.HashSet as S

-- | Consider this nick known in the given channel from now on.
rememberNick :: Nickname -> Channel -> BotSession ()
rememberNick nick chan = do
    chans <- getStateS bsKnownNicks
    let nicks = M.lookup chan chans
        nicks' = maybe (S.singleton nick) (S.insert nick) nicks
        chans' = M.insert chan nicks' chans
    modifyState $ \ s -> s { bsKnownNicks = chans' }

-- | A variant of 'rememberNick' which returns whether the nick was indeed new.
-- If not, it means the nick was already known.
rememberNick' :: Nickname -> Channel -> BotSession Bool
rememberNick' nick chan = do
    chans <- getStateS bsKnownNicks
    let ins ns = do
                    let chans' = M.insert chan ns chans
                    modifyState $ \ s -> s { bsKnownNicks = chans' }
                    return True
    case M.lookup chan chans of
        Nothing -> ins $ S.singleton nick
        Just nicks ->
            if nick `S.member` nicks
                then return False
                else ins $ S.insert nick nicks

-- | Consider these nicks known in the given channel from now on.
rememberNicks :: [Nickname] -> Channel -> BotSession ()
rememberNicks nicks chan = do
    chans <- getStateS bsKnownNicks
    let new = S.fromList nicks
        curr = M.lookup chan chans
        nicks' = maybe new (S.union new) curr
        chans' = M.insert chan nicks' chans
    modifyState $ \ s -> s { bsKnownNicks = chans' }

-- | Check whether the given nick is known in the given channel.
nickIsKnown :: Nickname -> Channel -> BotSession Bool
nickIsKnown nick chan = do
    chans <- getStateS bsKnownNicks
    return $ case M.lookup chan chans of
        Nothing    -> False
        Just nicks -> nick `S.member` nicks

deriving instance FromJSON Nickname
deriving instance ToJSON Nickname

-- | Load known nicks data from JSON file.
loadKnownNicks :: IO (M.HashMap Channel (S.HashSet Nickname))
loadKnownNicks = do
    r <- loadState $ stateFilePath nicksFilename (cfgStateRepo configuration)
    case r of
        Left (False, e) -> error $ "Failed to read known nicks file: " ++ e
        Left (True, e)  -> error $ "Failed to parse known nicks file: " ++ e
        Right hm        -> return hm

-- | Create a safe async known nicks data saver action.
mkSaveKnownNicks :: IO (M.HashMap Channel (S.HashSet Nickname) -> IO ())
mkSaveKnownNicks =
    mkSaveStateChoose
        stateSaveInterval
        nicksFilename
        (cfgStateRepo configuration)
        "auto commit by funbot"

-- | Schedule a save of the known nicks data into JSON file.
saveKnownNicks :: BotSession ()
saveKnownNicks = do
    nicks <- getStateS bsKnownNicks
    save <- askEnvS saveNicks
    liftIO $ save nicks
[See repo JSON]