Repos.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 #-}

-- | Add-spec, delete-spec, add-repo, delete-repo commands
--
-- Manage git repo event announcement details
module FunBot.Commands.Repos
    ( cmdAddSpec
    , cmdDeleteSpec
    , cmdAddRepo
    , cmdDeleteRepo
    )
where

import Control.Monad (unless, when)
import Data.List (find, intercalate)
import Data.Monoid ((<>))
import Data.Settings.Types (showOption)
import Data.Text (Text)
import FunBot.History (quote, reportHistory')
import FunBot.Memos (submitMemo)
import FunBot.Settings
import FunBot.Settings.Sections.Channels (addChannel)
import FunBot.Settings.Sections.Feeds (addFeed, deleteFeed)
import FunBot.Settings.Sections.Repos
import FunBot.Settings.Sections.Shortcuts (addShortcut, deleteShortcut)
import FunBot.Types
import FunBot.UserOptions
import FunBot.Util (getHistoryLines, cmds, helps)
import Network.IRC.Fun.Bot.Behavior
import Network.IRC.Fun.Bot.Chat
import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Bot.Types
import Text.Read (readMaybe)
import Network.IRC.Fun.Types.Base

import qualified Data.CaseInsensitive as CI
import qualified Data.Text as T
import qualified Data.Text.Read as TR

respondAddSpec
    :: Maybe Channel
    -> Nickname
    -> [Text]
    -> (MsgContent -> BotSession ())
    -> BotSession ()
respondAddSpec mchan nick [host, space, repo, chan] send = do
    succ <-
        addRepoAnnSpec
            (DevHostLabel host)
            (RepoSpace $ CI.mk space)
            (RepoName $ CI.mk repo)
            (Channel chan)
    if succ
        then send $ MsgContent "Git event announcement spec added."
        else failBack mchan nick $ OtherFail "Repo not found."
respondAddSpec mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 4)

cmdAddSpec = Command
    { cmdNames    = cmds ["spec+", "add-spec"]
    , cmdRespond  = respondAddSpec
    , cmdHelp     = helps
        [ ( "spec+ <host> <space> <repo> <channel>"
          , "add a channel to which git repo events will be announced, with \
            \default settings"
          )
        ]
    , cmdExamples =
        [ "spec+ notabug SylvieLorxu CSSBox #freepost"
        ]
    }

respondDeleteSpec
    :: Maybe Channel
    -> Nickname
    -> [Text]
    -> (MsgContent -> BotSession ())
    -> BotSession ()
respondDeleteSpec mchan nick [host, space, repo, num] send =
    case TR.signed TR.decimal num of
        Right (pos, "") ->
            if pos < 1
                then failBack mchan nick $ InvalidArg (Just 4) (Just num)
                else do
                    res <-
                        deleteRepoAnnSpec
                            (DevHostLabel host)
                            (RepoSpace $ CI.mk space)
                            (RepoName $ CI.mk repo)
                            (pos - 1)
                    case res of
                        Nothing ->
                            send $ MsgContent $
                                "Git event announcement spec " <>
                                num                            <>
                                " removed."
                        Just False ->
                            failBack mchan nick $
                            OtherFail "Repo not found."
                        Just True  ->
                            failBack mchan nick $
                            OtherFail "Spec number out of range."
        _ -> failBack mchan nick $ InvalidArg (Just 3) (Just num)
respondDeleteSpec mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 3)

cmdDeleteSpec = Command
    { cmdNames    = cmds ["spec-", "delete-spec"]
    , cmdRespond  = respondDeleteSpec
    , cmdHelp     = helps
        [ ( "spec- <host> <space> <repo> <num>"
          , "remove a git event announcement specification with the given \
            \index number (as found in the settings tree, i.e. starting from \
            \1) from the given repo."
          )
        ]
    , cmdExamples =
        [ "spec- notabug fr33domlover oldstuff 1"
        ]
    }

invalid :: Text -> Bool
invalid t = T.null t || T.any (== '/') t

respondAddRepo
    :: Maybe Channel
    -> Nickname
    -> [Text]
    -> (MsgContent -> BotSession ())
    -> BotSession ()
respondAddRepo mchan nick [host, space, repo, chan] send
    | invalid repo =
        failBack mchan nick $ InvalidArg (Just 3) (Just repo)
    | invalid space =
        failBack mchan nick $ InvalidArg (Just 2) (Just space)
    | otherwise = do
        res <-
            addRepo
                (DevHostLabel host)
                (RepoSpace $ CI.mk space)
                (RepoName $ CI.mk repo)
                (Channel chan)
        case res of
            Nothing -> send $ MsgContent "Git repo added."
            Just False ->
                failBack mchan nick $
                OtherFail "This host label isn’t registered."
            Just True ->
                failBack mchan nick $
                OtherFail "This repo is already registered."
respondAddRepo mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 4)

cmdAddRepo = Command
    { cmdNames    = cmds ["repo+", "add-repo"]
    , cmdRespond  = respondAddRepo
    , cmdHelp     = helps
        [ ( "repo+ <host> <space> <repo> <channel>"
          , "add a repo to announce its events in the given channel, with \
            \default settings."
          )
        ]
    , cmdExamples =
        [ "repo+ notabug Tsyesika Federated-MediaGoblin #mediagoblin"
        ]
    }

respondDeleteRepo
    :: Maybe Channel
    -> Nickname
    -> [Text]
    -> (MsgContent -> BotSession ())
    -> BotSession ()
respondDeleteRepo mchan nick [host, space, repo] send = do
    succ <-
        deleteRepo
            (DevHostLabel host)
            (RepoSpace $ CI.mk space)
            (RepoName $ CI.mk repo)
    if succ
        then send $ MsgContent "Git repo removed."
        else failBack mchan nick $ OtherFail "No such repo/owner pair found."
respondDeleteRepo mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 3)

cmdDeleteRepo = Command
    { cmdNames    = cmds ["repo-", "delete-repo"]
    , cmdRespond  = respondDeleteRepo
    , cmdHelp     = helps
        [ ( "repo- <host> <space> <repo>"
          , "stop announcing events for the given repo and remove its \
            \settings."
          )
        ]
    , cmdExamples =
        [ "repo- notabug fr33domlover oldstuff"
        ]
    }