{- This file is part of funbot-ext-events.
 -
 - 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/>.
 -}

-- For json field names
{-# LANGUAGE OverloadedStrings #-}

module FunBot.ExtEvents
    ( Repository (..)
    , ProjectObject (..)
    , Commit (..)
    , Push (..)
    , Tag (..)
    , Issue (..)
    , Note (..)
    , MergeRequest (..)
    , NewsItem (..)
    , Paste (..)
    , ExtEvent (..)
    )
where

import Control.Applicative
import Data.Aeson
import Data.Aeson.Types (Parser, typeMismatch)
import Data.Text (Text)

-- | A version control repository.
data Repository = Repository
    { -- | The repository's name. For example, @funbot-ext-events@.
      repoName  :: Text
      -- | The repository's namespace, i.e. username or team name under which
      -- the repository is being managed. For example, @fr33domlover@.
    , repoSpace :: Text
      -- | Network location where the repository is hosted. For now this should
      -- in most cases be the website URL's host part, but could be something
      -- else if/when we have distributed repository sharing. For example,
      -- @notabug.org@.
    , repoHost  :: Text
    }
    deriving Show

instance FromJSON Repository where
    parseJSON (Object o) =
        Repository <$>
        o .: "name" <*>
        o .: "space" <*>
        o .: "host"
    parseJSON v          = typeMismatch "Repository" v

instance ToJSON Repository where
    toJSON repo = object
        [ "name"  .= repoName  repo
        , "space" .= repoSpace repo
        , "host"  .= repoHost  repo
        ]

-- | An object that is part of a project, such as a merge request or an issue
-- or a series of commits being pushed.
data ProjectObject a = ProjectObject
    { -- | The project repository.
      poRepo :: Repository
      -- | The object itself.
    , poObj  :: a
    }
    deriving Show

instance FromJSON a => FromJSON (ProjectObject a) where
    parseJSON (Object o) =
        ProjectObject <$>
        o .: "repo" <*>
        o .: "obj"
    parseJSON v          = typeMismatch "ProjectObject" v

instance ToJSON a => ToJSON (ProjectObject a) where
    toJSON po = object
        [ "repo" .= poRepo po
        , "obj"  .= poObj  po
        ]

-- | A version control system commit, i.e. a set of changes with a description.
data Commit = Commit
    { -- | The author name. For example, @John Doe@.
      commitAuthor   :: Text
      -- | The commit title. For example, @Support encrypted messages@.
    , commitTitle    :: Text
      -- | A web view URL at which the commit details can be displayed.
    , commitUrl      :: Text
      -- | A list of files (relative to the repository top level) added to the
      -- repository in this commit. For example, @src\/FunBot\/ExtEvents.hs@.
    , commitAdded    :: [Text]
      -- | A list of files modified in the repository in this commit.
    , commitModified :: [Text]
      -- | A list of files removed from the repository in this commit.
    , commitRemoved  :: [Text]
    }
    deriving Show

instance FromJSON Commit where
    parseJSON (Object o) =
        Commit <$>
        o .: "author" <*>
        o .: "title" <*>
        o .: "url" <*>
        o .: "added" <*>
        o .: "modified" <*>
        o .: "removed"
    parseJSON v          = typeMismatch "Commit" v

instance ToJSON Commit where
    toJSON (Commit author title url added modified removed) = object
        [ "author"   .= author
        , "title"    .= title
        , "url"      .= url
        , "added"    .= added
        , "modified" .= modified
        , "removed"  .= removed
        ]

-- | A version control push operation, i.e. one or more commits being added to
-- a specific branch or a repsitory. Note that tags can be pushed too, but for
-- that see the 'Tag' type.
data Push = Push
    { pushBranch  :: Text
    , pushCommits :: [Commit]
    }
    deriving Show

instance FromJSON Push where
    parseJSON (Object o) =
        Push <$>
        o .: "branch" <*>
        o .: "commits"
    parseJSON v          = typeMismatch "Push" v

instance ToJSON Push where
    toJSON (Push branch commits) = object
        [ "branch"  .= branch
        , "commits" .= commits
        ]

-- | A version control tag. Allows a specific state of the repository to be
-- referred by name.
data Tag = Tag
    { -- | Tag author name, for example @John Doe@.
      tagAuthor :: Text
      -- | Tag label, for example @0.3.4.1@ (referring to a release version).
    , tagRef    :: Text
    }
    deriving Show

instance FromJSON Tag where
    parseJSON (Object o) =
        Tag <$>
        o .: "author" <*>
        o .: "ref"
    parseJSON v          = typeMismatch "Tag" v

instance ToJSON Tag where
    toJSON tag = object
        [ "author" .= tagAuthor tag
        , "ref"    .= tagRef tag
        ]

-- | A bug, request or other work item attached to a project.
data Issue = Issue
    { -- | Issue author name. For example, @John Doe@.
      issueAuthor    :: Text
      -- | The issue's unique identifier.
    , issueId        :: Int
      -- | Issue title text.
    , issueTitle     :: Text
      -- | A web view URL at which the issue's details can be viewed and
      -- perhaps modified.
    , issueUrl       :: Text
      -- | An action being applied to the issue, which is causing the event to
      -- be sent to the FunBot instance.
    , issueAction    :: Text
    }
    deriving Show

instance FromJSON Issue where
    parseJSON (Object o) =
        Issue <$>
        o .: "author" <*>
        o .: "id" <*>
        o .: "title" <*>
        o .: "url" <*>
        o .: "action"
    parseJSON v          = typeMismatch "Issue" v

instance ToJSON Issue where
    toJSON issue = object
        [ "author" .= issueAuthor issue
        , "id"     .= issueId issue
        , "title"  .= issueTitle issue
        , "url"    .= issueUrl issue
        , "action" .= issueAction issue
        ]

-- | A comment made on some project object.
data Note = Note
    { -- | Note author name, e.g. @John Doe@.
      noteAuthor    :: Text
      -- | Note content for the bot to display. Since notes can be long, this
      -- should be only the portion for the bot to display. The bot should
      -- examine this field and shorten long notes, but you shouldn't rely on
      -- it and provide the right short part here.
    , noteContent   :: Text
      -- | The project object being commented on, e.g. @issue #419@.
    , noteTarget    :: Text
      -- | A web view URL at which the note can be viewed.
    , noteUrl       :: Text
    }
    deriving Show

instance FromJSON Note where
    parseJSON (Object o) =
        Note <$>
        o .: "author" <*>
        o .: "content" <*>
        o .: "target" <*>
        o .: "url"
    parseJSON v          = typeMismatch "Note" v

instance ToJSON Note where
    toJSON (Note author content target url) = object
        [ "author"  .= author
        , "content" .= content
        , "target"  .= target
        , "url"     .= url
        ]

-- | A request from a user to merge their code changes into the project.
data MergeRequest = MergeRequest
    { -- | Merge request author name, e.g. @John Doe@.
      mrAuthor    :: Text
      -- | Merge request unique identifier.
    , mrId        :: Int
      -- | Merge request title.
    , mrTitle     :: Text
      -- | A web view URL at which the merge request can be viewed and perhaps
      -- edited.
    , mrUrl       :: Text
      -- | An action being applied to the merge request, which is causing the
      -- event to be sent to the FunBot instance.
    , mrAction    :: Text
    }
    deriving Show

instance FromJSON MergeRequest where
    parseJSON (Object o) =
        MergeRequest <$>
        o .: "author" <*>
        o .: "id" <*>
        o .: "title" <*>
        o .: "url" <*>
        o .: "action"
    parseJSON v          = typeMismatch "MergeRequest" v

instance ToJSON MergeRequest where
    toJSON mr = object
        [ "author" .= mrAuthor mr
        , "id"     .= mrId mr
        , "title"  .= mrTitle mr
        , "url"    .= mrUrl mr
        , "action" .= mrAction mr
        ]

-- | A news feed item.
data NewsItem = NewsItem
    { -- | Short label identifying the new feed to which the item belongs.
      itemFeedLabel :: Text
      -- | The name of the feed to which the item belongs.
    , itemFeedTitle :: Maybe Text
      -- | Item title.
    , itemTitle     :: Text
      -- | Item author name.
    , itemAuthor    :: Maybe Text
      -- | URL at which the item's content can be viewed.
    , itemUrl       :: Maybe Text
    }
    deriving Show

instance FromJSON NewsItem where
    parseJSON (Object o) =
        NewsItem <$>
        o .: "feed-label" <*>
        o .: "feed-title" <*>
        o .: "title" <*>
        o .: "author" <*>
        o .: "url"
    parseJSON v          = typeMismatch "NewsItem" v

instance ToJSON NewsItem where
    toJSON (NewsItem fLabel fTitle title author url) = object
        [ "feed-label" .= fLabel
        , "feed-title" .= fTitle
        , "title"      .= title
        , "author"     .= author
        , "url"        .= url
        ]

-- | A piece of text uploaded to a website for quick sharing.
data Paste = Paste
    { -- | Paste author name or IRC nickname.
      pasteAuthor  :: Text
      -- | Verb indicating the action done with the paste.
    , pasteVerb    :: Text
      -- | Paste title.
    , pasteTitle   :: Text
      -- | URL at which the paste content can be viewed.
    , pasteUrl     :: Text
      -- | An IRC channel into which to announce the paste.
    , pasteChannel :: Text
    }
    deriving Show

instance FromJSON Paste where
    parseJSON (Object o) =
        Paste <$>
        o .: "author" <*>
        o .: "verb" <*>
        o .: "title" <*>
        o .: "url" <*>
        o .: "channel"
    parseJSON v          = typeMismatch "Paste" v

instance ToJSON Paste where
    toJSON (Paste author verb title url chan) = object
        [ "author"  .= author
        , "verb"    .= verb
        , "title"   .= title
        , "url"     .= url
        , "channel" .= chan
        ]

-- | An event coming from one of the external event sources.
data ExtEvent
    -- | Git commits pushed into a repo.
    = GitPushEvent (ProjectObject Push)
    -- | A git tag pushed into a repo.
    | GitTagEvent (ProjectObject Tag)
    -- | An issue related event.
    | IssueEvent (ProjectObject Issue)
    -- | A merge request related event.
    | MergeRequestEvent (ProjectObject MergeRequest)
    -- | A comment made on an issue or MR or some other object.
    | NoteEvent (ProjectObject Note)
    -- | New news item published.
    | NewsEvent NewsItem
    -- | Paste related event in a paste server.
    | PasteEvent Paste
    -- | A new IRC user needs to be welcomed to a channel.
    | WelcomeEvent Text Text
    deriving Show

text :: Parser Text -> Text -> Parser Text
text parser expected = do
    got <- parser
    if got == expected
        then return got
        else empty

instance FromJSON ExtEvent where
    parseJSON (Object o) =
        let kind = text $ o .: "type"
            event label ctor = kind label *> (ctor <$> o .: "data")
        in  event "push"  GitPushEvent      <|>
            event "tag"   GitTagEvent       <|>
            event "mr"    MergeRequestEvent <|>
            event "note"  NoteEvent         <|>
            event "issue" IssueEvent        <|>
            event "news"  NewsEvent         <|>
            event "paste" PasteEvent
    parseJSON v          = typeMismatch "ExtEvent" v

instance ToJSON ExtEvent where
    toJSON (GitPushEvent commits) = object [ "type" .= ("push" :: Text)
                                           , "data" .= commits
                                           ]
    toJSON (GitTagEvent tag)      = object [ "type" .= ("tag" :: Text)
                                           , "data" .= tag
                                           ]
    toJSON (IssueEvent issue)     = object [ "type" .= ("issue" :: Text)
                                           , "data" .= issue
                                           ]
    toJSON (MergeRequestEvent mr) = object [ "type" .= ("mr" :: Text)
                                           , "data" .= mr
                                           ]
    toJSON (NoteEvent note)       = object [ "type" .= ("note" :: Text)
                                           , "data" .= note
                                           ]
    toJSON (NewsEvent item)       = object [ "type" .= ("news" :: Text)
                                           , "data" .= item
                                           ]
    toJSON (PasteEvent paste)     = object [ "type" .= ("paste" :: Text)
                                           , "data" .= paste
                                           ]
    toJSON (WelcomeEvent _ _)     = object []