| Safe Haskell | None |
|---|
Chat.Flowdock
Contents
Description
A client library for the Flowdock API. Currently only implements the push API.
- data FlowdockClient a
- withFlowdockClient :: auth -> (FlowdockClient auth -> IO a) -> IO a
- newtype Push = Push {}
- pushToInbox :: FlowdockClient Push -> InboxPushMessage -> IO ()
- newInboxPushMessage :: InboxPushMessage
- pushToChat :: FlowdockClient Push -> ChatPushMessage -> IO ()
- type Content = Text
- type ExternalUserName = Text
- newChatPushMessage :: ExternalUserName -> Content -> ChatPushMessage
- data InboxPushMessage
- source :: HasSource c e => Lens' c e
- fromAddress :: HasFromAddress c e => Lens' c e
- subject :: HasSubject c e => Lens' c e
- fromName :: HasFromName c e => Lens' c e
- replyTo :: HasReplyTo c e => Lens' c e
- project :: HasProject c e => Lens' c e
- data InboxPushFormat = Html
- format :: HasFormat c e => Lens' c e
- link :: HasLink c e => Lens' c e
- data ChatPushMessage
- externalUserName :: HasExternalUserName c e => Lens' c e
- messageId :: HasMessageId c e => Lens' c e
- content :: HasContent c e => Lens' c e
- data Tag
- tags :: HasTags c e => Lens' c e
- data JSONError = JSONError String
Using the client
The Flowdock API has different authentication mechanisms for different parts of the API. Functions that depend on specific authentication data are tagged with the authentication type necessary to use them.
{-# LANGUAGE OverloadedStrings #-}
import Chat.Flowdock
-- The push API uses the 'Push' authentication type
main = withFlowdockClient (Push "YOUR_FLOW_TOKEN_HERE") $ \client -> do
let msg = newChatPushMessage "Hello World Bot" "Hello, world!"
pushToChat client msg
data FlowdockClient a Source
withFlowdockClient :: auth -> (FlowdockClient auth -> IO a) -> IO aSource
Authentication types
Constructors
| Push | |
Fields | |
Pushing messages to the inbox
pushToInbox :: FlowdockClient Push -> InboxPushMessage -> IO ()Source
Pushing messages to the chatroom
pushToChat :: FlowdockClient Push -> ChatPushMessage -> IO ()Source
type ExternalUserName = TextSource
Constructing messages
InboxPushMessage fields
data InboxPushMessage Source
fromAddress :: HasFromAddress c e => Lens' c eSource
data InboxPushFormat Source
Constructors
| Html |
ChatPushMessage fields
data ChatPushMessage Source
externalUserName :: HasExternalUserName c e => Lens' c eSource