{- This file is part of funbot. - - Written in 2015, 2016 by fr33domlover . - - ♡ 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 - . -} {-# 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+ " , "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- " , "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+ " , "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- " , "stop announcing events for the given repo and remove its \ \settings." ) ] , cmdExamples = [ "repo- notabug fr33domlover oldstuff" ] }