{- This file is part of funbot. - - Written in 2015 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 #-} module FunBot.ExtHandlers ( handler ) where import Control.Monad (forM_, liftM, when) import Control.Monad.IO.Class (liftIO) import Data.Char (toLower) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Time.Clock (diffUTCTime) import FunBot.ExtEvents import FunBot.Types import FunBot.Util (passes) import Network.HTTP (Request (..), RequestMethod (..)) import Network.IRC.Fun.Bot.Chat (sendToChannel) import Network.IRC.Fun.Bot.Nicks (channelIsTracked, isInChannel) import Network.IRC.Fun.Bot.State import Network.IRC.Fun.Color import Text.Printf (printf) import qualified Data.HashMap.Lazy as M import qualified Data.Text as T import qualified Web.Hook.GitLab as GitLab import qualified Web.Hook.Gogs as Gogs makeEllip len = let ellip = "..." n = (len - 1) `div` 2 - 1 padl = replicate n ' ' m = len - length padl - length ellip padr = replicate m ' ' in padl ++ ellip ++ padr formatCommit branch repo (Commit author msg url) = encode $ Green #> Pure author <> " " <> Maroon #> Pure branch <> " " <> Purple #> Pure repo <> " | " <> Teal #> Pure msg <> " " <> Gray #> Pure url formatEllipsis len branch repo n = encode $ Green #> Pure (makeEllip len) <> " " <> Maroon #> Pure branch <> " " <> Purple #> Pure repo <> " | " <> Navy #> Pure ("... another " ++ show n ++ " commits ...") formatTag (Tag author ref repo _owner) = encode $ Green #> Pure author <> " " <> Purple #> Pure repo <> " " <> Teal #> Pure ref formatMR (MergeRequest author iid _repo _owner title url action) = encode $ Green #> Pure author <> " " <> Maroon #> Pure action <> " " <> Purple #> Pure ('#' : show iid) <> " | " <> Teal #> Pure title <> " " <> Gray #> Pure url formatNews item fields = let -- Filtered fields filt pass val = if pass then val else Nothing authorF = filt (dispAuthor fields) (itemAuthor item) fTitleF = filt (dispFeedTitle fields) (itemFeedTitle item) urlF = filt (dispUrl fields) (itemUrl item) -- Separate components author = fmap (\ a -> Green #> Pure a) authorF fTitle = fmap (\ ft -> Purple #> Pure ft) fTitleF iTitle = Teal #> Pure (itemTitle item) url = fmap (\ u -> Gray #> Pure u) urlF -- Now combine them af = case (author, fTitle) of (Nothing, Nothing) -> Nothing (a@(Just _), Nothing) -> a (Nothing, t@(Just _)) -> t (Just a, Just t) -> Just $ a <> " @ " <> t iu = case url of Nothing -> iTitle Just u -> iTitle <> " " <> u in encode $ case af of Nothing -> iu Just af' -> af' <> " | " <> iu formatPaste (Paste author verb title url _chan) = printf "%v %v “%v” | %v" author verb title url lower = map toLower keyb b = (branchRepo b, lower $ branchRepoOwner b) keyt t = (tagRepo t, lower $ tagRepoOwner t) keym mr = (mrRepo mr, lower $ mrRepoOwner mr) annCommits branch msgs ellip spec = let chan = pAnnChannel spec in when (branch `passes` pAnnBranches spec) $ if pAnnAllCommits spec || length msgs <= 3 then mapM_ (sendToChannel chan) msgs else do let firstCommit = head msgs lastCommit = last msgs between = length msgs - 2 sendToChannel chan firstCommit sendToChannel chan ellip sendToChannel chan lastCommit makeVerbal [] = "... ummm... I don’t know, actually. How embarrassing" makeVerbal [n] = n makeVerbal [n, m] = n ++ " and " ++ m makeVerbal (n:ns) = n ++ ", " ++ makeVerbal ns handler (GitPushEvent (Push branch commits)) = do chans <- getStateS $ stGitAnnChans . bsSettings case M.lookup (keyb branch) chans of Just specs -> let fmt = formatCommit (branchName branch) (branchRepo branch) msgs = map fmt commits len = case commits of [] -> 0 cs -> length $ commitAuthor $ last cs ellip = formatEllipsis len (branchName branch) (branchRepo branch) (length msgs - 2) in mapM_ (annCommits (branchName branch) msgs ellip) specs Nothing -> liftIO $ putStrLn $ "Ext handler: Git push for unregistered repo: " ++ show (keyb branch) handler (GitTagEvent tag) = do chans <- getStateS $ stGitAnnChans . bsSettings case M.lookup (keyt tag) chans of Just specs -> let msg = formatTag tag ann chan = sendToChannel chan msg in mapM_ (ann . pAnnChannel) specs Nothing -> liftIO $ putStrLn $ "Ext handler: Tag for unregistered repo: " ++ show (keyt tag) handler (MergeRequestEvent mr) = do chans <- getStateS $ stGitAnnChans . bsSettings case M.lookup (keym mr) chans of Just specs -> let msg = formatMR mr ann chan = sendToChannel chan msg in mapM_ (ann . pAnnChannel) specs Nothing -> liftIO $ putStrLn $ "Ext handler: MR for unregistered repo: " ++ show (keym mr) handler (NewsEvent item) = do feeds <- getStateS $ stWatchedFeeds . bsSettings let label = itemFeedLabel item case M.lookup label feeds of Just NewsFeed { nfAnnSpec = spec } -> let msg = formatNews item (nAnnFields spec) in mapM_ (\ chan -> sendToChannel chan msg) (nAnnChannels spec) Nothing -> liftIO $ do putStrLn $ "Ext handler: Feed item with unknown label: " ++ label print item handler (PasteEvent paste) = sendToChannel (pasteChannel paste) $ formatPaste paste handler (WelcomeEvent nick chan) = do getTime <- askTimeGetter now <- liftIO $ liftM fst getTime mt <- getStateS $ M.lookup chan . bsLastMsgTime let quiet = case mt of Nothing -> True Just t -> diffUTCTime t now >= 60 --seconds tracked <- channelIsTracked chan isHere <- nick `isInChannel` chan let assumeHere = tracked && isHere when (quiet && assumeHere) $ do chans <- getStateS $ stChannels . bsSettings case M.lookup chan chans of Nothing -> return () Just cs -> sendToChannel chan $ printf "Welcome, %v! The channel is pretty quiet right now, so I \ \thought I’d say hello. For reference, the main people \ \here to ping if you have questions are %v. Also, if no \ \one responds for a while, try emailing us at %v, or just \ \come back later." nick (makeVerbal $ csFolks cs) (csEmail cs)