Safe Haskell | None |
---|
This package is designed to provide an easy-to-use, typesafe interface to querying Bugzilla from Haskell.
A very simple program using this package might look like this:
withBugzillaContext "bugzilla.example.org" $ \ctx -> do let session = anonymousSession ctx user = "me@example.org" query = AssignedToField .==. user .&&. FlagRequesteeField .==. user .&&. (FlagsField `contains` "review" .||. FlagsField `contains` "feedback") bugs <- searchBugs session query mapM_ (putStrLn . show . bugSummary) bugs
There's a somewhat more in-depth demo program included with the source code to this package.
- newBugzillaContext :: BugzillaServer -> IO BugzillaContext
- closeBugzillaContext :: BugzillaContext -> IO ()
- withBugzillaContext :: BugzillaServer -> (BugzillaContext -> IO a) -> IO a
- loginSession :: BugzillaContext -> UserEmail -> Text -> IO (Maybe BugzillaSession)
- anonymousSession :: BugzillaContext -> BugzillaSession
- type BugzillaServer = Text
- data BugzillaContext
- data BugzillaSession
- data BugzillaToken
- searchBugs :: BugzillaSession -> SearchExpression -> IO [Bug]
- searchBugs' :: BugzillaSession -> SearchExpression -> IO [BugId]
- searchBugsWithLimit :: BugzillaSession -> Int -> Int -> SearchExpression -> IO [Bug]
- searchBugsWithLimit' :: BugzillaSession -> Int -> Int -> SearchExpression -> IO [BugId]
- getBug :: BugzillaSession -> BugId -> IO (Maybe Bug)
- getAttachment :: BugzillaSession -> AttachmentId -> IO (Maybe Attachment)
- getAttachments :: BugzillaSession -> BugId -> IO [Attachment]
- getComments :: BugzillaSession -> BugId -> IO [Comment]
- getHistory :: BugzillaSession -> BugId -> IO History
- searchUsers :: BugzillaSession -> Text -> IO [User]
- getUser :: BugzillaSession -> UserEmail -> IO (Maybe User)
- getUserById :: BugzillaSession -> UserId -> IO (Maybe User)
- type BugId = Int
- type AttachmentId = Int
- type CommentId = Int
- type UserId = Int
- type EventId = Int
- type FlagId = Int
- type FlagType = Int
- type UserEmail = Text
- data Field a where
- AliasField :: Field Text
- AssignedToField :: Field UserEmail
- AttachmentCreatorField :: Field UserEmail
- AttachmentDataField :: Field Text
- AttachmentDescriptionField :: Field Text
- AttachmentFilenameField :: Field Text
- AttachmentIsObsoleteField :: Field Bool
- AttachmentIsPatchField :: Field Bool
- AttachmentIsPrivateField :: Field Bool
- AttachmentMimetypeField :: Field Text
- BlocksField :: Field Int
- BugIdField :: Field Int
- CcField :: Field UserEmail
- CcListAccessibleField :: Field Bool
- ClassificationField :: Field Text
- CommentField :: Field Text
- CommentIsPrivateField :: Field Text
- CommentTagsField :: Field Text
- CommenterField :: Field UserEmail
- ComponentField :: Field Text
- ContentField :: Field Text
- CreationDateField :: Field UTCTime
- DaysElapsedField :: Field Int
- DependsOnField :: Field Int
- EverConfirmedField :: Field Bool
- FlagRequesteeField :: Field UserEmail
- FlagSetterField :: Field UserEmail
- FlagsField :: Field Text
- GroupField :: Field Text
- KeywordsField :: Field [Text]
- ChangedField :: Field UTCTime
- CommentCountField :: Field Int
- OperatingSystemField :: Field Text
- HardwareField :: Field Text
- PriorityField :: Field Text
- ProductField :: Field Text
- QaContactField :: Field UserEmail
- ReporterField :: Field UserEmail
- ReporterAccessibleField :: Field Bool
- ResolutionField :: Field Text
- RestrictCommentsField :: Field Bool
- SeeAlsoField :: Field Text
- SeverityField :: Field Text
- StatusField :: Field Text
- WhiteboardField :: Field Text
- SummaryField :: Field Text
- TagsField :: Field Text
- TargetMilestoneField :: Field Text
- TimeSinceAssigneeTouchedField :: Field Int
- BugURLField :: Field Text
- VersionField :: Field Text
- VotesField :: Field Text
- CustomField :: Text -> Field Text
- data User = User {}
- data Flag = Flag {}
- data Bug = Bug {
- bugId :: !BugId
- bugAlias :: Maybe Text
- bugAssignedTo :: UserEmail
- bugAssignedToDetail :: User
- bugBlocks :: [BugId]
- bugCc :: [UserEmail]
- bugCcDetail :: [User]
- bugClassification :: Text
- bugComponent :: Text
- bugCreationTime :: UTCTime
- bugCreator :: UserEmail
- bugCreatorDetail :: User
- bugDependsOn :: [BugId]
- bugDupeOf :: Maybe BugId
- bugFlags :: [Flag]
- bugGroups :: [Text]
- bugIsCcAccessible :: Bool
- bugIsConfirmed :: Bool
- bugIsCreatorAccessible :: Bool
- bugIsOpen :: Bool
- bugKeywords :: [Text]
- bugLastChangeTime :: UTCTime
- bugOpSys :: Text
- bugPlatform :: Text
- bugPriority :: Text
- bugProduct :: Text
- bugQaContact :: UserEmail
- bugResolution :: Text
- bugSeeAlso :: [Text]
- bugSeverity :: Text
- bugStatus :: Text
- bugSummary :: Text
- bugTargetMilestone :: Text
- bugUrl :: Text
- bugVersion :: Text
- bugWhiteboard :: Text
- bugCustomFields :: HashMap Text Text
- data Attachment = Attachment {
- attachmentId :: !AttachmentId
- attachmentBugId :: !BugId
- attachmentFileName :: Text
- attachmentSummary :: Text
- attachmentCreator :: UserEmail
- attachmentIsPrivate :: Bool
- attachmentIsObsolete :: Bool
- attachmentIsPatch :: Bool
- attachmentFlags :: [Flag]
- attachmentCreationTime :: UTCTime
- attachmentLastChangeTime :: UTCTime
- attachmentContentType :: Text
- attachmentSize :: !Int
- attachmentData :: Text
- data Comment = Comment {}
- data History = History {
- historyBugId :: !BugId
- historyEvents :: [HistoryEvent]
- data HistoryEvent = HistoryEvent {}
- data Change
- = TextFieldChange (Field Text) (Modification Text)
- | ListFieldChange (Field [Text]) (Modification [Text])
- | IntFieldChange (Field Int) (Modification Int)
- | TimeFieldChange (Field UTCTime) (Modification UTCTime)
- | BoolFieldChange (Field Bool) (Modification Bool)
- data (Eq a, Show a) => Modification a = Modification {
- modRemoved :: Maybe a
- modAdded :: Maybe a
- modAttachmentId :: Maybe AttachmentId
- fieldName :: Field a -> Text
- data BugzillaException
Connecting to Bugzilla
newBugzillaContext :: BugzillaServer -> IO BugzillaContextSource
Creates a new BugzillaContext
, suitable for connecting to the
provided server. You should try to reuse BugzillaContext
s
whenever possible, because creating them is expensive.
closeBugzillaContext :: BugzillaContext -> IO ()Source
Closes the provided BugzillaContext
. Using it afterwards is an error.
withBugzillaContext :: BugzillaServer -> (BugzillaContext -> IO a) -> IO aSource
Creates a BugzillaContext
and ensures that it will be closed
automatically, even if an exception is thrown.
loginSession :: BugzillaContext -> UserEmail -> Text -> IO (Maybe BugzillaSession)Source
Attempts to create a logged-in BugzillaSession
using the
provided username and password. Returns Nothing
if login
fails.
anonymousSession :: BugzillaContext -> BugzillaSessionSource
Creates an anonymous BugzillaSession
. Note that some content
will be hidden by Bugzilla when you make queries in this state.
type BugzillaServer = TextSource
data BugzillaContext Source
Holds information about a BugzillaServer
and manages outgoing
connections. You can use newBugzillaContext
or
withBugzillaContext
to create one.
data BugzillaSession Source
A session for Bugzilla queries. Use anonymousSession
and
loginSession
, as appropriate, to create one.
Querying Bugzilla
searchBugs :: BugzillaSession -> SearchExpression -> IO [Bug]Source
Searches Bugzilla and returns a list of Bug
s. The SearchExpression
can be constructed conveniently using the operators in Web.Bugzilla.Search.
searchBugs' :: BugzillaSession -> SearchExpression -> IO [BugId]Source
Like searchBugs
, but returns a list of BugId
s. You can
retrieve the Bug
for each BugId
using getBug
. The combination
of searchBugs'
and getBug
is much less efficient than
searchBugs
. searchBugs'
is suitable for cases where you won't need to call
getBug
most of the time - for example, polling to determine whether the
set of bugs returned by a query has changed.
:: BugzillaSession | |
-> Int | The maximum number of results to return. |
-> Int | The offset from the first result to start from. |
-> SearchExpression | |
-> IO [Bug] |
Search Bugzilla and returns a limited number of results. You can
call this repeatedly and use offset
to retrieve the results of
a large query incrementally. Note that most Bugzillas won't
return all of the results for a very large query by default, but
you can request this by calling searchBugsWithLimit
with 0 for
the limit.
:: BugzillaSession | |
-> Int | The maximum number of results to return. |
-> Int | The offset from the first result to start from. |
-> SearchExpression | |
-> IO [BugId] |
Like searchBugsWithLimit
, but returns a list of BugId
s. See
searchBugs'
for more discussion.
getAttachment :: BugzillaSession -> AttachmentId -> IO (Maybe Attachment)Source
Retrieve a bug by attachment number.
getAttachments :: BugzillaSession -> BugId -> IO [Attachment]Source
Get all attachments for a bug.
getComments :: BugzillaSession -> BugId -> IO [Comment]Source
Get all comments for a bug.
getHistory :: BugzillaSession -> BugId -> IO HistorySource
Get the history for a bug.
searchUsers :: BugzillaSession -> Text -> IO [User]Source
Search user names and emails using a substring search.
getUserById :: BugzillaSession -> UserId -> IO (Maybe User)Source
Get a user by user ID.
type AttachmentId = IntSource
A field which you can search by using searchBugs
or track
changes to using getHistory
. To get a human-readable name for
a field, use fieldName
.
A Bugzilla user.
Flags, which may be set on an attachment or on a bug directly.
Flag | |
|
A Bugzilla bug.
Bug | |
|
data Attachment Source
An attachment to a bug.
A bug comment. To display these the way Bugzilla does, you'll
need to call getUser
and use the userRealName
for each user.
History information for a bug.
History | |
|
data HistoryEvent Source
An event in a bug's history.
HistoryEvent | |
|
A single change which is part of an event. Different constructors
are used according to the type of the field. The Modification
describes the value of the field before and after the change.
data (Eq a, Show a) => Modification a Source
A description of how a field changed during a HistoryEvent
.
Modification | |
|
(Eq a, Show a) => Eq (Modification a) | |
(Eq a, Show a) => Show (Modification a) |