Channels.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.Channels
    ( chanSec
    , addChannel
    , addLocalLocation
    , removeLocalLocation
    )
where

import Control.Monad (unless, void)
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.HashSet as S
import qualified Data.Sequence as Q
import qualified Data.Text as T

defChan = ChanSettings True False [] "(?)" M.empty S.empty Nothing

locationOption chan l@(LocationLabel t) =
                    let defl = "(?)"
                        getl l sets = fromMaybe defl $ do
                            cs <- M.lookup chan $ stChannels sets
                            loc <- M.lookup l $ csLocations cs
                            return $ unLocation loc
                        setl l v sets =
                            let chans = stChannels sets
                                cs = M.lookupDefault defChan chan chans
                                locs = csLocations cs
                                locs' = M.insert l (Location v) locs
                                cs' = cs { csLocations = locs' }
                                chans' = M.insert chan cs' chans
                            in  sets { stChannels = chans' }
                        f l = mkOptionF (getl l) (setl l) defl
                    in  (CI.original t, f l)

-- | Create a section for a channel.
chanSec :: Channel -> [LocationLabel] -> SettingsTree
chanSec chan lls = Section
    { secOpts = M.fromList
        [ ( "track"
          , mkOptionB
                (channelIsTracked chan)
                (bool (stopTrackingChannel chan) (startTrackingChannel chan))
                False
          )
        , ( "count"
          , mkOptionB
                (chanIsCounted chan)
                (bool (stopCountingChan chan) (startCountingChan chan))
                False
          )
        , ( "log"
          , mkOptionB
                (channelIsLogged chan)
                (bool (stopLoggingChannel chan) (startLoggingChannel chan))
                False
          )
        , ( "def-response"
          , mkOptionB
                (defRespEnabled chan)
                (void . setDefResp chan)
                True
          )
        , ( "say-titles"
          , mkOptionF
                (getf True csSayTitles)
                (setf $ \ cs say -> cs { csSayTitles = say })
                True
          )
        , ( "welcome"
          , mkOptionF
                (getf False csWelcome)
                (setf $ \ cs w -> cs { csWelcome = w })
                False
          )
        , ( "folks"
          , mkOptionF
                (getf [] $ map unNickname . csFolks)
                (setf $ \ cs fs -> cs { csFolks = map Nickname fs })
                []
          )
        , ( "email"
          , mkOptionF
                (getf "(?)" csEmail)
                (setf $ \ cs s -> cs { csEmail = s })
                "(?)"
          )
        , ( "browse"
          , mkOptionF
                (getf "" $ fromMaybe "" . csBrowse)
                (setf $ \ cs url ->
                    if T.null url
                        then cs { csBrowse = Nothing }
                        else cs { csBrowse = Just url }
                )
                ""
          )
        ]
    , secSubs = M.fromList
        [ ( "locations"
          , Section
                { secOpts = M.fromList $ map (locationOption chan) lls
                , secSubs = M.empty
                }
          )
        ]
    }
    where
    getf e f = maybe e f . M.lookup chan . stChannels
    setf f v s =
        let chans = stChannels s
            cs = M.lookupDefault defChan chan chans
            cs' = f cs v
            chans' = M.insert chan cs' chans
        in  s { stChannels = chans' }

-- | Add a new channel to state and tree and to be joined from now on. If
-- already exists, nothing happens.
addChannel :: Channel -> BotSession ()
addChannel chan = do
    selectChannel chan
    addChannelState chan
    sets <- getSTree
    let route = ["channels", unChannel chan]
    unless (route `memberSub` sets) $ do
        let sec = chanSec chan []
            ins = insertSub route sec
        modifyState $ \ s -> s { bsSTree = ins $ bsSTree s }

-- | Add a new location item to a channel's settings and tree. Return 'Nothing'
-- on success. Otherwise return whether the channel isn't selected ('False') or
-- the location label already exists ('True').
addLocalLocation
    :: Channel
    -> LocationLabel
    -> Location
    -> BotSession (Maybe Bool)
addLocalLocation chan label location = do
    sel <- channelSelected chan
    if sel
        then do
            chans <- fmap stChannels getSettings
            let cs = M.lookupDefault defChan chan chans
                locs = csLocations cs
            case M.lookup label locs of
                Just _  -> return $ Just True
                Nothing -> do
                    let locs' = M.insert label location locs
                        cs' = cs { csLocations = locs' }
                        chans' = M.insert chan cs' chans
                    modifySettings $ \ s -> s { stChannels = chans' }
                    saveBotSettings
                    let (t, opt) = locationOption chan label
                        path = ["channels", unChannel chan, "locations", t]
                        ins = insertOpt path opt
                    modifyState $ \ s -> s { bsSTree = ins $ bsSTree s }
                    return Nothing
        else return $ Just False

-- | Remove a channel-specific location from settings and tree. Return whether
-- success, i.e. whether the location did exist and indeed has been deleted.
removeLocalLocation :: Channel -> LocationLabel -> BotSession Bool
removeLocalLocation chan label = do
    chans <- fmap stChannels getSettings
    case M.lookup chan chans of
        Nothing -> return False
        Just cs ->
            let locs = csLocations cs
            in  if M.member label locs
                    then do
                        let locs' = M.delete label locs
                            cs' = cs { csLocations = locs' }
                            chans' = M.insert chan cs' chans
                        modifySettings $ \ s -> s { stChannels = chans' }
                        saveBotSettings
                        let t = CI.original $ unLocationLabel label
                            path = ["channels", unChannel chan, "locations", t]
                            del = deleteOpt path
                        modifyState $ \ s -> s { bsSTree = del $ bsSTree s }
                        return True
                    else return False