{- This file is part of funbot. - - Written in 2015, 2016 by fr33domlover . - - ♡ 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 - . -} -- For JSON field names {-# LANGUAGE OverloadedStrings #-} module FunBot.UserOptions ( getUserHistoryOpts , sendHistoryOpts , sendChannels , setEnabled , setMaxLines , eraseOpts , loadUserOptions , mkSaveUserOptions , saveUserOptions ) where import Control.Applicative ((<$>), (<*>)) import Control.Monad (liftM, mzero) import Control.Monad.IO.Class (liftIO) import Data.Aeson import Data.JsonState import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Text (Text, intercalate) import Formatting import FunBot.Config (stateSaveInterval, configuration, userOptsFilename) import FunBot.Settings.Instances () import FunBot.Types import FunBot.Util (getHistoryLines) import Network.IRC.Fun.Bot.Chat (sendToUser) import Network.IRC.Fun.Bot.State import Network.IRC.Fun.Bot.Types (Config (cfgStateRepo)) import Network.IRC.Fun.Types.Base import qualified Data.HashMap.Lazy as M ------------------------------------------------------------------------------- -- Utilities ------------------------------------------------------------------------------- defaultEnabled :: Bool defaultEnabled = False defaultMaxLines :: Int defaultMaxLines = 10 defHistoryDisplay :: HistoryDisplay defHistoryDisplay = HistoryDisplay { hdEnabled = defaultEnabled , hdMaxLines = defaultMaxLines } defUserOpts :: UserOptions defUserOpts = UserOptions { uoHistoryDisplay = M.empty } getUserHistoryOpts :: Nickname -> Channel -> BotSession HistoryDisplay getUserHistoryOpts nick chan = do opts <- getStateS bsUserOptions let user = M.lookup nick opts hdmap = fmap uoHistoryDisplay user mhd = hdmap >>= M.lookup chan return $ fromMaybe defHistoryDisplay mhd ------------------------------------------------------------------------------- -- Command Implementation ------------------------------------------------------------------------------- showEnabled :: Bool -> Text showEnabled True = "Enabled" showEnabled False = "Disabled" showMaxLines :: Int -> Text showMaxLines n = sformat (int % " lines") n formatHistoryOpts :: Nickname -> Channel -> Maybe HistoryDisplay -> MsgContent formatHistoryOpts nick chan mhd = let defSuffix = " [default]" (enabled, maxLines) = case mhd of Nothing -> ( showEnabled defaultEnabled <> defSuffix , showMaxLines defaultMaxLines <> defSuffix ) Just hd -> ( showEnabled $ hdEnabled hd , showMaxLines $ hdMaxLines hd ) in MsgContent $ sformat ( "History display of " % stext % " for " % stext % ": " % stext % ", " % stext ) (unChannel chan) (unNickname nick) enabled maxLines modifyOpts :: Nickname -> Channel -> (HistoryDisplay -> HistoryDisplay) -> BotSession () modifyOpts nick chan f = do opts <- getStateS bsUserOptions let userPrev = M.lookupDefault defUserOpts nick opts hdmapPrev = uoHistoryDisplay userPrev hdPrev = M.lookupDefault defHistoryDisplay chan hdmapPrev hdNew = f hdPrev hdmapNew = M.insert chan hdNew hdmapPrev userNew = userPrev { uoHistoryDisplay = hdmapNew } optsNew = M.insert nick userNew opts modifyState $ \ s -> s { bsUserOptions = optsNew } saveUserOptions ------------------------------------------------------------------------------- -- Commands ------------------------------------------------------------------------------- sendHistoryOpts :: Nickname -> Channel -> BotSession () sendHistoryOpts nick chan = do opts <- getStateS bsUserOptions let user = M.lookup nick opts hdmap = fmap uoHistoryDisplay user mhd = hdmap >>= M.lookup chan sendToUser nick $ formatHistoryOpts nick chan mhd sendChannels :: Nickname -> BotSession () sendChannels nick = do muser <- fmap (M.lookup nick) $ getStateS bsUserOptions let mhdmap = fmap uoHistoryDisplay muser mkeys = fmap M.keys mhdmap keys = fromMaybe [] mkeys l = if null keys then "(none)" else intercalate ", " $ map unChannel keys sendToUser nick $ MsgContent $ "Options stored for channels: " <> l setEnabled :: Nickname -> Channel -> Bool -> BotSession () setEnabled nick chan enabled = do modifyOpts nick chan $ \ hd -> hd { hdEnabled = enabled } sendToUser nick $ MsgContent $ sformat ( "History display of " % stext % ": " % stext ) (unChannel chan) (showEnabled enabled) setMaxLines :: Nickname -> Channel -> Int -> BotSession () setMaxLines nick chan maxLines = do modifyOpts nick chan $ \ hd -> hd { hdMaxLines = maxLines } hls <- getHistoryLines chan sendToUser nick $ MsgContent $ sformat ( "History display length for " % stext % ": " % stext % "\n(I keep in my logs up to " % stext % " for " % stext % ")" ) (unChannel chan) (showMaxLines maxLines) (showMaxLines hls) (unChannel chan) eraseOpts :: Nickname -> BotSession () eraseOpts nick = do opts <- getStateS bsUserOptions case M.lookup nick opts of Nothing -> sendToUser nick $ MsgContent "You don’t have stored options." Just user -> do modifyState $ \ s -> s { bsUserOptions = M.delete nick opts } saveUserOptions sendToUser nick $ MsgContent "All your options have been reset to defaults." ------------------------------------------------------------------------------- -- Persistence ------------------------------------------------------------------------------- instance FromJSON HistoryDisplay where parseJSON (Object o) = HistoryDisplay <$> o .: "enabled" <*> o .: "max-lines" parseJSON _ = mzero instance ToJSON HistoryDisplay where toJSON (HistoryDisplay enabled maxLines) = object [ "enabled" .= enabled , "max-lines" .= maxLines ] instance FromJSON UserOptions where parseJSON (Object o) = UserOptions <$> o .: "history-display" parseJSON _ = mzero instance ToJSON UserOptions where toJSON (UserOptions hd) = object [ "history-display" .= hd ] loadUserOptions :: IO (M.HashMap Nickname UserOptions) loadUserOptions = do r <- loadState $ stateFilePath userOptsFilename (cfgStateRepo configuration) case r of Left (False, e) -> error $ "Failed to read user options file: " ++ e Left (True, e) -> error $ "Failed to parse user options file: " ++ e Right s -> return s mkSaveUserOptions :: IO (M.HashMap Nickname UserOptions -> IO ()) mkSaveUserOptions = mkSaveStateChoose stateSaveInterval userOptsFilename (cfgStateRepo configuration) "auto commit by funbot" saveUserOptions :: BotSession () saveUserOptions = do opts <- getStateS bsUserOptions save <- askEnvS saveUserOpts liftIO $ save opts