module Network.IRC.Fun.Bot.Internal.Persist
( loadBotState
, mkSaveBotState
, saveBotState
)
where
import Control.Applicative
import Control.Monad (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.Settings.Persist
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
r <- loadSettings $ stateFile $ config env
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
in mkSaveSettings iv (stateFile conf)
saveBotState :: Session e s ()
saveBotState = do
bstate <- get
save <- asks saveState
liftIO $ save bstate