| Safe Haskell | None |
|---|
Chat.Flowdock
Contents
Description
A client library for the Flowdock API. Currently only implements the push API.
- data FlowdockClient a
- withFlowdockClient :: ClientManagerSettings auth => auth -> (FlowdockClient auth -> IO a) -> IO a
- newtype Push = Push {}
- newtype User = User {}
- data Flow
- = QualifiedFlow {
- _qfOrganization :: Text
- _qfFlow :: Text
- | FlowId Text
- = QualifiedFlow {
- class MessageType a
- data Message a
- newtype MessageId = MessageId Int
- message :: Flow -> a -> Message a
- comment :: Text -> MessageId -> Comment
- data Chat
- data FileUpload
- data Status
- sendMessage :: MessageType a => FlowdockClient User -> Message a -> IO (MessageResponse a)
- data Comment
- sendComment :: FlowdockClient User -> Message Comment -> IO (MessageResponse Comment)
- pushToInbox :: FlowdockClient Push -> InboxPushMessage -> IO ()
- newInboxPushMessage :: InboxPushMessage
- data MessageResponse c
- pushToChat :: FlowdockClient Push -> ChatPushMessage -> IO ()
- type Content = Text
- type ExternalUserName = Text
- newChatPushMessage :: ExternalUserName -> Content -> ChatPushMessage
- data FlowFilter
- allFlows :: FlowFilter
- justFlows :: [Flow] -> FlowFilter
- data StreamQuery a
- type Event = Object
- streamOptions :: a -> StreamQuery a
- streamFlow :: FlowdockClient User -> StreamQuery Flow -> (Producer Event IO () -> IO a) -> IO a
- streamFlows :: FlowdockClient User -> StreamQuery FlowFilter -> (Producer Event IO () -> IO a) -> IO a
- data InboxPushMessage
- data InboxPushFormat = Html
- data ChatPushMessage
- data Tag
- data JSONError = JSONError String
- class HasActive s a | s -> a where
- class HasApp s a | s -> a where
- class HasContent s a | s -> a where
- class HasContentType s a | s -> a where
- contentType :: Lens' s a
- class HasEvent s a | s -> a where
- class HasExternalUserName s a | s -> a where
- externalUserName :: Lens' s a
- class HasFileName s a | s -> a where
- class HasFlow s a | s -> a where
- flow :: Traversal' s a
- class HasFormat s a | s -> a where
- class HasFromAddress s a | s -> a where
- fromAddress :: Lens' s a
- class HasFromName s a | s -> a where
- class HasLink s a | s -> a where
- class HasMessageId s a | s -> a where
- class HasOrganization s a | s -> a where
- organization :: Traversal' s a
- class HasProject s a | s -> a where
- class HasReplyTo s a | s -> a where
- class HasSent s a | s -> a where
- class HasSource s a | s -> a where
- class HasSubject s a | s -> a where
- class HasTags s a | s -> a where
- class HasUser s a | s -> a where
- class HasUuid s a | s -> a where
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 :: ClientManagerSettings auth => auth -> (FlowdockClient auth -> IO a) -> IO aSource
Authentication types
Constructors
| Push | |
Fields | |
Constructors
| User | |
Fields | |
General types
Constructors
| QualifiedFlow | |
Fields
| |
| FlowId Text | |
REST API
class MessageType a Source
Instances
Instances
data FileUpload Source
Instances
sendMessage :: MessageType a => FlowdockClient User -> Message a -> IO (MessageResponse a)Source
Instances
Pushing messages to the inbox
pushToInbox :: FlowdockClient Push -> InboxPushMessage -> IO ()Source
data MessageResponse c Source
Instances
| Show (MessageResponse c) | |
| FromJSON (MessageResponse r) | |
| HasMessageId (MessageResponse c0) MessageId | |
| HasSent (MessageResponse c0) Int | |
| HasApp (MessageResponse c0) Text |
Pushing messages to the chatroom
pushToChat :: FlowdockClient Push -> ChatPushMessage -> IO ()Source
type ExternalUserName = TextSource
Streaming events
data FlowFilter Source
justFlows :: [Flow] -> FlowFilterSource
data StreamQuery a Source
Instances
| HasSource (StreamQuery a0) a0 | |
| HasUser (StreamQuery a0) (Maybe Bool) | |
| HasActive (StreamQuery a0) (Maybe Bool) |
streamOptions :: a -> StreamQuery aSource
streamFlow :: FlowdockClient User -> StreamQuery Flow -> (Producer Event IO () -> IO a) -> IO aSource
streamFlows :: FlowdockClient User -> StreamQuery FlowFilter -> (Producer Event IO () -> IO a) -> IO aSource
Constructing messages
InboxPushMessage fields
data InboxPushMessage Source
Instances
data InboxPushFormat Source
Constructors
| Html |
ChatPushMessage fields
data ChatPushMessage Source
Common fields
Exception types
Lens field classes
class HasApp s a | s -> a whereSource
Instances
| HasApp (MessageResponse c0) Text |
class HasContent s a | s -> a whereSource
class HasExternalUserName s a | s -> a whereSource
Methods
externalUserName :: Lens' s aSource
Instances
class HasFileName s a | s -> a whereSource
Instances
class HasFlow s a | s -> a whereSource
Methods
flow :: Traversal' s aSource
class HasFromName s a | s -> a whereSource
Instances
class HasMessageId s a | s -> a whereSource
Instances
class HasProject s a | s -> a whereSource
Instances
class HasReplyTo s a | s -> a whereSource
Instances
class HasSent s a | s -> a whereSource
Instances
| HasSent (MessageResponse c0) Int |
class HasSubject s a | s -> a whereSource
Instances