Add documentation

This commit also renames ConnectionDetails to ConnectionConfig, because I think
that is a more appropriate name.
This commit is contained in:
Joscha 2020-01-07 16:06:25 +00:00
parent 22aacc1c98
commit ea9390ebd5

View file

@ -8,9 +8,10 @@ module Haboli.Euphoria.Client
-- * The Client monad -- * The Client monad
Client Client
, runClient , runClient
, ConnectionDetails(..) , ConnectionConfig(..)
, defaultDetails , defaultConfig
, getConnectionDetails , withRoom
, getConnectionConfig
-- ** Event handling -- ** Event handling
, Event(..) , Event(..)
, nextEvent , nextEvent
@ -67,7 +68,7 @@ data AwaitingReply e
type AwaitingReplies e = Map.Map T.Text (AwaitingReply e) type AwaitingReplies e = Map.Map T.Text (AwaitingReply e)
data ClientInfo e = ClientInfo data ClientInfo e = ClientInfo
{ ciDetails :: ConnectionDetails { ciDetails :: ConnectionConfig
, ciConnection :: WS.Connection , ciConnection :: WS.Connection
, ciAwaiting :: TVar (AwaitingReplies e) , ciAwaiting :: TVar (AwaitingReplies e)
, ciEventChan :: TChan Event , ciEventChan :: TChan Event
@ -76,6 +77,16 @@ data ClientInfo e = ClientInfo
} }
-- This type declaration feels lispy in its parenthesisness -- This type declaration feels lispy in its parenthesisness
-- | @'Client' e a@ is the monad in which clients are written. @e@ is the custom
-- exception type that can be seen in functions like 'catch' or 'runClient'. @a@
-- is the monad return type.
--
-- A value of type @'Client' e a@ can be thought of as an action returning a
-- value of type @a@ or throwing an exception of type @'ClientException' e@ that
-- can be executed in a client (which usually has an open websocket connection)
--
-- For more information on how a 'Client' is executed, see the documentation of
-- 'runClient'.
newtype Client e a = Client (ExceptT (ClientException e) newtype Client e a = Client (ExceptT (ClientException e)
(ReaderT (ClientInfo e) (ReaderT (ClientInfo e)
IO) a) IO) a)
@ -158,22 +169,41 @@ runWebsocketThread info =
{- Running the Client monad -} {- Running the Client monad -}
data ConnectionDetails = ConnectionDetails -- | Configuration for the websocket connection. The websocket connection always
-- uses https.
data ConnectionConfig = ConnectionConfig
{ cdHost :: HostName { cdHost :: HostName
, cdPort :: PortNumber , cdPort :: PortNumber
, cdPath :: String , cdPath :: String
, cdPingInterval :: Int , cdPingInterval :: Int
} deriving (Show) } deriving (Show)
defaultDetails :: ConnectionDetails -- | A default configuration that points the bot to the room @&test@ at
defaultDetails = ConnectionDetails -- <https://euphoria.io/room/test>.
defaultConfig :: ConnectionConfig
defaultConfig = ConnectionConfig
{ cdHost = "euphoria.io" { cdHost = "euphoria.io"
, cdPort = 443 , cdPort = 443
, cdPath = "/room/test/ws" , cdPath = "/room/test/ws"
, cdPingInterval = 10 , cdPingInterval = 10
} }
runClient :: ConnectionDetails -> Client e a -> IO (Either (ClientException e) a) -- | @'withRoom' roomname config@ modifies the 'cdPath' of @config@ to point to
-- the room @roomname@.
withRoom :: String -> ConnectionConfig -> ConnectionConfig
withRoom room config = config{cdPath = "/room/" ++ room ++ "/ws"}
--TODO: Catch IO exceptions that occur when a connection could not be created
-- | Execute a 'Client'.
--
-- The execution is bound to a single websocket connection. Once that connection
-- closes for any reason, calls to 'nextEvent' or to commands throw a
-- 'StoppedException'. If the 'Client' finishes executing, the websocket
-- connection is closed automatically.
--
-- At the moment, IO exceptions that occur while creating the websocket
-- connection are not caught. This will probably change soon.
runClient :: ConnectionConfig -> Client e a -> IO (Either (ClientException e) a)
runClient details (Client stack) = runClient details (Client stack) =
withSocketsDo $ withSocketsDo $
WSS.runSecureClient (cdHost details) (cdPort details) (cdPath details) $ \connection -> do WSS.runSecureClient (cdHost details) (cdPort details) (cdPath details) $ \connection -> do
@ -205,11 +235,15 @@ runClient details (Client stack) =
getClientInfo :: Client e (ClientInfo e) getClientInfo :: Client e (ClientInfo e)
getClientInfo = Client $ lift ask getClientInfo = Client $ lift ask
getConnectionDetails :: Client e ConnectionDetails -- | Get the 'ConnectionConfig' the current websocket connection uses.
getConnectionDetails = ciDetails <$> getClientInfo getConnectionConfig :: Client e ConnectionConfig
getConnectionConfig = ciDetails <$> getClientInfo
{- Event handling -} {- Event handling -}
-- | This type represents events sent by the server. For more information on the
-- specific events, see their documentation in "Haboli.Euphoria.Api" or have a
-- look at <http://api.euphoria.io/#asynchronous-events>.
data Event data Event
= EventBounce BounceEvent = EventBounce BounceEvent
| EventDisconnect DisconnectEvent | EventDisconnect DisconnectEvent
@ -237,6 +271,9 @@ instance FromJSON Event where
, EventSnapshot <$> parseJSON v , EventSnapshot <$> parseJSON v
] ]
-- | Retrieve the next event sent by the server. This function blocks until a
-- new event is available or the connection closes, in which case it will throw
-- a 'StoppedException'.
nextEvent :: Client e Event nextEvent :: Client e Event
nextEvent = do nextEvent = do
info <- getClientInfo info <- getClientInfo
@ -252,6 +289,10 @@ nextEvent = do
Left e -> throwRaw e Left e -> throwRaw e
Right e -> pure e Right e -> pure e
-- | Respond to 'EventPing's according to the documentation (see
-- <http://api.euphoria.io/#ping-event>). This function is meant to be wrapped
-- directly around 'nextEvent':
-- > event <- respondingToPing nextEvent
respondingToPing :: Client e Event -> Client e Event respondingToPing :: Client e Event -> Client e Event
respondingToPing holdingEvent = do respondingToPing holdingEvent = do
event <- holdingEvent event <- holdingEvent
@ -262,25 +303,30 @@ respondingToPing holdingEvent = do
{- Exception handling -} {- Exception handling -}
-- | The type of exceptions in the 'Client' monad.
data ClientException e data ClientException e
= ServerException T.Text = ServerException T.Text
-- ^ @'ServerError' error@ is an error sent by the server in response to a -- ^ The server has sent an error message as a reply to a command. Usually
-- command. @error@ is a message that appears if a command fails. -- this happens if a command is used incorrectly.
| StoppedException | StoppedException
-- ^ The websocket connection underlying the 'Client' was closed.
| DecodeException T.Text | DecodeException T.Text
-- ^ At some point during decoding a websocket packet, something went wrong. -- ^ At some point during decoding a websocket packet, something went wrong.
| UnexpectedException SomeException | UnexpectedException SomeException
-- ^ While a forked thread was executed, an unexpected exception was thrown in -- ^ While a forked thread was executed, an unexpected exception was thrown in
-- the IO monad. -- the IO monad.
| CustomException e | CustomException e
-- ^ A custom exception was thrown via 'throw'.
deriving (Show) deriving (Show)
throwRaw :: ClientException e -> Client e a throwRaw :: ClientException e -> Client e a
throwRaw = Client . throwE throwRaw = Client . throwE
-- | Throw a 'CustomException'.
throw :: e -> Client e a throw :: e -> Client e a
throw = throwRaw . CustomException throw = throwRaw . CustomException
-- | Catch a 'ClientException'. This method works like 'catchE'.
catch :: Client e a -> (ClientException e -> Client e a) -> Client e a catch :: Client e a -> (ClientException e -> Client e a) -> Client e a
-- The main reason why the 'ExceptT' is wrapped around the 'ReaderT' in the -- The main reason why the 'ExceptT' is wrapped around the 'ReaderT' in the
-- 'Client' monad is that it makes this function easier to implement -- 'Client' monad is that it makes this function easier to implement
@ -288,13 +334,18 @@ catch c f = Client $ catchE (unclient c) (unclient . f)
where where
unclient (Client m) = m unclient (Client m) = m
-- | A version of 'catch' with its arguments flipped. It is named after
-- 'Control.Exception.handle'.
handle :: (ClientException e -> Client e a) -> Client e a -> Client e a handle :: (ClientException e -> Client e a) -> Client e a -> Client e a
handle = flip Haboli.Euphoria.Client.catch handle = flip Haboli.Euphoria.Client.catch
{- Threading -} {- Threading -}
-- | This type represents a thread spawned by 'fork'.
newtype Thread e a = Thread (MVar (Either (ClientException e) a)) newtype Thread e a = Thread (MVar (Either (ClientException e) a))
-- | @'fork' p@ forks a new thread running the 'Client' @p@. To wait for the
-- thread to finish execution and collect the result, use 'wait'.
fork :: Client e a -> Client e (Thread e a) fork :: Client e a -> Client e (Thread e a)
fork (Client f) = do fork (Client f) = do
info <- getClientInfo info <- getClientInfo
@ -305,6 +356,8 @@ fork (Client f) = do
void $ liftIO $ forkFinally thread andThen void $ liftIO $ forkFinally thread andThen
pure $ Thread waitVar pure $ Thread waitVar
-- | Wait for a thread to finish executing and collect the result. If the thread
-- threw a 'ClientException', that exception is rethrown.
wait :: Thread e a -> Client e a wait :: Thread e a -> Client e a
wait (Thread waitVar) = do wait (Thread waitVar) = do
result <- liftIO $ readMVar waitVar result <- liftIO $ readMVar waitVar
@ -326,6 +379,9 @@ instance FromJSON r => FromJSON (Reply e r) where
<$> throttledParser <$> throttledParser
<*> ((Left <$> errorParser) <|> (Right <$> parseJSON v)) <*> ((Left <$> errorParser) <|> (Right <$> parseJSON v))
where where
-- I don't know if the API guarantees that there is always a
-- "throttled_reason" if the commands are throttled or not. For now, I'm
-- trusting the "throttled" boolean more than the "throttled_reason."
throttledParser = do throttledParser = do
throttled <- o .:? "throttled" .!= False throttled <- o .:? "throttled" .!= False
if throttled if throttled
@ -399,25 +455,32 @@ sendPacketWithReply packet = do
{- Session commands -} {- Session commands -}
-- | Send a reply to a 'PingEvent' sent by the server.
pingReply :: UTCTime -> Client e () pingReply :: UTCTime -> Client e ()
pingReply = void . sendPacket . PingReply pingReply = void . sendPacket . PingReply
{- Chat room commands -} {- Chat room commands -}
-- | Change your own nick. Returns the new nick.
nick :: T.Text -> Client e T.Text nick :: T.Text -> Client e T.Text
nick targetNick = do nick targetNick = do
answer <- sendPacketWithReply $ NickCommand targetNick answer <- sendPacketWithReply $ NickCommand targetNick
pure $ nickReplyTo answer pure $ nickReplyTo answer
-- | Send a new top-level message. Returns the sent message.
send :: T.Text -> Client e Message send :: T.Text -> Client e Message
send content = do send content = do
(SendReply msg) <- sendPacketWithReply $ SendCommand content Nothing (SendReply msg) <- sendPacketWithReply $ SendCommand content Nothing
pure msg pure msg
-- | Reply to a message via its id. Returns the sent message.
reply' :: Snowflake -> T.Text -> Client e Message reply' :: Snowflake -> T.Text -> Client e Message
reply' messageId content = do reply' messageId content = do
(SendReply msg) <- sendPacketWithReply $ SendCommand content (Just messageId) (SendReply msg) <- sendPacketWithReply $ SendCommand content (Just messageId)
pure msg pure msg
-- | Reply to a message. Returns the sent message.
--
-- This function is equivalent to @'reply'' . 'msgId'@.
reply :: Message -> T.Text -> Client e Message reply :: Message -> T.Text -> Client e Message
reply = reply' . msgId reply = reply' . msgId