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.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 BotStateJ = BotStateJ (M.HashMap String ChanInfo) (S.HashSet String)
toJ :: BotState s -> BotStateJ
toJ bstate =
BotStateJ (M.map stateToInfo $ bsChannels bstate) (bsSelChans bstate)
fromJ :: BotEnv e s -> BotStateJ -> s -> IO (BotState s)
fromJ env (BotStateJ stateJ selJ) pub = do
let f chan (ChanInfo tracking counting logging hls) = do
mlogger <-
if logging
then fmap Just $ makeLogger env chan
else return Nothing
return $ ChanState tracking counting mlogger hls
defstate = ChanInfo False False False 0
chansConf = S.toList selJ `union` cfgChannels (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 M.empty M.empty pub
instance FromJSON ChanInfo where
parseJSON (Object o) =
ChanInfo <$>
o .: "track" <*>
o .: "count" <*>
o .: "log" <*>
o .: "history-lines"
parseJSON _ = mzero
instance ToJSON ChanInfo where
toJSON (ChanInfo tracking counting logging hls) = object
[ "track" .= tracking
, "count" .= counting
, "log" .= logging
, "history-lines" .= hls
]
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 (cfgStateFile conf) (cfgStateRepo 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 $ cfgSaveInterval conf :: Microsecond
msg = "auto commit by irc-fun-bot"
in mkSaveStateChoose iv (cfgStateFile conf) (cfgStateRepo 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 (ChanState False False Nothing 0) chans
saveBotState