{- This file is part of irc-fun-bot. - - Written in 2015 by fr33domlover . - - ♡ 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 - . -} -- For JSON field names {-# LANGUAGE OverloadedStrings #-} module Network.IRC.Fun.Bot.Internal.Persist ( loadBotState , mkSaveBotState , saveBotState , selectChannel , unselectChannel , addChannelState ) where import Control.Applicative import Control.Monad (mzero, unless, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS import Data.Aeson import Data.Maybe (isJust) import Data.JsonState import Data.List (union) import Data.Time.Interval import Data.Time.Units (Microsecond) import Network.IRC.Fun.Bot.Internal.IrcLog (makeLogger) import Network.IRC.Fun.Bot.Internal.State import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Client.NickTracker (newNetwork) import qualified Data.HashMap.Lazy as M import qualified Data.HashSet as S data ChannelStateJ = ChannelStateJ Bool Bool data BotStateJ = BotStateJ (M.HashMap String ChannelStateJ) (S.HashSet String) toJ :: BotState s -> BotStateJ toJ bstate = BotStateJ (M.map f $ bsChannels bstate) (bsSelChans bstate) where f (ChannelState track mlogger) = ChannelStateJ track (isJust mlogger) fromJ :: BotEnv e s -> BotStateJ -> s -> IO (BotState s) fromJ env (BotStateJ stateJ selJ) pub = do let f chan (ChannelStateJ tracking logging) = do mlogger <- if logging then fmap Just $ makeLogger env chan else return Nothing return $ ChannelState tracking mlogger defstate = ChannelStateJ False False chansConf = S.toList selJ `union` channels (beConfig env) stateConf = M.fromList $ zip chansConf (repeat defstate) stateAll = stateJ `M.union` stateConf cstate <- M.traverseWithKey f stateAll return $ BotState newNetwork cstate S.empty selJ pub instance FromJSON ChannelStateJ where parseJSON (Object o) = ChannelStateJ <$> o .: "track" <*> o .: "log" parseJSON _ = mzero instance ToJSON ChannelStateJ where toJSON (ChannelStateJ tracking logging) = object [ "track" .= tracking , "log" .= logging ] instance FromJSON BotStateJ where parseJSON (Object o) = BotStateJ <$> o .: "chan-state" <*> o .: "chans-join" parseJSON _ = mzero instance ToJSON BotStateJ where toJSON (BotStateJ chans sel) = object [ "chan-state" .= chans , "chans-join" .= sel ] instance ToJSON (BotState s) where toJSON bstate = toJSON $ toJ bstate loadBotState :: BotEnv e s -> s -> IO (BotState s) loadBotState env pub = do let conf = beConfig env r <- loadState $ stateFilePath (stateFile conf) (stateRepo conf) case r of Left (False, e) -> error $ "Failed to read state file: " ++ e Left (True, e) -> error $ "Failed to parse state file: " ++ e Right sj -> fromJ env sj pub mkSaveBotState :: Config -> IO (BotState s -> IO ()) mkSaveBotState conf = let iv = fromInteger $ microseconds $ saveInterval conf :: Microsecond msg = "auto commit by irc-fun-bot" in mkSaveStateChoose iv (stateFile conf) (stateRepo conf) msg saveBotState :: Session e s () saveBotState = do bstate <- get save <- asks beSaveState liftIO $ save bstate -- | Add a channel to the persistent list of channels to be joined. Next time -- the bot launches (or, say, 'joinConfig` is called), it will join this -- channel. If the channel is already listed, nothing happens. selectChannel :: String -> Session e s () selectChannel chan = do chans <- gets bsSelChans unless (chan `S.member` chans) $ do modify $ \ s -> s { bsSelChans = S.insert chan chans } saveBotState -- | Remove a channel from the persistent list of channels to be joined. Next -- time the bot launches, it won't join this channel (unless listed in the -- config or otherwise requested). If the channel isn't listed, nothing -- happens. unselectChannel :: String -> Session e s () unselectChannel chan = do chans <- gets bsSelChans when (chan `S.member` chans) $ do modify $ \ s -> s { bsSelChans = S.delete chan chans } saveBotState -- | Add default channel state for the given channel. It will be stored into -- the state file. If the channel already has state, nothing will happen. addChannelState :: String -> Session e s () addChannelState chan = do chans <- getChans unless (chan `M.member` chans) $ do putChans $ M.insert chan (ChannelState False Nothing) chans saveBotState