{- This file is part of funbot.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ 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.Sources.WebListener.GitLab
    ( dispatchGitLab
    )
where

import qualified Data.ByteString.Lazy.Char8 as BC
import           Data.Maybe (fromMaybe)
import qualified Data.Text as T
import           FunBot.Types
import           Network.HTTP (Request (..))
import           Network.URI
import qualified Web.Hook.GitLab as G

refToBranch :: T.Text -> T.Text
refToBranch ref = fromMaybe ref $ T.stripPrefix "refs/heads/" ref

refToTag :: T.Text -> T.Text
refToTag ref = fromMaybe ref $ T.stripPrefix "refs/tags/" ref

nl c = c == '\n' || c == '\r'

urlToOwner url =
    case parseAbsoluteURI url of
        Just (URI { uriPath = _ : p }) -> takeWhile (/= '/') p
        _                              -> ""

makeCommit commit =
    let author = T.unpack $ G.authorName $ G.commitAuthor commit
        msg    = T.unpack $ T.takeWhile (not . nl) $ G.commitMessage commit
        url    = T.unpack $ G.commitUrl commit
    in  Commit author msg url

makeBranch ref repo =
    let branch = T.unpack $ refToBranch ref
        repo'  = T.unpack $ G.repoName repo
        owner  = urlToOwner $ T.unpack $ G.repoHomepage repo
    in  Branch branch repo' owner

makeTag ref repo user =
    let user'  = T.unpack user
        ref'   = T.unpack $ refToTag ref
        repo'  = T.unpack $ G.repoName repo
        owner  = urlToOwner $ T.unpack $ G.repoHomepage repo
    in  GitTag $ Tag user' ref' repo' owner

makeMR mre =
    let mr     = G.mreRequest mre
        author = T.unpack $ G.userName $ G.mreUser mre
        iid    = G.mrId mr
        repo   = T.unpack $ G.mepName $ G.mrTarget mr
        owner  = T.unpack $ G.mepNamespace $ G.mrTarget mr
        title  = T.unpack $ T.takeWhile (not . nl) $ G.mrTitle mr -- to be safe
        url    = T.unpack $ G.mrUrl mr
        action = T.unpack $ G.mreAction mre
    in  MergeRequest $ MR author iid repo owner title url action

dispatchPush push _pushMany p =
    let commits = map makeCommit $ G.pushCommits p
        branch = makeBranch (G.pushRef p) (G.pushRepository p)
    in  push $ GitPush $ Push branch commits

dispatchTag push pushMany p =
    push $ makeTag (G.pushRef p) (G.pushRepository p) (G.pushUserName p)

dispatchMR push pushMany e = push $ makeMR e

dispatchGitLab push pushMany request =
    case G.parse $ rqBody request of
        Left e -> do
            putStr "Web hook source: GitLab: "
            print e
            BC.putStrLn $ rqBody request
        Right (G.EventPush e)         -> dispatchPush push pushMany e
        Right (G.EventPushTag e)      -> dispatchTag push pushMany e
        Right (G.EventIssue e)        -> putStrLn ">>> GitLab Issue"
        Right (G.EventMergeRequest e) -> dispatchMR push pushMany e