{- 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 Control.Monad (when)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import FunBot.ExtEvents
import Formatting
import FunBot.Sources.WebListener.Util
import Network.HTTP (Request (..))
import Network.URI

import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as BC
import qualified Data.Text as T
import qualified Web.Hook.GitLab as G

makeCommit :: G.Commit -> Commit
makeCommit commit = Commit
    { commitAuthor   = G.authorName $ G.commitAuthor commit
    , commitTitle    = takeLine $ G.commitMessage commit
    , commitUrl      = G.commitUrl commit
    , commitAdded    = G.commitAdded commit
    , commitModified = G.commitModified commit
    , commitRemoved  = G.commitRemoved commit
    }

makeRepo :: G.Repository -> Repository
makeRepo repo = Repository
    { repoName  = G.repoName repo
    , repoSpace = uriSpace uri
    , repoHost  = uriHost uri
    }
    where
    uri = parseURI $ T.unpack $ G.repoHomepage repo

makePush :: G.Push -> ExtEvent
makePush push = GitPushEvent ProjectObject
    { poRepo = makeRepo $ G.pushRepository push
    , poObj  = Push
        { pushBranch  = refToBranch $ G.pushRef push
        , pushCommits = map makeCommit $ G.pushCommits push
        }
    }

makeTag :: T.Text -> G.Repository -> T.Text -> ExtEvent
makeTag ref repo user = GitTagEvent $ ProjectObject
    { poRepo = makeRepo repo
    , poObj  = Tag
        { tagAuthor = user
        , tagRef    = refToTag ref
        }
    }

makeIssue :: G.IssueEvent -> ExtEvent
makeIssue ie = IssueEvent ProjectObject
    { poRepo = makeRepo $ G.ieRepo ie
    , poObj  = Issue
        { issueAuthor = G.userName $ G.ieUser ie
        , issueId     = G.issueId i
        , issueTitle  = takeLine $ G.issueTitle i
        , issueUrl    = G.issueUrl i
        , issueAction = G.ieAction ie
        }
    }
    where
    i = G.ieIssue ie

makeMR :: G.MergeRequestEvent -> ExtEvent
makeMR mre = MergeRequestEvent ProjectObject
    { poRepo = Repository
        { repoName  = G.mepName $ G.mrTarget mr
        , repoSpace = G.mepNamespace $ G.mrTarget mr
        , repoHost  = uriHost $ parseURI $ T.unpack $ G.mepWebUrl target
        }
    , poObj  = MergeRequest
        { mrAuthor = G.userName $ G.mreUser mre
        , mrId     = G.mrId mr
        , mrTitle  = takeLine $ G.mrTitle mr
        , mrUrl    = G.mrUrl mr
        , mrAction = G.mreAction mre
        }
    }
    where
    mr     = G.mreRequest mre
    target = G.mrTarget mr

shorten n t =
    if t `T.compareLength` n == GT
        then T.take n t <> "[…]"
        else t

showNoteTarget :: G.NoteTarget -> T.Text
showNoteTarget (G.NTCommit c) =
    sformat
        ("commit " % stext % " (“" % stext % "”)")
        (T.take 8 $ G.commitId c)
        (shorten 40 $ takeLine $ G.commitMessage c)
showNoteTarget (G.NTIssue i) =
    sformat ("issue #" % int) (G.issueId i)
showNoteTarget (G.NTMergeRequest mr) =
    sformat ("MR #" % int) (G.mrId mr)
showNoteTarget (G.NTSnippet s) =
    sformat ("snippet #" % int) (G.snippetId s)

makeNote :: G.NoteEvent -> ExtEvent
makeNote ne = NoteEvent ProjectObject
    { poRepo = makeRepo $ G.neRepo ne
    , poObj  = Note
        { noteAuthor  = G.userName $ G.neUser ne
        , noteContent = shorten 200 $ takeLine $ G.noteNote n
        , noteTarget  = showNoteTarget $ G.neTarget ne
        , noteUrl     = G.noteUrl n
        }
    }
    where
    n = G.neNote ne
    maxlen = 200

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) ->
            push $ makePush e
        Right (G.EventPushTag e) ->
            push $
            makeTag (G.pushRef e) (G.pushRepository e) (G.pushUserName e)
        Right (G.EventIssue e) ->
            push $ makeIssue e
        Right (G.EventMergeRequest e) -> do
            let mre@(MergeRequestEvent (ProjectObject _ mr)) = makeMR e
            when (mrAction mr /= "update") $ push mre
        Right (G.EventNote e) ->
            push $ makeNote e