| Portability | portable |
|---|---|
| Stability | provisional |
| Maintainer | Michael Xavier <michael@michaelxavier.net> |
Web.Campfire
Description
Toplevel module for the Campfire API operating in the CamfireM monad. Covers the entire campfire API excluding the streaming and file upload APIs. Might include support for these features in the future.
{-# LANGUAGE OverloadedStrings #-}
import Web.Campfire
import Web.Campfire.Monad
import Web.Campfire.Types
import Control.Monad.Reader
import Data.Text (unpack)
doStuff :: CampfireM ()
doStuff = do
(room:_) <- getRooms
let rid = roomId room
joinRoom rid
speak rid stmt
leaveRoom rid
return ()
where stmt = TextStatement { statementBody = "ATTENTION: I have nothing important to say" }
main :: IO ()
main = do
runReaderT (unCampfireM doStuff) env
me <- runReaderT (unCampfireM getMe) env
putStrLn "Hello, my name is:"
putStrLn . unpack $ userName me
where env = CampfireEnv { cfKey = "MYKEY", cfSubDomain = "mysubdomain"}
- getRooms :: CampfireM [Room]
- getRoom :: Id -> CampfireM Room
- getPresence :: CampfireM [Room]
- setRoomTopic :: Id -> Text -> CampfireM (Int, ByteString)
- setRoomName :: Id -> Text -> CampfireM (Int, ByteString)
- joinRoom :: Id -> CampfireM (Int, ByteString)
- leaveRoom :: Id -> CampfireM (Int, ByteString)
- lockRoom :: Id -> CampfireM (Int, ByteString)
- unlockRoom :: Id -> CampfireM (Int, ByteString)
- getMe :: CampfireM User
- getUser :: Id -> CampfireM User
- speak :: Id -> Statement -> CampfireM (Int, ByteString)
- highlightMessage :: Id -> CampfireM (Int, ByteString)
- unhighlightMessage :: Id -> CampfireM (Int, ByteString)
- getRecentMessages :: Id -> Maybe Integer -> Maybe Integer -> CampfireM [Message]
- getUploads :: Id -> CampfireM [Upload]
- getUpload :: Id -> Id -> CampfireM Upload
- search :: Text -> CampfireM [Message]
- getTodayTranscript :: Id -> CampfireM [Message]
- getTranscript :: Id -> Day -> CampfireM [Message]
Documentation
getPresence :: CampfireM [Room]Source
Get a list of rooms in which the authenticated user is present.
Arguments
| :: Id | Room ID |
| -> Text | New topic |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Change the topic of a particular room.
Arguments
| :: Id | Room ID |
| -> Text | New room name |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Change the name of a particular room.
Arguments
| :: Id | Room ID |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Causes the authenticated user to join a particular room.
Arguments
| :: Id | Room ID |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Causes the authenticated user to leave a particular room.
Arguments
| :: Id | Roomd ID |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Locks a particular room.
Arguments
| :: Id | Room ID |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Unlocks a particular room.
Arguments
| :: Id | The room ID in which to speak |
| -> Statement | The statement to send to the room |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Say something in a room as the currently authenticated user.
Arguments
| :: Id | Message ID |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Put a star next to a message. That message will then show up in that day's highlights.
Arguments
| :: Id | Message ID |
| -> CampfireM (Int, ByteString) | Status code and body (may change) |
Remove the star next to a message.
Arguments
| :: Id | Room ID |
| -> Maybe Integer | Optional limit. Default is 100 |
| -> Maybe Integer | Optional message ID. Setting this will retreive messages since that message was received. |
| -> CampfireM [Message] |
Receive a list of recent messages in a particular room.
Get a list of up to 5 recent uploads to a given room
Retrieve a particular upload from a room.
Search for messages matching a given term.
Get a transcript of all messages in a room for the day.