Sections.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
    ( initTree
    )
where

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.Settings.Sections.Channels
import FunBot.Settings.Sections.DevHosts
import FunBot.Settings.Sections.Feeds
import FunBot.Settings.Sections.Locations
import FunBot.Settings.Sections.Repos
import FunBot.Settings.Sections.Shortcuts
import FunBot.Types
import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Types.Base (Channel (..))

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

-- | Build initial settings tree, already inside the session
initTree :: BotSession ()
initTree = do
    cinfo <- getChanInfo
    sets <- getSettings
    let chans = stChannels sets
        locs = M.map (M.keys . csLocations) chans
        defs = M.map (const []) cinfo
        locs' = (locs `M.intersection` defs) `M.union` defs
        mapKey f g = M.fromList . map (\ k -> (f k, g k)) . M.keys
        mapBoth f g = M.fromList . map (\ (k, v) -> (f k, g k v)) . M.toList
        map' f = M.fromList . map f . M.keys
        tree = Section
            { secOpts = M.empty
            , secSubs = M.fromList
                [ ( "channels"
                  , Section
                        { secOpts = M.empty
                        , secSubs = mapBoth unChannel chanSec locs'
                        }
                  )
                , ( "repos"
                  , Section
                        { secOpts = M.empty
                        , secSubs =
                            mapBoth unDevHostLabel hostSection $
                            stGitAnnChans sets
                        }
                  )
                , ( "feeds"
                  , Section
                        { secOpts = M.empty
                        , secSubs =
                            mapKey (CI.original . unFeedLabel) feedSec $
                            stWatchedFeeds sets
                        }
                  )
                , ( "shortcuts"
                  , Section
                        { secOpts = M.empty
                        , secSubs =
                            mapKey (CI.original . unShortcutLabel) shortcutSec
                            $ stShortcuts sets
                        }
                  )
                , ( "dev-hosts"
                  , Section
                        { secOpts = map' devHostOption $ stDevHosts sets
                        , secSubs = M.empty
                        }
                  )
                , ( "locations"
                  , Section
                        { secOpts = map' locationOption $ stLocations sets
                        , secSubs = M.empty
                        }
                  )
                ]
            }
    modifyState $ \ s -> s { bsSTree = tree }