Persist.hs

{- This file is part of irc-fun-bot.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ 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
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

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