{- This file is part of funbot. - - Written in 2015 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.List (intercalate) import Data.Maybe (fromMaybe) import FunBot.Config (stateSaveInterval, configuration, userOptsFilename) 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 Text.Printf (printf) 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 :: String -- ^ User nickname -> String -- ^ 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 -> String showEnabled True = "Enabled" showEnabled False = "Disabled" showMaxLines :: Int -> String showMaxLines n = show n ++ " lines" formatHistoryOpts :: String -> String -> Maybe HistoryDisplay -> String 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 printf "History display of %v for %v: %v, %v" chan nick enabled maxLines modifyOpts :: String -- ^ User nickname -> String -- ^ Channel -> (HistoryDisplay -> HistoryDisplay) -- ^ Modification -> 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 :: String -- ^ User nickname -> String -- ^ 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 :: String -- ^ User nickname -> BotSession () sendChannels nick = do muser <- liftM (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 ", " keys sendToUser nick $ "Options stored for channels: " ++ l setEnabled :: String -- ^ User nickname -> String -- ^ Channel -> Bool -- ^ Whether to enable (or disable) -> BotSession () setEnabled nick chan enabled = do modifyOpts nick chan $ \ hd -> hd { hdEnabled = enabled } sendToUser nick $ printf "History display of %v: %v" chan (showEnabled enabled) setMaxLines :: String -- ^ User nickname -> String -- ^ Channel -> Int -- ^ Number of lines -> BotSession () setMaxLines nick chan maxLines = do modifyOpts nick chan $ \ hd -> hd { hdMaxLines = maxLines } hls <- getHistoryLines chan sendToUser nick $ printf "History display length for %v: %v\n\ \(I keep in my logs up to %v for %v)" chan (showMaxLines maxLines) (showMaxLines hls) chan eraseOpts :: String -- ^ User nickname -> BotSession () eraseOpts nick = do opts <- getStateS bsUserOptions case M.lookup nick opts of Nothing -> sendToUser nick "You don't have stored options." Just user -> do modifyState $ \ s -> s { bsUserOptions = M.delete nick opts } saveUserOptions sendToUser nick "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 String 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 String 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