{- 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 ) where import Control.Applicative import Control.Monad (liftM, mzero) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS import Data.Aeson import qualified Data.HashMap.Lazy as M import Data.Maybe (isJust) import Data.JsonState import Data.Time.Interval import Data.Time.Units (Microsecond) import Network.IRC.Fun.Bot.Internal.IrcLog (makeLogger) import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Client.NickTracker (newNetwork) data ChannelStateJ = ChannelStateJ Bool Bool data BotStateJ = BotStateJ (M.HashMap String ChannelStateJ) toJ :: BotState s -> BotStateJ toJ bstate = BotStateJ $ M.map f $ chanstate bstate where f (ChannelState track mlogger) = ChannelStateJ track (isJust mlogger) fromJ :: BotStateJ -> BotEnv e s -> s -> IO (BotState s) fromJ (BotStateJ chansJ) env 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 = M.fromList $ zip (channels $ config env) (repeat defstate) chansAll = chansJ `M.union` chansConf chans <- M.traverseWithKey f chansAll return $ BotState newNetwork chans 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 .: "channels" parseJSON _ = mzero instance ToJSON BotStateJ where toJSON (BotStateJ chans) = object [ "channels" .= chans ] instance ToJSON (BotState s) where toJSON bstate = toJSON $ toJ bstate loadBotState :: BotEnv e s -> s -> IO (BotState s) loadBotState env pub = do let conf = config 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 sj env 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 saveState liftIO $ save bstate