State.hs

{- This file is part of irc-fun-bot.
 -
 - 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 Network.IRC.Fun.Bot.Internal.State
    ( askConfig
    , askConfigS
    , askBehavior
    , askBehaviorS
    , askEnv
    , askEnvS
    , askHandle
    , askTimeGetter
    , getState
    , getStateS
    , putState
    , modifyState
    , getChannelState
    , getChans
    , putChans
    , modifyChans
    , addCurrChan
    , removeCurrChan
    , clearCurrChans
    , channelSelected
    , botMemberOf
    )
where

import Control.Monad (liftM)
import Control.Monad.Trans.RWS
import Data.HashMap.Lazy (HashMap)
import Data.Maybe (isJust)
import Data.Time.Clock (UTCTime)
import Network.IRC.Fun.Bot.Internal.Types
import Network.IRC.Fun.Client.IO (Handle)

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

-- | Fetch the bot configuration.
askConfig :: Session e s Config
askConfig = asks beConfig

-- | Retrieve a function of the bot configuration.
askConfigS :: (Config -> a) -> Session e s a
askConfigS f = asks $ f . beConfig

-- | Fetch the bot behavior definition.
askBehavior :: Session e s (Behavior e s)
askBehavior = asks beBehavior

-- | Retrieve a function of the bot behavior definition.
askBehaviorS :: (Behavior e s -> a) -> Session e s a
askBehaviorS f = asks $ f . beBehavior

-- | Fetch the bot environment, i.e. read-only state.
askEnv :: Session e s e
askEnv = asks beCustom

-- | Retrieve a function of the bot environment.
askEnvS :: (e -> a) -> Session e s a
askEnvS f = asks $ f . beCustom

-- | Fetch the bot session socket handle.
askHandle :: Session e s Handle
askHandle = asks beHandle

-- | Fetch the time getter. The actual time data is cached and updated at most
-- once per second depending on need. You can safely use it at any frequency
-- withou overloading IO and time formatting.
--
-- The second item is a formatted time string in the form
-- @2015-09-01 18:10:00@, and is always expressed in UTC.
askTimeGetter :: Session e s (IO (UTCTime, String))
askTimeGetter = asks beGetTime

-- | Fetch the current value of the state within the session.
getState :: Session e s s
getState = gets bsPublic

-- | Get a specific component of the state, using a projection function
-- supplied.
getStateS :: (s -> a) -> Session e s a
getStateS f = gets $ f . bsPublic

-- | Set the state within the session.
putState :: s -> Session e s ()
putState st = modify $ \ old -> old { bsPublic = st }

-- | Update the state to the result of applying a function to the current
-- state.
modifyState :: (s -> s) -> Session e s ()
modifyState f =
    modify $ \ old@(BotState { bsPublic = st }) -> old { bsPublic = f st }

-- | Get channel state information, in the form of a mapping from channel names
-- to their data.
--
-- Channel data is a pair of two booleans. The first says whether channel
-- tracking is enabled. The second says whether channel logging info a file is
-- enabled.
getChannelState :: Session e s (HashMap String (Bool, Bool))
getChannelState = do
    chans <- getChans
    let f cstate = (chanTracking cstate, isJust $ chanLogger cstate)
    return $ M.map f chans

-- Get the channel state map.
getChans :: Session e s (HashMap String ChannelState)
getChans = gets bsChannels

-- Set a new value for the channel state map.
putChans :: HashMap String ChannelState -> Session e s ()
putChans chans = modify $ \ s -> s { bsChannels = chans }

-- Update the channel state map value with the result of applying a function.
modifyChans :: (HashMap String ChannelState -> HashMap String ChannelState)
            -> Session e s ()
modifyChans f = modify $ \ s -> s { bsChannels = f $ bsChannels s }

-- Add a channel to the list of currently really-joined channels.
addCurrChan :: String -> Session e s ()
addCurrChan chan =
    let f = S.insert chan
    in  modify $ \ s -> s { bsCurrChans = f $ bsCurrChans s }

-- Remove a channel from the list of currently really-joined channels.
removeCurrChan :: String -> Session e s ()
removeCurrChan chan =
    let f = S.delete chan
    in  modify $ \ s -> s { bsCurrChans = f $ bsCurrChans s }

-- Remove all channels from the list of currently really-joined channels.
clearCurrChans :: Session e s ()
clearCurrChans = modify $ \ s -> s { bsCurrChans = S.empty }

-- | Check whether a channel is listed in persistent state to be joined.
channelSelected :: String -> Session e s Bool
channelSelected chan = liftM (chan `S.member`) $ gets bsSelChans

-- | Check whether, as far as the bot knows, if it currently a member of the
-- given channel. Currently kicks, bans, etc. are fully tracked, therefore this
-- information isn't 100% accurate, but if you aren't planning to ban your bot
-- you can probably rely on it.
botMemberOf :: String -> Session e s Bool
botMemberOf chan = liftM (chan `S.member`) $ gets bsCurrChans