packages feed

funbot-0.4: src/FunBot/KnownNicks.hs

{- This file is part of funbot.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ 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/>.
 -}

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

import Control.Monad.IO.Class (liftIO)
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 qualified Data.HashMap.Lazy as M
import qualified Data.HashSet as S

-- | Consider this nick known in the given channel from now on.
rememberNick :: String -> String -> 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' :: String -> String -> 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 :: [String] -> String -> 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 :: String -> String -> BotSession Bool
nickIsKnown nick chan = do
    chans <- getStateS bsKnownNicks
    return $ case M.lookup chan chans of
        Nothing    -> False
        Just nicks -> nick `S.member` nicks

-- | Load known nicks data from JSON file.
loadKnownNicks :: IO (M.HashMap String (S.HashSet String))
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 s         -> return s

-- | Create a safe async known nicks data saver action.
mkSaveKnownNicks :: IO (M.HashMap String (S.HashSet String) -> 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