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