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
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
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
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