{- 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.Repos
    ( hostSection
    , addRepoAnnSpec
    , deleteRepoAnnSpec
    , addRepo
    , deleteRepo
    )
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.Types
import Network.IRC.Fun.Bot.State (modifyState)
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

specSection :: DevHostLabel -> RepoSpace -> RepoName -> Int -> SettingsTree
specSection host space repo pos = Section
    { secOpts = M.fromList
        [ ( "channel"
          , mkopt
                "set-channel-here"
                (unChannel . rasChannel)
                (\ chan spec -> spec { rasChannel = Channel chan })
          )
        , ( "branches"
          , mkopt
                []
                (\ spec ->
                    case rasBranches spec of
                        Accept l -> map unBranchName l
                        Reject l -> map unBranchName l
                )
                (\ branches spec ->
                    let bs = case rasBranches spec of
                                Accept _ -> Accept $ map BranchName branches
                                Reject _ -> Reject $ map BranchName branches
                    in  spec { rasBranches = bs }
                )
          )
        , ( "accept"
          , mkopt
                False
                (\ spec ->
                    case rasBranches spec of
                        Accept _ -> True
                        Reject _ -> False
                )
                (\ b spec ->
                    let ctor = if b then Accept else Reject
                        bs = case rasBranches spec of
                                Accept l -> ctor l
                                Reject l -> ctor l
                    in  spec { rasBranches = bs }
                )
          )
        , ( "all-commits"
          , mkopt
                False
                rasAllCommits
                (\ b spec -> spec { rasAllCommits = b })
          )
        , ( "commits"
          , mkopt
                True
                rasCommits
                (\ b spec -> spec { rasCommits = b })
          )
        , ( "issues"
          , mkopt
                True
                rasIssues
                (\ b spec -> spec { rasIssues = b })
          )
        , ( "merge-requests"
          , mkopt
                True
                rasMergeRequests
                (\ b spec -> spec { rasMergeRequests = b })
          )
        , ( "snippets"
          , mkopt
                True
                rasSnippets
                (\ b spec -> spec { rasSnippets = b })
          )
        , ( "notes"
          , mkopt
                True
                rasNotes
                (\ b spec -> spec { rasNotes = b })
          )
        , ( "new"
          , mkopt
                True
                rasNew
                (\ b spec -> spec { rasNew = b })
          )
        , ( "old"
          , mkopt
                True
                rasOld
                (\ b spec -> spec { rasOld = b })
          )
        , ( "untimed"
          , mkopt
                True
                rasUntimed
                (\ b spec -> spec { rasUntimed = b })
          )
        ]
    , secSubs = M.empty
    }
    where
    setSpecField f val sets = fromMaybe sets $ do
        let hosts = stGitAnnChans sets
        repos <- M.lookup host hosts
        specs <- M.lookup (space, repo) repos
        let specs' = Q.adjust (f val) pos specs
            repos' = M.insert (space, repo) specs' repos
            hosts' = M.insert host repos' hosts
        return sets { stGitAnnChans = hosts' }
    getSpecField defval f sets = fromMaybe defval $ do
        let hosts = stGitAnnChans sets
        repos <- M.lookup host hosts
        specs <- M.lookup (space, repo) repos
        spec <- if 0 <= pos && pos < Q.length specs
                    then Just $ Q.index specs pos
                    else Nothing
        return $ f spec
    mkopt defval get set =
        mkOptionF (getSpecField defval get) (setSpecField set) defval

repoSection
    :: DevHostLabel
    -> RepoSpace
    -> RepoName
    -> Seq RepoAnnSpec
    -> (T.Text, SettingsTree)
repoSection h s r specs =
    ( CI.original (unRepoSpace s) <> "/" <> CI.original (unRepoName r)
    , Section
        { secOpts = M.empty
        , secSubs = M.fromList $ map mksub [1 .. Q.length specs]
        }
    )
    where
    mksub i = (T.pack $ show i, specSection h s r (i - 1))

hostSection
    :: DevHostLabel
    -> M.HashMap (RepoSpace, RepoName) (Seq RepoAnnSpec)
    -> SettingsTree
hostSection host repos = Section
    { secOpts = M.empty
    , secSubs = M.fromList $ map (uncurry f) $ M.toList repos
    }
    where
    f (space, repo) specs = repoSection host space repo specs

mkDefSpec :: Channel -> RepoAnnSpec
mkDefSpec chan = RepoAnnSpec
    { rasChannel       = chan
    , rasBranches      = Reject []
    , rasAllCommits    = False
    , rasCommits       = True
    , rasIssues        = True
    , rasMergeRequests = True
    , rasSnippets      = True
    , rasNotes         = True
    , rasNew           = True
    , rasOld           = True
    , rasUntimed       = True
    }

-- | Append a new repo ann spec to the settings and a matching tree under the
-- repo section. Return whether succeeded.
addRepoAnnSpec
    :: DevHostLabel
    -> RepoSpace
    -> RepoName
    -> Channel
    -> BotSession Bool
addRepoAnnSpec host space repo chan = do
    hosts <- fmap stGitAnnChans getSettings
    case M.lookup host hosts of
        Just repos ->
            case M.lookup (space, repo) repos of
                Just specs -> do
                    let specs' = specs |> defSpec
                        repos' = M.insert (space, repo) specs' repos
                        hosts' = M.insert host repos' hosts
                    modifySettings $ \ s -> s { stGitAnnChans = hosts' }
                    saveBotSettings
                    let (t, sec) = repoSection host space repo specs'
                        ins = insertSub ["repos", unDevHostLabel host, t] sec
                    modifyState $ \ s -> s { bsSTree = ins $ bsSTree s }
                    return True
                Nothing -> return False
        Nothing -> return False
    where
    defSpec = mkDefSpec chan

-- | Remove a spec from a repo. Return 'Nothing' on success. Otherwise return
-- whether the error was repo not found ('False') or index too big ('True').
-- The position given is 0-based.
deleteRepoAnnSpec
    :: DevHostLabel
    -> RepoSpace
    -> RepoName
    -> Int
    -> BotSession (Maybe Bool)
deleteRepoAnnSpec host space repo pos = do
    hosts <- fmap stGitAnnChans getSettings
    case M.lookup host hosts of
        Just repos ->
            case M.lookup (space, repo) repos of
                Just specs ->
                    let (u, v) = Q.splitAt pos specs
                    in  case Q.viewl v of
                            EmptyL -> return $ Just True
                            s :< r -> do
                                let specs' = u >< r
                                    repos' =
                                        M.insert (space, repo) specs' repos
                                    hosts' = M.insert host repos' hosts
                                modifySettings $
                                    \ s -> s { stGitAnnChans = hosts' }
                                saveBotSettings
                                let (t, sec) =
                                        repoSection host space repo specs'
                                    ins =
                                        insertSub
                                            ["repos", unDevHostLabel host, t]
                                            sec
                                modifyState $
                                    \ s -> s { bsSTree = ins $ bsSTree s }
                                return Nothing
                Nothing -> return $ Just False
        Nothing -> return $ Just False

-- | Add a new repo to settings and tree. Return 'Nothing' on success.
-- Otherwise return whether the host doesn't exist ('False') or the repo
-- already exists ('True').
addRepo
    :: DevHostLabel
    -> RepoSpace
    -> RepoName
    -> Channel
    -> BotSession (Maybe Bool)
addRepo host space repo chan = do
    hosts <- fmap stGitAnnChans getSettings
    case M.lookup host hosts of
        Nothing    -> return $ Just False
        Just repos ->
            case M.lookup (space, repo) repos of
                Just _  -> return $ Just True
                Nothing -> do
                    let specs = Q.singleton defSpec
                        repos' =
                            M.insert (space, repo) specs repos
                        hosts' = M.insert host repos' hosts
                    modifySettings $ \ s -> s { stGitAnnChans = hosts' }
                    saveBotSettings
                    let (t, sec) = repoSection host space repo specs
                        ins = insertSub ["repos", unDevHostLabel host, t] sec
                    modifyState $ \ s -> s { bsSTree = ins $ bsSTree s }
                    return Nothing
    where
    defSpec = mkDefSpec chan

-- | Remove a repo from settings and tree. Return whether success, i.e. whether
-- the repo did exist and indeed has been deleted.
deleteRepo :: DevHostLabel -> RepoSpace -> RepoName -> BotSession Bool
deleteRepo host space repo = do
    hosts <- fmap stGitAnnChans getSettings
    case M.lookup host hosts of
        Just repos ->
            if M.member (space, repo) repos
                then do
                    let repos' = M.delete (space, repo) repos
                        hosts' = M.insert host repos' hosts
                    modifySettings $ \ s -> s { stGitAnnChans = hosts' }
                    saveBotSettings
                    let name =
                            CI.original (unRepoSpace space) <>
                            "/" <>
                            CI.original (unRepoName repo)
                        del = deleteSub ["repos", unDevHostLabel host, name]
                    modifyState $ \ s -> s { bsSTree = del $ bsSTree s }
                    return True
                else return False
        Nothing    -> return False