Settings.hs

{- This file is part of funbot.
 -
 - Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ 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 irc-fun-color StyledString
{-# LANGUAGE OverloadedStrings #-}

module FunBot.Settings
    ( respondGet'
    , respondSet'
    , respondReset'
    , respondSettingsHelp
    )
where

import Control.Applicative
import Control.Monad (liftM, mzero, unless)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson hiding (encode)
import Data.Bool (bool)
import Data.Char (toLower)
import Data.Default.Class (def)
import Data.JsonState
import Data.List (intercalate, intersperse, isSuffixOf, sort)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid
import Data.Settings.Interface
import Data.Settings.Option
import Data.Settings.Route
import Data.Settings.Section (deleteSub, insertSub, memberSub)
import Data.Settings.Types
import Data.Text (Text)
import Data.Time.Units (Second)
import FunBot.Config (stateSaveInterval, configuration, settingsFilename)
import FunBot.Settings.Help
import FunBot.Settings.Instances ()
import FunBot.Types
import FunBot.Util
import Network.IRC.Fun.Bot.Chat
import Network.IRC.Fun.Bot.IrcLog
import Network.IRC.Fun.Bot.MsgCount
import Network.IRC.Fun.Bot.Nicks
import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Bot.Types (Config (cfgStateRepo))
import Network.IRC.Fun.Color
import Network.IRC.Fun.Types.Base (MsgContent (..))
import Web.Feed.Collect hiding (addFeed)

import qualified Data.HashMap.Lazy as M
import qualified Data.Text as T
import qualified Web.Feed.Collect as F (addFeed)

showError :: SettingsError -> Text
showError (InvalidPath t)         = t <> " : Invalid path"
showError (NoSuchNode r)          = showRoute r <> " : No such option/section"
showError (NoSuchOption r)        = showRoute r <> " : No such option"
showError (NoSuchSection r)       = showRoute r <> " : No such section"
showError (InvalidValueForType t) = t <> " : Invalid value for option type"
showError (InvalidValue t)        = t <> " : Invalid value"

showOptLine :: Text -> Text -> Text -> Text
showOptLine opt op val =
    encode $ Yellow #> plain opt <> Teal #> plain op <> Maroon #> plain val

showGet :: Text -> Text -> Text
showGet opt val = showOptLine opt " = " val

showSec :: OptPath -> [Text] -> [Text] -> Text
showSec path subs opts =
    let showSub = ('‣' `T.cons`)
        showOpt = ('•' `T.cons`)
        showList = T.unwords . sort
        pathF = Yellow #> plain path
        subsF = Green #> plain (showList $ map showSub subs)
        optsF = Purple #> plain (showList $ map showOpt opts)
    in  encode $ case (null subs, null opts) of
            (False, False) -> pathF <> " : " <> subsF <> " | " <> optsF
            (False, True)  -> pathF <> " : " <> subsF
            (True, False)  -> pathF <> " : " <> optsF
            (True, True)   -> pathF <> " : Empty section"

-- Remove user-friendliness parts and determine whether given string refers to
-- a potential section (otherwise it could also be an potential option).
stripPath :: Text -> (Text, Bool)
stripPath opt
    | opt == "*"              = (T.empty, True)
    | ".*" `T.isSuffixOf` opt = (T.dropEnd 2 opt, True)
    | otherwise               = (opt, False)

respondGet' :: OptPath -> (MsgContent -> BotSession ()) -> BotSession ()
respondGet' opt send = resp path
    where
    (path, sec) = stripPath opt
    resp = if sec then respSec else respAny
    respAny path = do
        result <- query path
        send $ MsgContent $ case result of
            Left err                  -> showError err
            Right (Left (subs, opts)) -> showSec path subs opts
            Right (Right val)         -> showGet path val
    respSec path = do
        result <- querySection path
        send $ MsgContent $ case result of
            Left err           -> showError err
            Right (subs, opts) -> showSec path subs opts

showSet :: Text -> Text -> Text
showSet opt val = showOptLine opt " ← " val

respondSet'
    :: OptPath
    -> Text
    -> (MsgContent -> BotSession ())
    -> BotSession ()
respondSet' opt val send = do
    merr <- updateOption opt val
    case merr of
        Just err -> send $ MsgContent $ showError err
        Nothing  -> send $ MsgContent $ showSet opt val

showReset :: Text -> Text -> Text
showReset opt val = showOptLine opt " ↩ " val

showResetStrange :: Text -> Text
showResetStrange opt = opt <> " : got reset, but I can’t find it now"

respondReset' :: OptPath -> (MsgContent -> BotSession ()) -> BotSession ()
respondReset' opt send = do
    merr <- resetOption opt
    case merr of
        Just err -> send $ MsgContent $ showError err
        Nothing  -> do
            me <- queryOption opt
            send $ MsgContent $ case me of
                Left _    -> showResetStrange opt
                Right val -> showReset opt val

respondSettingsHelp
    :: OptPath
    -> (MsgContent -> BotSession ())
    -> BotSession Bool
respondSettingsHelp path send =
    let p = fst $ stripPath path
    in  case parseRoute p of
            Just r -> do
                send $ MsgContent $ p <> " : " <> help r
                return True
            Nothing -> return False