vcs-web-hook-parse 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+296/−131 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• NEWS +24/−0
• src/Web/Hook/GitLab.hs +270/−129
• vcs-web-hook-parse.cabal +2/−2

@@ -3,6 +3,30 @@   +vcs-web-hook-parse 0.2.0.0 -- 2016-01-27+========================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* Add added/modified/removed file list fields to Commit for Gitlab+* Support for Gitlab note events++Bug fixes:++* (None)++Dependency changes:++* (None)+++++ vcs-web-hook-parse 0.1.0.0 -- 2015-08-10 ======================================== 

@@ -18,16 +18,22 @@ module Web.Hook.GitLab     ( CommitID     , Url+    , File     , Author (..)     , User (..)     , Commit (..)     , MergeEndpoint (..)     , Repository (..)+    , Diff (..)+    , Snippet (..)+    , NoteTarget (..)     , Issue (..)     , MergeRequest (..)+    , Note (..)     , Push (..)     , IssueEvent (..)     , MergeRequestEvent (..)+    , NoteEvent (..)     , Event (..)     , parse     )@@ -36,7 +42,8 @@ import Control.Applicative import Control.Monad (mzero) import Data.Aeson-import Data.Aeson.Types (Parser)+import Data.Aeson.Types (Parser, typeMismatch)+ import qualified Data.ByteString.Lazy as B import qualified Data.Text as T @@ -44,43 +51,107 @@  type Url = T.Text +type File = T.Text++text :: Parser T.Text -> T.Text -> Parser T.Text+text parser expected = do+    got <- parser+    if got == expected+        then return got+        else mzero+ data Author = Author     { authorName  :: T.Text     , authorEmail :: T.Text     } +instance FromJSON Author where+    parseJSON (Object o) =+        Author <$>+        o .: "name" <*>+        o .: "email"+    parseJSON v          = typeMismatch "Author" v+ data User = User     { userName     :: T.Text     , userUsername :: T.Text     , userAvatar   :: Url     } +instance FromJSON User where+    parseJSON (Object o) =+        User <$>+        o .: "name" <*>+        o .: "username" <*>+        o .: "avatar_url"+    parseJSON v          = typeMismatch "User" v+ data Commit = Commit     { commitId        :: CommitID     , commitMessage   :: T.Text     , commitTimestamp :: T.Text     , commitUrl       :: Url     , commitAuthor    :: Author+    , commitAdded     :: [File]+    , commitModified  :: [File]+    , commitRemoved   :: [File]     } +instance FromJSON Commit where+    parseJSON (Object o) =+        Commit <$>+        o .:  "id"              <*>+        o .:  "message"         <*>+        o .:  "timestamp"       <*>+        o .:  "url"             <*>+        o .:  "author"          <*>+        o .:? "added"    .!= [] <*>+        o .:? "modified" .!= [] <*>+        o .:? "removed"  .!= []+    parseJSON v          = typeMismatch "Commit" v+ data MergeEndpoint = MergeEndpoint     { mepName       :: T.Text     , mepSshUrl     :: Url-    , mepHttpurl    :: Url+    , mepHttpUrl    :: Url+    , mepWebUrl     :: Url     , mepVisibility :: Int     , mepNamespace  :: T.Text     } +instance FromJSON MergeEndpoint where+    parseJSON (Object o) =+        MergeEndpoint <$>+        o .: "name" <*>+        o .: "ssh_url" <*>+        o .: "http_url" <*>+        o .: "web_url" <*>+        o .: "visibility_level" <*>+        o .: "namespace"+    parseJSON v          = typeMismatch "MergeEndpoint" v+ data Repository = Repository     { repoName       :: T.Text     , repoUrl        :: Url     , repoDesc       :: T.Text     , repoHomepage   :: Url-    , repoGitHttpUrl :: Url-    , repoGitSshUrl  :: Url-    , repoVisibility :: Int+    , repoGitHttpUrl :: Maybe Url+    , repoGitSshUrl  :: Maybe Url+    , repoVisibility :: Maybe Int     } +instance FromJSON Repository where+    parseJSON (Object o) =+        Repository <$>+        o .:  "name" <*>+        o .:  "url" <*>+        o .:  "description" <*>+        o .:  "homepage" <*>+        o .:? "git_http_url" <*>+        o .:? "git_ssh_url" <*>+        o .:? "visibility_level"+    parseJSON v          = typeMismatch "Repository" v+ data Issue = Issue     { issueInternalId  :: Int     , issueTitle       :: T.Text@@ -98,6 +169,25 @@     , issueUrl         :: Url     } +instance FromJSON Issue where+    parseJSON (Object o) =+        Issue <$>+        o .: "id" <*>+        o .: "title" <*>+        o .: "assignee_id" <*>+        o .: "author_id" <*>+        o .: "project_id" <*>+        o .: "created_at" <*>+        o .: "updated_at" <*>+        o .: "position" <*>+        o .: "branch_name" <*>+        o .: "description" <*>+        o .: "milestone_id" <*>+        o .: "state" <*>+        o .: "iid" <*>+        o .:? "url" .!= T.empty+    parseJSON v          = typeMismatch "Issue" v+ data MergeRequest = MergeRequest     { mrInternalId      :: Int     , mrTargetBranch    :: T.Text@@ -119,9 +209,97 @@     , mrSource          :: MergeEndpoint     , mrTarget          :: MergeEndpoint     , mrLastCommit      :: Commit+    , mrWorkInProgress  :: Bool     , mrUrl             :: Url     } +instance FromJSON MergeRequest where+    parseJSON (Object o) =+        MergeRequest <$>+        o .: "id" <*>+        o .: "target_branch" <*>+        o .: "source_branch" <*>+        o .: "source_project_id" <*>+        o .: "author_id" <*>+        o .: "assignee_id" <*>+        o .: "title" <*>+        o .: "created_at" <*>+        o .: "updated_at" <*>+        --v .: "st_commits" <*>+        --v .: "st_diffs" <*>+        o .: "milestone_id" <*>+        o .: "state" <*>+        o .: "merge_status" <*>+        o .: "target_project_id" <*>+        o .: "iid" <*>+        o .: "description" <*>+        o .: "source" <*>+        o .: "target" <*>+        o .: "last_commit" <*>+        o .: "work_in_progress" <*>+        o .:? "url" .!= T.empty+    parseJSON v          = typeMismatch "MergeRequest" v++data Diff = Diff+    { diffDiff        :: T.Text+    , diffNewPath     :: T.Text+    , diffOldPath     :: T.Text+    , diffAMode       :: T.Text+    , diffBMode       :: T.Text+    , diffNewFile     :: Bool+    , diffRenamedFile :: Bool+    , diffDeletedFile :: Bool+    }++instance FromJSON Diff where+    parseJSON (Object o) =+        Diff <$>+        o .: "diff" <*>+        o .: "new_path" <*>+        o .: "old_path" <*>+        o .: "a_mode" <*>+        o .: "b_mode" <*>+        o .: "new_file" <*>+        o .: "renamed_file" <*>+        o .: "deleted_file"+    parseJSON v          = typeMismatch "Diff" v++data Note = Note+    { noteId         :: Int+    , noteNote       :: T.Text+    --, noteType       :: NoteableType+    , noteAuthorId   :: Int+    , noteCreatedAt  :: T.Text+    , noteUpdatedAt  :: T.Text+    , noteProjectId  :: Int+    --, noteAttachment :: Maybe ()+    , noteLineCode   :: Maybe T.Text+    , noteCommitId   :: CommitID+    , noteNoteableId :: Maybe Int+    , noteSystem     :: Bool+    , noteStDiff     :: Maybe Diff+    , noteUrl        :: Url+    }++instance FromJSON Note where+    parseJSON (Object o) =+        Note <$>+        o .: "id" <*>+        o .: "note" <*>+        --o .: "noteable_type" <*>+        o .: "author_id" <*>+        o .: "created_at" <*>+        o .: "updated_at" <*>+        o .: "project_id" <*>+        --o .: "attachment" <*>+        o .: "line_code" <*>+        o .: "commit_id" <*>+        o .: "noteable_id" <*>+        o .: "system" <*>+        o .: "st_diff" <*>+        o .: "url"+    parseJSON v          = typeMismatch "Note" v+ data Push = Push     { pushBefore       :: CommitID     , pushAfter        :: CommitID@@ -135,116 +313,6 @@     , pushCommitsTotal :: Int     } -data IssueEvent = IssueEvent-    { ieUser   :: User-    , ieIssue  :: Issue-    , ieAction :: T.Text-    }--data MergeRequestEvent = MergeRequestEvent-    { mreUser    :: User-    , mreRequest :: MergeRequest-    , mreAction  :: T.Text-    }--data Event-    = EventPush Push-    | EventPushTag Push-    | EventIssue IssueEvent-    | EventMergeRequest MergeRequestEvent--instance FromJSON Author where-    parseJSON (Object v) =-        Author <$>-        v .: "name" <*>-        v .: "email"-    parseJSON _          = mzero--instance FromJSON User where-    parseJSON (Object v) =-        User <$>-        v .: "name" <*>-        v .: "username" <*>-        v .: "avatar_url"-    parseJSON _          = mzero--instance FromJSON Commit where-    parseJSON (Object v) =-        Commit <$>-        v .: "id" <*>-        v .: "message" <*>-        v .: "timestamp" <*>-        v .: "url" <*>-        v .: "author"-    parseJSON _          = mzero--instance FromJSON MergeEndpoint where-    parseJSON (Object v) =-        MergeEndpoint <$>-        v .: "name" <*>-        v .: "ssh_url" <*>-        v .: "http_url" <*>-        v .: "visibility_level" <*>-        v .: "namespace"-    parseJSON _          = mzero--instance FromJSON Repository where-    parseJSON (Object v) =-        Repository <$>-        v .: "name" <*>-        v .: "url" <*>-        v .: "description" <*>-        v .: "homepage" <*>-        v .: "git_http_url" <*>-        v .: "git_ssh_url" <*>-        v .: "visibility_level"-    parseJSON _          = mzero--instance FromJSON Issue where-    parseJSON (Object v) =-        Issue <$>-        v .: "id" <*>-        v .: "title" <*>-        v .: "assignee_id" <*>-        v .: "author_id" <*>-        v .: "project_id" <*>-        v .: "created_at" <*>-        v .: "updated_at" <*>-        v .: "position" <*>-        v .: "branch_name" <*>-        v .: "description" <*>-        v .: "milestone_id" <*>-        v .: "state" <*>-        v .: "iid" <*>-        v .: "url"-    parseJSON _          = mzero--instance FromJSON MergeRequest where-    parseJSON (Object v) =-        MergeRequest <$>-        v .: "id" <*>-        v .: "target_branch" <*>-        v .: "source_branch" <*>-        v .: "source_project_id" <*>-        v .: "author_id" <*>-        v .: "assignee_id" <*>-        v .: "title" <*>-        v .: "created_at" <*>-        v .: "updated_at" <*>-        --v .: "st_commits" <*>-        --v .: "st_diffs" <*>-        v .: "milestone_id" <*>-        v .: "state" <*>-        v .: "merge_status" <*>-        v .: "target_project_id" <*>-        v .: "iid" <*>-        v .: "description" <*>-        v .: "source" <*>-        v .: "target" <*>-        v .: "last_commit" <*>-        v .: "url"-    parseJSON _          = mzero- instance FromJSON Push where     parseJSON (Object v) =         Push <$>@@ -260,39 +328,112 @@         v .: "total_commits_count"     parseJSON _          = mzero -text :: Parser T.Text -> T.Text -> Parser T.Text-text parser expected = do-    got <- parser-    if got == expected-        then return got-        else mzero+data IssueEvent = IssueEvent+    { ieUser   :: User+    , ieRepo   :: Repository+    , ieIssue  :: Issue+    , ieAction :: T.Text+    }  instance FromJSON IssueEvent where     parseJSON (Object o) = do         user <- o .: "user"+        repo <- o .: "repository"         attrs <- o .: "object_attributes"-        mr <- o .: "object_attributes"+        issue <- o .: "object_attributes"         action <- attrs .: "action"-        return $ IssueEvent user mr action-    parseJSON _          = mzero+        return $ IssueEvent user repo issue action+    parseJSON v          = typeMismatch "IssueEvent" v +data MergeRequestEvent = MergeRequestEvent+    { mreUser    :: User+    , mreRequest :: MergeRequest+    , mreAction  :: T.Text+    }+ instance FromJSON MergeRequestEvent where     parseJSON (Object o) = do         user <- o .: "user"         attrs <- o .: "object_attributes"-        issue <- o .: "object_attributes"+        mr <- o .: "object_attributes"         action <- attrs .: "action"-        return $ MergeRequestEvent user issue action-    parseJSON _          = mzero+        return $ MergeRequestEvent user mr action+    parseJSON v          = typeMismatch "MergeRequestEvent" v +data Snippet = Snippet+    { snippetId         :: Int+    , snippetTitle      :: T.Text+    , snippetContent    :: T.Text+    , snippetAuthorId   :: Int+    , snippetProjectId  :: Int+    , snippetCreatedAt  :: T.Text+    , snippetUpdatedAt  :: T.Text+    , snippetFileName   :: T.Text+    , snippetExpiresAt  :: Maybe T.Text+    , snippetType       :: T.Text+    , snippetVisibility :: Int+    }++instance FromJSON Snippet where+    parseJSON (Object o) =+        Snippet <$>+        o .: "id" <*>+        o .: "title" <*>+        o .: "content" <*>+        o .: "author_id" <*>+        o .: "project_id" <*>+        o .: "created_at" <*>+        o .: "updated_at" <*>+        o .: "file_name" <*>+        o .: "expires_at" <*>+        o .: "type" <*>+        o .: "visibility_level"+    parseJSON v          = typeMismatch "Snippet" v++data NoteTarget+    = NTCommit Commit+    | NTIssue Issue+    | NTMergeRequest MergeRequest+    | NTSnippet Snippet++data NoteEvent = NoteEvent+    { neUser      :: User+    , neProjectId :: Int+    , neRepo      :: Repository+    , neNote      :: Note+    , neTarget    :: NoteTarget+    }++instance FromJSON NoteEvent where+    parseJSON (Object o) =+        NoteEvent <$>+        o .: "user" <*>+        o .: "project_id" <*>+        o .: "repository" <*>+        o .: "object_attributes" <*>+        ( NTCommit       <$> o .: "commit"        <|>+          NTMergeRequest <$> o .: "merge_request" <|>+          NTIssue        <$> o .: "issue"         <|>+          NTSnippet      <$> o .: "snippet"+        )+    parseJSON v          = typeMismatch "NoteEvent" v++data Event+    = EventPush Push+    | EventPushTag Push+    | EventIssue IssueEvent+    | EventMergeRequest MergeRequestEvent+    | EventNote NoteEvent+ instance FromJSON Event where     parseJSON v@(Object o) =         let kind = text $ o .: "object_kind"         in  kind "push"          *> (EventPush         <$> parseJSON v) <|>             kind "tag_push"      *> (EventPushTag      <$> parseJSON v) <|>             kind "issue"         *> (EventIssue        <$> parseJSON v) <|>-            kind "merge_request" *> (EventMergeRequest <$> parseJSON v)-    parseJSON _          = mzero+            kind "merge_request" *> (EventMergeRequest <$> parseJSON v) <|>+            kind "note"          *> (EventNote         <$> parseJSON v)+    parseJSON v            = typeMismatch "Event" v  -- | Parse a JSON string (the body of the HTTP request) into event information. -- If parsing fails, return 'Left' an error message.

@@ -1,5 +1,5 @@ name:                vcs-web-hook-parse-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Parse development platform web hook messages. description:   A development platform is a server system which hosts (mostly software)@@ -39,7 +39,7 @@  source-repository head   type:                darcs-  location:            http://dev.rel4tion.org/fr33domlover/vcs-web-hook-parse+  location:            http://hub.darcs.net/fr33domlover/vcs-web-hook-parse  library   exposed-modules:     Web.Hook.GitLab