An IRC bot for learning, fun and collaboration in the Freepost community.

[[ 🗃 ^VvM9v funbot ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Commits]

Clone

HTTPS: git clone https://vervis.peers.community/repos/VvM9v

SSH: git clone USERNAME@vervis.peers.community:VvM9v

Branches

Tags

master :: src / FunBot / Settings / Sections /

Shortcuts.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/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module FunBot.Settings.Sections.Shortcuts
    ( shortcutSec
    , addShortcut
    , deleteShortcut
    )
where

import Control.Monad (unless)
import Data.Bool (bool)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Sequence (Seq, (|>), (><), ViewL (..))
import Data.Settings.Section
import Data.Settings.Types
import FunBot.Settings.MkOption
import FunBot.Settings.Persist
import FunBot.Types
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.Types.Base (Channel (..), Nickname (..))

import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Lazy as M
import qualified Data.Sequence as Q
import qualified Data.Text as T

-- | Create a settings section for a shortcut, given its label string
shortcutSec :: ShortcutLabel -> SettingsTree
shortcutSec label = Section
    { secOpts = M.fromList
        [ ( "prefix"
          , mkOptionF
                (getf shPrefix)
                (setf $ \ cut prefix -> cut { shPrefix = prefix })
                ""
          )
        , ( "before"
          , mkOptionF
                (getf shBefore)
                (setf $ \ cut before -> cut { shBefore = before })
                ""
          )
        , ( "after"
          , mkOptionF
                (getf shAfter)
                (setf $ \ cut after -> cut { shAfter = after })
                ""
          )
        , ( "channels"
          , mkOptionF
                (getl $ map unChannel . shChannels)
                (setf $ \ cut chans -> cut { shChannels = map Channel chans })
                []
          )
        ]
    , secSubs = M.empty
    }
    where
    err = "ERROR not found"
    getf f = maybe err f . M.lookup label . stShortcuts
    getl f = maybe []  f . M.lookup label . stShortcuts
    setf f v s =
        let cuts = stShortcuts s
        in  case M.lookup label cuts of
                Nothing  -> s
                Just cut ->
                    let cut' = f cut v
                        cuts' = M.insert label cut' cuts
                    in  s { stShortcuts = cuts' }

-- | Add a new shortcut to settings and tree. Return whether success, i.e.
-- whether the shortcut didn't exist and indeed a new one has been created.
addShortcut :: ShortcutLabel -> Channel -> BotSession Bool
addShortcut label chan = do
    cuts <- fmap stShortcuts getSettings
    case M.lookup label cuts of
        Just _  -> return False
        Nothing -> do
            let cuts' = M.insert label defCut cuts
            modifySettings $ \ s -> s { stShortcuts = cuts' }
            saveBotSettings
            let sec = shortcutSec label
                ins = insertSub ["shortcuts", CI.foldedCase $ unShortcutLabel label] sec
            modifyState $ \ s -> s { bsSTree = ins $ bsSTree s }
            return True
    where
    defCut = Shortcut "PrEfIx" "http://BeFoRe.org/" "/AfTeR.html" [chan]

-- | Remove a shortcut from settings and tree. Return whether success, i.e.
-- whether the shortcut did exist and indeed has been deleted.
deleteShortcut :: ShortcutLabel -> BotSession Bool
deleteShortcut label = do
    cuts <- fmap stShortcuts getSettings
    if M.member label cuts
        then do
            let cuts' = M.delete label cuts
            modifySettings $ \ s -> s { stShortcuts = cuts' }
            saveBotSettings
            let del = deleteSub ["shortcuts", CI.foldedCase $ unShortcutLabel label]
            modifyState $ \ s -> s { bsSTree = del $ bsSTree s }
            return True
        else return False
[See repo JSON]