22 changed files with 311 additions and 1083 deletions
--- a/.gitignore
+++ b/.gitignore
@ -1,2 +1,3 @@
 .stack-work/
-*~
+haboli.cabal
+*~
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -1,30 +1,22 @@
 # Changelog for haboli

-## upcoming
- add `Haboli.Euphoria.Botrulez` module
- add `Haboli.Euphoria.Command` module and submodules
- add `Haboli.Euphoria.Lens` and add lenses to a few types
- add `Haboli.Euphoria.Listing` module
- add `Haboli.Euphoria.Util` module and move `respondingToPing` there
- add example bot (`Haboli.Euphoria.ExampleBot`)
- clean up project
- fix nick of example bot in readme
- remove `Haboli.Euphoria.Examples` module
- update `README.md` to reflect these changes
+<!-- markdown-toc start - Don't edit this section. Run M-x markdown-toc-refresh-toc -->
+**Table of Contents**

-## 0.3.1.0
- add `Haboli.Euphoria` module
- add proper README
- clean up package structure
- update documentation
+- [Changelog for haboli](#changelog-for-haboli)
+    - [0.3.0.0](#0300)
+    - [0.2.0.0](#0200)
+    - [0.1.0.0](#0100)
+
+<!-- markdown-toc end -->

 ## 0.3.0.0
- fix Client not receiving all kinds of server events
- rename ConnectionConfig record accessors
+* fix Client not receiving all kinds of server events
+* rename ConnectionConfig record accessors

 ## 0.2.0.0
- add all session and chat room commands
- modify `send` command so it also returns the old nick
+* add all session and chat room commands
+* modify `send` command so it also returns the old nick

 ## 0.1.0.0
- create project
+* create project
--- a/README.md
+++ b/README.md
@ -1,70 +1 @@
 # haboli
-
-Haboli is a haskell library providing API bindings for
-[the euphoria api](https://api.euphoria.io/). It can be used to create bots and
-otherwise interact with the euphoria servers.
-
-## Basic concept
-
-This library is based around the custom `Client` monad. It is based on `IO` and
-represents computations that happen while a connection to an euphoria server is
-open. Once a `Client` finishes executing, the connection is automatically
-closed. If the connection closes unexpectedly while the corresponding `Client`
-is still running, it is notified and commands like `send` or `nick` will result
-in an exception. The `Client` does not automatically reconnect.
-
-The `Client` monad supports exceptions via the `throw`, `catch` and `handle`
-operations, as well as multiple threads via the `fork` and `wait` operations. It
-supports all session and chat room commands listed in the
-[api reference](https://api.euphoria.io/).
-
-For more information, see the haddock for the `Haboli.Euphoria.Client` and
-`Haboli.Euphoria.Api` modules.
-
-## Bots
-
-The library is built with flexibility and composability in mind. Because of
-this, there is no special `Bot` monad — bots also run inside the `Client` monad.
-However, there are a few convenience modules that make development of bots
-easier.
-
-The convenience modules are built on top of the `Client` monad. None of the
-convenience modules are necessary to create a functioning bot. When creating a
-new bot, you can freely choose which modules to use and which to ignore or
-replace with your own creations.
-
-For an example bot structure using the convenience modules, here is an
-[example bot](src/Haboli/Euphoria/ExampleBot.hs).
-
-## Example client
-
-Here is a very basic example bot that replies to `!ping` with `Pong!`. It does
-not use any of the provided convenience modules.
-
-```haskell
-pingPongBot :: Client () ()
-pingPongBot = forever $ do
-  event <- respondingToPing nextEvent
-  case event of
-    EventSnapshot _ -> void $ nick "PingPongBot"
-    EventSend e ->
-      let msg = sendMessage e
-      in  when (msgContent msg == "!ping") $
-            void $ reply msg "Pong!"
-    _ -> pure ()
-```
-
-And here's how to run that bot:
-
-```haskell
-main :: IO ()
-main = void $ runClient defaultConfig pingPongBot
-```
-
-## Lenses
-
-Haboli exports lenses for a few data types. The lenses are named like the record
-accessors but suffixed with a `L`. For example, the lens corresponding to
-`svNick` from `SessionView` is named `svNickL`. Lenses are not required to use
-the libary. They are provided for the convenience of those who like using
-lenses.
--- a/Setup.hs
+++ b/Setup.hs
@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
--- a/app/Main.hs
+++ b/app/Main.hs
@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "Nothing to see here"
--- a/haboli.cabal
+++ b/haboli.cabal
@ -1,65 +0,0 @@
-cabal-version: 1.18
-
-- This file has been generated from package.yaml by hpack version 0.31.2.
--
-- see: https://github.com/sol/hpack
--
-- hash: 3ce7165a468ff6ccd5e098638b16268df6af5b8dbd4f0ac2e5490a29f6f15a37
-
-name:           haboli
-version:        0.3.1.0
-synopsis:       API bindings for https://euphoria.io/
-description:    Please see the README on GitHub at <https://github.com/Garmelon/haboli#readme>
-homepage:       https://github.com/Garmelon/haboli#readme
-bug-reports:    https://github.com/Garmelon/haboli/issues
-author:         Garmelon <joscha@plugh.de>
-maintainer:     Garmelon <joscha@plugh.de>
-copyright:      2020 Garmelon
-license:        MIT
-license-file:   LICENSE
-build-type:     Simple
-extra-source-files:
-    README.md
-    CHANGELOG.md
-    LICENSE
-extra-doc-files:
-    README.md
-
-source-repository head
-  type: git
-  location: https://github.com/Garmelon/haboli
-
-library
-  exposed-modules:
-      Haboli.Euphoria
-      Haboli.Euphoria.Api
-      Haboli.Euphoria.Botrulez
-      Haboli.Euphoria.Client
-      Haboli.Euphoria.Command
-      Haboli.Euphoria.Command.Megaparsec
-      Haboli.Euphoria.Command.Simple
-      Haboli.Euphoria.ExampleBot
-      Haboli.Euphoria.Lens
-      Haboli.Euphoria.Listing
-      Haboli.Euphoria.Util
-  other-modules:
-      Paths_haboli
-  hs-source-dirs:
-      src
-  build-depends:
-      aeson
-    , base >=4.7 && <5
-    , containers
-    , megaparsec
-    , microlens
-    , microlens-th
-    , network
-    , stm
-    , template-haskell
-    , text
-    , time
-    , transformers
-    , unordered-containers
-    , websockets
-    , wuss
-  default-language: Haskell2010
--- a/package.yaml
+++ b/package.yaml
@ -1,37 +1,57 @@
-name: haboli
-version: 0.3.1.0
-license: MIT
-author: Garmelon <joscha@plugh.de>
-copyright: 2020 Garmelon
-
-synopsis: API bindings for https://euphoria.io/
-description: Please see the README on GitHub at <https://github.com/Garmelon/haboli#readme>
-github: Garmelon/haboli
+name:                haboli
+version:             0.3.0.0
+github:              "Garmelon/haboli"
+license:             MIT
+author:              "Garmelon"
+maintainer:          "joscha@plugh.de"
+copyright:           "2020 Garmelon"

 extra-source-files:
-  - README.md
-  - CHANGELOG.md
-  - LICENSE
+- README.md

-extra-doc-files:
-  - README.md
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/Garmelon/haboli#readme>

 dependencies:
-  - base >= 4.7 && < 5
-  - aeson
-  - containers
-  - megaparsec
-  - microlens
-  - microlens-th
-  - network
-  - stm
-  - template-haskell
-  - text
-  - time
-  - transformers
-  - unordered-containers
-  - websockets
-  - wuss
+- base >= 4.7 && < 5
+- aeson
+- containers
+- network
+- stm
+- text
+- time
+- transformers
+- unordered-containers
+- websockets
+- wuss

 library:
  source-dirs: src
+
+executables:
+  haboli-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - haboli
+
+tests:
+  haboli-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - haboli
--- a/src/Haboli/Euphoria.hs
+++ b/src/Haboli/Euphoria.hs
@ -1,19 +0,0 @@
-- | This module reexports the most commonly used modules for convenience. For
-- more detail on how this library works, check the <README.md> or the
-- "Haboli.Euphoria.Client" module's documentation.
-
-module Haboli.Euphoria
-  ( module Haboli.Euphoria.Api
-  , module Haboli.Euphoria.Client
-  , module Haboli.Euphoria.Command
-  , module Haboli.Euphoria.Command.Simple
-  , module Haboli.Euphoria.Listing
-  , module Haboli.Euphoria.Util
-  ) where
-
-import           Haboli.Euphoria.Api
-import           Haboli.Euphoria.Client
-import           Haboli.Euphoria.Command
-import           Haboli.Euphoria.Command.Simple
-import           Haboli.Euphoria.Listing
-import           Haboli.Euphoria.Util
--- a/src/Haboli/Euphoria/Api.hs
+++ b/src/Haboli/Euphoria/Api.hs
@ -1,107 +1,44 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-
-- | This module attempts to map the structure of the ephoria API to types.

 module Haboli.Euphoria.Api
  ( ToJSONObject(..)
  -- * Basic types
  , AuthOption(..)
+  , Message(..)
+  , PersonalAccountView(..)
+  , SessionView(..)
  , Snowflake
  , UserType(..)
  , UserId(..)
-  , userTypeL
-  , userSnowflakeL
-  , SessionView(..)
-  , svIdL
-  , svNickL
-  , svServerIdL
-  , svServerEraL
-  , svSessionIdL
-  , svIsStaffL
-  , svIsManagerL
-  , svClientAddressL
-  , svRealClientAddressL
-  , Message(..)
-  , msgIdL
-  , msgParentL
-  , msgPreviousEditIdL
-  , msgTimeL
-  , msgSenderL
-  , msgContentL
-  , msgEncryptionKeyIdL
-  , msgEditedL
-  , msgDeletedL
-  , msgTruncatedL
-  , PersonalAccountView(..)
-  , pavIdL
-  , pavNameL
-  , pavEmailL
  -- * Asynchronous events
  -- ** bounce-event
  , BounceEvent(..)
-  , bounceReasonL
-  , bounceAuthOptionL
  -- ** disconnect-event
  , DisconnectEvent(..)
-  , disconnectReasonL
  -- ** hello-event
  , HelloEvent(..)
-  , helloAccountL
-  , helloSessionViewL
-  , helloAccountHasAccessL
-  , helloAccountEmailVerifiedL
-  , helloRoomIsPrivateL
-  , helloVersionL
  -- ** join-event
  , JoinEvent(..)
-  , joinSessionL
  -- ** login-event
  , LoginEvent(..)
-  , loginAccountIdL
  -- ** logout-event
  , LogoutEvent(..)
  -- ** network-event
  , NetworkEvent(..)
-  , networkTypeL
-  , networkServerIdL
-  , networkServerEraL
  -- ** nick-event
  , NickEvent(..)
-  , nickSessionIdL
-  , nickIdL
-  , nickFromL
-  , nickToL
  -- ** edit-message-event
  , EditMessageEvent(..)
-  , editMessageMessageL
-  , editMessageEditIdL
  -- ** part-event
  , PartEvent(..)
-  , partSessionL
  -- ** ping-event
  , PingEvent(..)
-  , pingTimeL
-  , pingNextL
  -- ** pm-initiate-event
  , PmInitiateEvent(..)
-  , pmInitiateFromL
-  , pmInitiateFromNickL
-  , pmInitiateFromRoomL
-  , pmInitiatePmIdL
  -- ** send-event
  , SendEvent(..)
-  , sendMessageL
  -- ** snapshot-event
  , SnapshotEvent(..)
-  , snapshotIdentityL
-  , snapshotSessionIdL
-  , snapshotVersionL
-  , snapshotListingL
-  , snapshotLogL
-  , snapshotNickL
-  , snapshotPmWithNickL
-  , snapshotPmWithUserIdL
  -- * Session commands
  -- ** auth
  , AuthCommand(..)
@ -138,10 +75,6 @@ import qualified Data.Text             as T
 import           Data.Time
 import           Data.Time.Clock.POSIX

-import Haboli.Euphoria.Lens
-
-- | A class for all types that can be converted into an
-- 'Data.Aeson.Types.Object'. Similar to 'ToJSON', but more restrictive.
 class ToJSONObject a where
  toJSONObject :: a -> Object

@ -161,9 +94,8 @@ toPacket packetType packetData = HMap.fromList

 {- Basic types -}

-- | A method of authenticating.
 data AuthOption = Passcode
-  deriving (Show, Eq)
+  deriving (Show)

 instance ToJSON AuthOption where
  toJSON Passcode = String "passcode"
@ -173,9 +105,76 @@ instance FromJSON AuthOption where
  parseJSON (String _)          = fail "invalid value"
  parseJSON v                   = typeMismatch "String" v

+-- | A 'Message' is a node in a room’s log. It corresponds to a chat message, or
+-- a post, or any broadcasted event in a room that should appear in the log. See
+-- <http://api.euphoria.io/#message>.
+data Message = Message
+  { msgId              :: Snowflake
+  , msgParent          :: Maybe Snowflake
+  , msgPreviousEditId  :: Maybe Snowflake
+  , msgTime            :: UTCTime
+  , msgSender          :: SessionView
+  , msgContent         :: T.Text
+  , msgEncryptionKeyId :: Maybe T.Text
+  , msgEdited          :: Maybe UTCTime
+  , msgDeleted         :: Maybe UTCTime
+  , msgTruncated       :: Bool
+  } deriving (Show)
+
+instance FromJSON Message where
+  parseJSON v = parseJSON v >>= \o -> Message
+    <$> o .: "id"
+    <*> o .:? "parent"
+    <*> o .:? "previous_edit_id"
+    <*> (posixSecondsToUTCTime <$> o .: "time")
+    <*> o .: "sender"
+    <*> o .: "content"
+    <*> o .:? "encryption_key_id"
+    <*> o .:? "edited"
+    <*> (fmap posixSecondsToUTCTime <$> o .:? "deleted")
+    <*> o .:? "truncated" .!= False
+
+data PersonalAccountView = PersonalAccountView
+  { pavId    :: Snowflake
+  , pavName  :: T.Text
+  , pavEmail :: T.Text
+  } deriving (Show)
+
+instance FromJSON PersonalAccountView where
+  parseJSON v = parseJSON v >>= \o -> PersonalAccountView
+    <$> o .: "id"
+    <*> o .: "name"
+    <*> o .: "email"
+
+-- | A 'SessionView' describes a session and its identity. See
+-- <http://api.euphoria.io/#sessionview>.
+data SessionView = SessionView
+  { svId                :: UserId
+  , svNick              :: T.Text
+  , svServerId          :: T.Text
+  , svServerEra         :: T.Text
+  , svSessionId         :: T.Text
+  , svIsStaff           :: Bool
+  , svIsManager         :: Bool
+  , svClientAddress     :: Maybe T.Text
+  , svRealClientAddress :: Maybe T.Text
+  } deriving (Show)
+
+instance FromJSON SessionView where
+  parseJSON v = parseJSON v >>= \o -> SessionView
+    <$> o .: "id"
+    <*> o .: "name"
+    <*> o .: "server_id"
+    <*> o .: "server_era"
+    <*> o .: "session_id"
+    <*> o .:? "is_staff" .!= False
+    <*> o .:? "is_manager" .!= False
+    <*> o .:? "client_address"
+    <*> o .:? "real_client_address"
+
 -- | A snowflake is a 13-character string, usually used as a unique identifier
 -- for some type of object. It is the base-36 encoding of an unsigned, 64-bit
-- integer. See <https://api.euphoria.io/#snowflake>.
+-- integer. See <http://api.euphoria.io/#snowflake>.
 type Snowflake = T.Text

 -- | The type of session a client may have.
@ -190,17 +189,15 @@ data UserType
  -- ^ The client has none of the other user types. While this value does not
  -- occur nowadays, some messages in the room logs are still from a time before
  -- the distinction of user types were introduced.
-  deriving (Show, Eq, Ord)
+  deriving (Show, Eq)

 -- | A 'UserId' identifies a user. It consists of two parts: The type of
 -- session, and a unique value for that type of session. See
-- <https://api.euphoria.io/#userid>.
+-- <http://api.euphoria.io/#userid>.
 data UserId = UserId
  { userType      :: UserType
  , userSnowflake :: Snowflake
-  } deriving (Show, Eq, Ord)
-
-makeLensesL ''UserId
+  } deriving (Show, Eq)

 instance ToJSON UserId where
  toJSON uid =
@ -219,93 +216,15 @@ instance FromJSON UserId where
    ("bot", snowflake)     -> pure $ UserId Bot     $ T.drop 1 snowflake
    _                      -> fail "invalid user id label"

-- | A 'SessionView' describes a session and its identity. See
-- <https://api.euphoria.io/#sessionview>.
-data SessionView = SessionView
-  { svId                :: UserId
-  , svNick              :: T.Text
-  , svServerId          :: T.Text
-  , svServerEra         :: T.Text
-  , svSessionId         :: T.Text
-  , svIsStaff           :: Bool
-  , svIsManager         :: Bool
-  , svClientAddress     :: Maybe T.Text
-  , svRealClientAddress :: Maybe T.Text
-  } deriving (Show)
-
-makeLensesL ''SessionView
-
-instance FromJSON SessionView where
-  parseJSON v = parseJSON v >>= \o -> SessionView
-    <$> o .: "id"
-    <*> o .: "name"
-    <*> o .: "server_id"
-    <*> o .: "server_era"
-    <*> o .: "session_id"
-    <*> o .:? "is_staff" .!= False
-    <*> o .:? "is_manager" .!= False
-    <*> o .:? "client_address"
-    <*> o .:? "real_client_address"
-
-- | A 'Message' is a node in a room’s log. It corresponds to a chat message, or
-- a post, or any broadcasted event in a room that should appear in the log. See
-- <https://api.euphoria.io/#message>.
-data Message = Message
-  { msgId              :: Snowflake
-  , msgParent          :: Maybe Snowflake
-  , msgPreviousEditId  :: Maybe Snowflake
-  , msgTime            :: UTCTime
-  , msgSender          :: SessionView
-  , msgContent         :: T.Text
-  , msgEncryptionKeyId :: Maybe T.Text
-  , msgEdited          :: Maybe UTCTime
-  , msgDeleted         :: Maybe UTCTime
-  , msgTruncated       :: Bool
-  } deriving (Show)
-
-makeLensesL ''Message
-
-instance FromJSON Message where
-  parseJSON v = parseJSON v >>= \o -> Message
-    <$> o .: "id"
-    <*> o .:? "parent"
-    <*> o .:? "previous_edit_id"
-    <*> (posixSecondsToUTCTime <$> o .: "time")
-    <*> o .: "sender"
-    <*> o .: "content"
-    <*> o .:? "encryption_key_id"
-    <*> o .:? "edited"
-    <*> (fmap posixSecondsToUTCTime <$> o .:? "deleted")
-    <*> o .:? "truncated" .!= False
-
-- | A 'PersonalAccountView' contains information about an euphoria account. See
-- <https://api.euphoria.io/#personalaccountview>.
-data PersonalAccountView = PersonalAccountView
-  { pavId    :: Snowflake
-  , pavName  :: T.Text
-  , pavEmail :: T.Text
-  } deriving (Show)
-
-makeLensesL ''PersonalAccountView
-
-instance FromJSON PersonalAccountView where
-  parseJSON v = parseJSON v >>= \o -> PersonalAccountView
-    <$> o .: "id"
-    <*> o .: "name"
-    <*> o .: "email"
-
 {- Asynchronous events -}

 {- bounce-event -}

-- | See <https://api.euphoria.io/#bounce-event>.
 data BounceEvent = BounceEvent
  { bounceReason     :: Maybe T.Text
  , bounceAuthOption :: [AuthOption]
  } deriving (Show)

-makeLensesL ''BounceEvent
-
 instance FromJSON BounceEvent where
  parseJSON = fromPacket "bounce-event" $ \o -> BounceEvent
    <$> o .:? "reason"
@ -313,20 +232,16 @@ instance FromJSON BounceEvent where

 {- disconnect-event -}

-- | See <https://api.euphoria.io/#disconnect-event>.
 newtype DisconnectEvent = DisconnectEvent
  { disconnectReason :: T.Text
  } deriving (Show)

-makeLensesL ''DisconnectEvent
-
 instance FromJSON DisconnectEvent where
  parseJSON = fromPacket "disconnect-evnet" $ \o -> DisconnectEvent
    <$> o .: "reason"

 {- hello-event -}

-- | See <https://api.euphoria.io/#hello-event>.
 data HelloEvent = HelloEvent
  { helloAccount              :: Maybe PersonalAccountView
  , helloSessionView          :: SessionView
@ -336,8 +251,6 @@ data HelloEvent = HelloEvent
  , helloVersion              :: T.Text
  } deriving (Show)

-makeLensesL ''HelloEvent
-
 instance FromJSON HelloEvent where
  parseJSON = fromPacket "hello-event" $ \o -> HelloEvent
    <$> o .:? "account"
@ -349,33 +262,26 @@ instance FromJSON HelloEvent where

 {- join-event -}

-- | See <https://api.euphoria.io/#join-event>.
 newtype JoinEvent = JoinEvent
  { joinSession :: SessionView
  } deriving (Show)

-makeLensesL ''JoinEvent
-
 instance FromJSON JoinEvent where
  parseJSON = fromPacket "join-event" $ \o -> JoinEvent
    <$> parseJSON (Object o)

 {- login-event -}

-- | See <https://api.euphoria.io/#login-event>.
 newtype LoginEvent = LoginEvent
  { loginAccountId :: Snowflake
  } deriving (Show)

-makeLensesL ''LoginEvent
-
 instance FromJSON LoginEvent where
  parseJSON = fromPacket "login-event" $ \o -> LoginEvent
    <$> o .: "acount_id"

 {- logout-event -}

-- | See <https://api.euphoria.io/#logout-event>.
 data LogoutEvent = LogoutEvent
  deriving (Show)

@ -384,15 +290,12 @@ instance FromJSON LogoutEvent where

 {- network-event -}

-- | See <https://api.euphoria.io/#network-event>.
 data NetworkEvent = NetworkEvent
  { networkType      :: T.Text -- always "partition"
  , networkServerId  :: T.Text
  , networkServerEra :: T.Text
  } deriving (Show)

-makeLensesL ''NetworkEvent
-
 instance FromJSON NetworkEvent where
  parseJSON = fromPacket "network-event" $ \o -> NetworkEvent
    <$> o .: "type"
@ -401,7 +304,6 @@ instance FromJSON NetworkEvent where

 {- nick-event -}

-- | See <https://api.euphoria.io/#nick-event>.
 data NickEvent = NickEvent
  { nickSessionId :: T.Text
  , nickId        :: UserId
@ -409,8 +311,6 @@ data NickEvent = NickEvent
  , nickTo        :: T.Text
  } deriving (Show)

-makeLensesL ''NickEvent
-
 instance FromJSON NickEvent where
  parseJSON = fromPacket "nick-event" $ \o -> NickEvent
    <$> o .: "session_id"
@ -420,14 +320,11 @@ instance FromJSON NickEvent where

 {- edit-message-event -}

-- | See <https://api.euphoria.io/#edit-message-event>.
 data EditMessageEvent = EditMessageEvent
  { editMessageMessage :: Message
  , editMessageEditId  :: Snowflake
  } deriving (Show)

-makeLensesL ''EditMessageEvent
-
 instance FromJSON EditMessageEvent where
  parseJSON = fromPacket "EditMessageEvent" $ \o -> EditMessageEvent
    <$> parseJSON (Object o)
@ -435,27 +332,21 @@ instance FromJSON EditMessageEvent where

 {- part-event -}

-- | See <https://api.euphoria.io/#part-event>.
 newtype PartEvent = PartEvent
  { partSession :: SessionView
  } deriving (Show)

-makeLensesL ''PartEvent
-
 instance FromJSON PartEvent where
  parseJSON = fromPacket "part-event" $ \o -> PartEvent
    <$> parseJSON (Object o)

 {- ping-event -}

-- | See <https://api.euphoria.io/#ping-event>.
 data PingEvent = PingEvent
  { pingTime :: UTCTime
  , pingNext :: UTCTime
  } deriving (Show)

-makeLensesL ''PingEvent
-
 instance FromJSON PingEvent where
  parseJSON = fromPacket "ping-event" $ \o -> PingEvent
    <$> (posixSecondsToUTCTime <$> o .: "time")
@ -463,7 +354,6 @@ instance FromJSON PingEvent where

 {- pm-initiate-event -}

-- | See <https://api.euphoria.io/#pm-initiate-event>.
 data PmInitiateEvent = PmInitiateEvent
  { pmInitiateFrom     :: UserId
  , pmInitiateFromNick :: T.Text
@ -471,8 +361,6 @@ data PmInitiateEvent = PmInitiateEvent
  , pmInitiatePmId     :: Snowflake
  } deriving (Show)

-makeLensesL ''PmInitiateEvent
-
 instance FromJSON PmInitiateEvent where
  parseJSON = fromPacket "pm-initiate-event" $ \o -> PmInitiateEvent
    <$> o .: "from"
@ -482,20 +370,16 @@ instance FromJSON PmInitiateEvent where

 {- send-event -}

-- | See <https://api.euphoria.io/#send-event>.
 newtype SendEvent = SendEvent
  { sendMessage :: Message
  } deriving (Show)

-makeLensesL ''SendEvent
-
 instance FromJSON SendEvent where
  parseJSON = fromPacket "send-event" $ \o -> SendEvent
    <$> parseJSON (Object o)

 {- snapshot-event -}

-- | See <https://api.euphoria.io/#snapshot-event>.
 data SnapshotEvent = SnapshotEvent
  { snapshotIdentity     :: UserId
  , snapshotSessionId    :: T.Text
@ -507,8 +391,6 @@ data SnapshotEvent = SnapshotEvent
  , snapshotPmWithUserId :: Maybe UserId
  } deriving (Show)

-makeLensesL ''SnapshotEvent
-
 instance FromJSON SnapshotEvent where
  parseJSON = fromPacket "snapshot-event" $ \o -> SnapshotEvent
    <$> o .: "identity"
@ -524,7 +406,6 @@ instance FromJSON SnapshotEvent where

 {- auth -}

-- | See <https://api.euphoria.io/#auth>.
 newtype AuthCommand = AuthWithPasscode T.Text
  deriving (Show)

@ -534,7 +415,6 @@ instance ToJSONObject AuthCommand where
    , "passcode" .= password
    ]

-- | See <https://api.euphoria.io/#auth>.
 data AuthReply = AuthSuccessful | AuthFailed T.Text
  deriving (Show)

@ -549,7 +429,6 @@ instance FromJSON AuthReply where

 {- ping -}

-- | See <https://api.euphoria.io/#ping>.
 newtype PingCommand = PingCommand UTCTime
  deriving (Show)

@ -558,7 +437,6 @@ instance ToJSONObject PingCommand where
    [ "time" .= utcTimeToPOSIXSeconds time
    ]

-- | See <https://api.euphoria.io/#ping>.
 newtype PingReply = PingReply UTCTime
  deriving (Show)

@ -575,7 +453,6 @@ instance FromJSON PingReply where

 {- get-message -}

-- | See <https://api.euphoria.io/#get-message>.
 newtype GetMessageCommand = GetMessageCommand Snowflake
  deriving (Show)

@ -584,7 +461,6 @@ instance ToJSONObject GetMessageCommand where
    [ "id" .= mId
    ]

-- | See <https://api.euphoria.io/#get-message>.
 newtype GetMessageReply = GetMessageReply Message
  deriving (Show)

@ -594,7 +470,6 @@ instance FromJSON GetMessageReply where

 {- log -}

-- | See <https://api.euphoria.io/#log>.
 data LogCommand = LogCommand Int (Maybe Snowflake)
  deriving (Show)

@ -607,7 +482,6 @@ instance ToJSONObject LogCommand where
    , "before" .= before
    ]

-- | See <https://api.euphoria.io/#log>.
 data LogReply = LogReply [Message] (Maybe Snowflake)
  deriving (Show)

@ -618,7 +492,6 @@ instance FromJSON LogReply where

 {- nick -}

-- | See <https://api.euphoria.io/#nick>.
 newtype NickCommand = NickCommand T.Text
  deriving (Show)

@ -627,7 +500,6 @@ instance ToJSONObject NickCommand where
    [ "name" .= nick
    ]

-- | See <https://api.euphoria.io/#nick>.
 data NickReply = NickReply
  { nickReplySessionId :: T.Text
  , nickReplyId        :: UserId
@ -644,7 +516,6 @@ instance FromJSON NickReply where

 {- pm-initiate -}

-- | See <https://api.euphoria.io/#pm-initiate>.
 newtype PmInitiateCommand = PmInitiateCommand UserId
  deriving (Show)

@ -653,7 +524,6 @@ instance ToJSONObject PmInitiateCommand where
    [ "user_id" .= userId
    ]

-- | See <https://api.euphoria.io/#pm-initiate>.
 data PmInitiateReply = PmInitiateReply Snowflake T.Text
  deriving (Show)

@ -664,7 +534,6 @@ instance FromJSON PmInitiateReply where

 {- send -}

-- | See <https://api.euphoria.io/#send>.
 data SendCommand = SendCommand T.Text (Maybe Snowflake)
  deriving (Show)

@ -674,7 +543,6 @@ instance ToJSONObject SendCommand where
  toJSONObject (SendCommand content (Just parent)) =
    toPacket "send" $ object ["content" .= content, "parent" .= parent]

-- | See <https://api.euphoria.io/#send>.
 newtype SendReply = SendReply Message
  deriving (Show)

@ -684,14 +552,12 @@ instance FromJSON SendReply where

 {- who -}

-- | See <https://api.euphoria.io/#who>.
 data WhoCommand = WhoCommand
  deriving (Show)

 instance ToJSONObject WhoCommand where
  toJSONObject WhoCommand = toPacket "who" $ object []

-- | See <https://api.euphoria.io/#who>.
 newtype WhoReply = WhoReply [SessionView]
  deriving (Show)

--- a/src/Haboli/Euphoria/Botrulez.hs
+++ b/src/Haboli/Euphoria/Botrulez.hs
@ -1,70 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-- | This module implements a few commands defined in the
-- [botrulez](https://github.com/jedevc/botrulez). If you need more advanced
-- behaviour, it should be pretty easy to reimplement the commands as necessary.
-
-module Haboli.Euphoria.Botrulez
-  ( botrulezPingGeneral
-  , botrulezPingSpecific
-  , botrulezHelpGeneral
-  , botrulezHelpSpecific
-  , botrulezUptimeSpecific
-  , botrulezKillSpecific
-  ) where
-
-import           Control.Monad
-import           Control.Monad.IO.Class
-import qualified Data.Text                      as T
-import           Data.Time
-
-import           Haboli.Euphoria.Api
-import           Haboli.Euphoria.Client
-import           Haboli.Euphoria.Command
-import           Haboli.Euphoria.Command.Simple
-import           Haboli.Euphoria.Util
-
-- | @'botrulezPingGeneral'@ replies to commands of the form @!ping@ with
-- @Pong!@.
-botrulezPingGeneral :: Command e
-botrulezPingGeneral = cmdGeneral "ping" $ \msg ->
-  void $ reply msg "Pong!"
-
-- | @'botrulezPingSpecific' nick@ replies to commands of the form @!ping
-- \@nick@ with @Pong!@.
-botrulezPingSpecific :: T.Text -> Command e
-botrulezPingSpecific name = cmdSpecific "ping" name $ \msg ->
-  void $ reply msg "Pong!"
-
-- | @'botrulezHelpGeneral' helpText@ replies to commands of the form @!help@
-- with @helpText@.
-botrulezHelpGeneral :: T.Text -> Command e
-botrulezHelpGeneral help = cmdGeneral "help" $ \msg ->
-  void $ reply msg help
-
-- | @'botrulezHelpSpecific' nick helpText@ replies to commands of the form
-- @!help \@nick@ with @helpText@.
-botrulezHelpSpecific :: T.Text -> T.Text -> Command e
-botrulezHelpSpecific name help = cmdSpecific "help" name $ \msg ->
-  void $ reply msg help
-
-- | @'botrulezUptimeSpecific' nick startTime@ replies to commands of the form
-- @!uptime \@nick@ with the time since @startTime@.
-botrulezUptimeSpecific :: T.Text -> UTCTime -> Command e
-botrulezUptimeSpecific name since = cmdSpecific "uptime" name $ \msg -> do
-  now <- liftIO getCurrentTime
-  let delta = diffUTCTime now since
-  void $ reply msg $ mconcat
-    [ "/me has been up since "
-    , formatUTCTime since
-    , " UTC ("
-    , formatNominalDiffTime delta
-    , ")"
-    ]
-
-- | @'botrulezKillSpecific' nick@ replies to commands of the form @!kill
-- \@nick@ with @/me dies@. It then throws an exception.
-botrulezKillSpecific :: T.Text -> Command T.Text
-botrulezKillSpecific name = cmdSpecific "kill" name $ \msg -> do
-  void $ reply msg "/me dies"
-  throw $ "I was killed by " <> svNick (msgSender msg)
--- a/src/Haboli/Euphoria/Client.hs
+++ b/src/Haboli/Euphoria/Client.hs
@ -3,18 +3,6 @@
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RankNTypes                 #-}

-- | This library is based around the custom 'Client' monad. It is based on 'IO'
-- and represents computations that happen while a connection to an euphoria
-- server is open. Once a 'Client' finishes executing, the connection is
-- automatically closed. If the connection closes unexpectedly while the
-- corresponding 'Client' is still running, it is notified and commands like
-- 'send' or 'nick' will result in an exception. The 'Client' does not
-- automatically reconnect.
--
-- The 'Client' monad supports exceptions via the 'throw', 'catch' and 'handle'
-- operations, as well as multiple threads via the 'fork' and 'wait' operations.
-- It supports all session and chat room commands listed in <api.euphoria.io>.
-
 module Haboli.Euphoria.Client
  (
  -- * The Client monad
@ -27,6 +15,7 @@ module Haboli.Euphoria.Client
  -- ** Event handling
  , Event(..)
  , nextEvent
+  , respondingToPing
  -- ** Exception handling
  , ClientException(..)
  , throw
@ -75,9 +64,9 @@ import qualified Wuss                       as WSS

 import           Haboli.Euphoria.Api

-- | This type represents a @Reply e r@ with arbitrary @r@ that has yet to be
-- received. The @forall@ allows whoever creates the AwaitingReply to decide on
-- the type of @r@.
+-- | This type represents a @'Reply' e r@ with arbitrary @r@ that has yet to be
+-- received. The @forall@ allows whoever creates the 'AwaitingReply' to decide
+-- on the type of @r@.
 data AwaitingReply e
  = forall r. FromJSON r => AwaitingReply (TMVar (Reply e r))

@ -132,8 +121,8 @@ closeConnectionOnInvalidMessage connection (WS.UnicodeException _) =
 closeConnectionOnInvalidMessage _ e = E.throwIO e

 -- | An exception handler that stops the client if any sort of
-- 'WS.ConnectionException' occurs. It does this by setting ciStopped to True
-- and cancelling all AwaitingReply-s in ciAwaiting.
+-- 'WS.ConnectionException' occurs. It does this by setting 'ciStopped' to True
+-- and cancelling all 'AwaitingReply'-s in 'ciAwaiting'.
 cancelAllReplies :: ClientInfo e -> WS.ConnectionException -> IO ()
 cancelAllReplies info _ = atomically $ do
  writeTVar (ciStopped info) True
@ -206,8 +195,8 @@ defaultConfig = ConnectionConfig
  , confPingInterval = 10
  }

-- | @'withRoom' roomname config@ modifies the 'confPath' of @config@ to point
-- to the room @roomname@.
+-- | @'withRoom' roomname config@ modifies the 'cdPath' of @config@ to point to
+-- the room @roomname@.
 withRoom :: String -> ConnectionConfig -> ConnectionConfig
 withRoom room config = config{confPath = "/room/" ++ room ++ "/ws"}

@ -279,6 +268,7 @@ data Event
  | EventSnapshot SnapshotEvent
  deriving (Show)

+--TODO: Add all the events
 instance FromJSON Event where
  parseJSON v = foldr (<|>) mempty
    [ EventBounce <$> parseJSON v
@ -315,6 +305,18 @@ nextEvent = do
    Left e  -> throwRaw 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 holdingEvent = do
+  event <- holdingEvent
+  case event of
+    EventPing e -> pingReply (pingTime e)
+    _           -> pure ()
+  pure event
+
 {- Exception handling -}

 -- | The type of exceptions in the 'Client' monad.
--- a/src/Haboli/Euphoria/Command.hs
+++ b/src/Haboli/Euphoria/Command.hs
@ -1,56 +0,0 @@
-- | This module provides an abstraction for bot commands.
-
-module Haboli.Euphoria.Command
-  ( Command
-  , cmdSequential
-  , cmdParallel
-  , respondingToCommand
-  ) where
-
-import           Control.Monad
-
-import           Haboli.Euphoria.Api
-import           Haboli.Euphoria.Client
-
-- | If a command should block any further commands from executing on a message,
-- it should return 'True'. Otherwise. it should return 'False'.
-type Command e = Message -> Client e Bool
-
-- | Try out multiple 'Command's in order until one returns 'True'. All commands
-- following that one are not applied. Returns 'True' if any of the commands
-- returned 'True'. Returns 'False' otherwise.
-cmdSequential :: [Command e] -> Command e
-cmdSequential [] _ = pure False
-cmdSequential (c:cs) msg = do
-  abort <- c msg
-  if abort
-    then pure True
-    else cmdSequential cs msg
-
-- | Apply multiple 'Command's in order. Each command will be applied. Returns
-- 'True' if at least one of the commands returned 'True'. Returns 'False'
-- otherwise.
-cmdParallel :: [Command e] -> Command e
-cmdParallel commands msg = do
-  results <- traverse ($msg) commands
-  pure $ or results
-
-- | @'respondingToCommand' getCommand getEvent@ runs a 'Command' on all
-- 'EventSend's. It passes through all events unmodified.
--
-- The @getEvent@ action is used to obtain the next 'Event'. The @getCommand@
-- action is used to obtain the currently available command. @getCommand@ is
-- called directly after a new 'Event' becomes available through @getEvent@.
--
-- This utility function is meant to be wrapped directly or indirectly around
-- 'nextEvent':
--
-- > event <- respondingToCommand command nextEvent
-respondingToCommand :: Client e (Command e) -> Client e Event -> Client e Event
-respondingToCommand getCommand getEvent = do
-  event <- getEvent
-  command <- getCommand
-  case event of
-    EventSend e -> void $ command $ sendMessage e
-    _           -> pure ()
-  pure event
--- a/src/Haboli/Euphoria/Command/Megaparsec.hs
+++ b/src/Haboli/Euphoria/Command/Megaparsec.hs
@ -1,26 +0,0 @@
-- | Bot commands based on the megaparsec library.
-
-module Haboli.Euphoria.Command.Megaparsec
-  ( cmdMega
-  , cmdMega'
-  ) where
-
-import qualified Data.Text               as T
-import           Text.Megaparsec
-
-import           Haboli.Euphoria.Api
-import           Haboli.Euphoria.Client
-import           Haboli.Euphoria.Command
-
-- | Turn a megaparsec parser into a bot command. Applies the parser to the
-- content of the message. If the parser fails to parse the message content, the
-- command fails.
-cmdMega :: Parsec e' T.Text a -> (Message -> a -> Client e ()) -> Command e
-cmdMega parser f = cmdMega' parser $ \msg a -> True <$ f msg a
-
-- | A version of 'cmdMega' that allows the command function to decide whether
-- the command was successful or not.
-cmdMega' :: Parsec e' T.Text a -> (Message -> a -> Client e Bool) -> Command e
-cmdMega' parser f msg = case parse parser "" $ msgContent msg of
-  Left _  -> pure False
-  Right a -> f msg a
--- a/src/Haboli/Euphoria/Command/Simple.hs
+++ b/src/Haboli/Euphoria/Command/Simple.hs
@ -1,122 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-- | General and specific commands as described in the
-- [botrulez](https://github.com/jedevc/botrulez).
-
-module Haboli.Euphoria.Command.Simple
-  (
-  -- * General commands
-    cmdGeneral
-  , cmdGeneral'
-  , cmdGeneralArgs
-  , cmdGeneralArgs'
-  -- * Specific commands
-  , cmdSpecific
-  , cmdSpecific'
-  , cmdSpecificArgs
-  , cmdSpecificArgs'
-  -- * Parsers for convenience
-  , pAnyCmd
-  , pCmd
-  , pAnyNick
-  , pNick
-  , pUntilEof
-  , pCmdGeneral
-  , pCmdSpecific
-  ) where
-
-import           Control.Monad
-import           Data.Char
-import qualified Data.Text                          as T
-import           Text.Megaparsec
-import           Text.Megaparsec.Char
-
-import           Haboli.Euphoria.Api
-import           Haboli.Euphoria.Client
-import           Haboli.Euphoria.Command
-import           Haboli.Euphoria.Command.Megaparsec
-import           Haboli.Euphoria.Util
-
-- | Parse any command of the form @!\<non-space character\>@.
-pAnyCmd :: (Ord e) => Parsec e T.Text T.Text
-pAnyCmd = label "command" $ char '!' *> takeWhileP Nothing (not . isSpace)
-
-- | @'pCmd' a@ parses commands of the form @!\<cmd\>@ where @cmd@ is equivalent
-- to @a@.
-pCmd :: (Ord e) => T.Text -> Parsec e T.Text T.Text
-pCmd cmd = do
-  cmd' <- pAnyCmd
-  guard $ cmd == cmd'
-  pure cmd'
-
-- | Parse any nick of the form @\@\<non-space character\>@.
-pAnyNick :: (Ord e) => Parsec e T.Text T.Text
-pAnyNick = label "nick" $ do
-  void $ char '@'
-  takeWhile1P Nothing (not . isSpace)
-
-- | @'pNick' a@ parses nicks of the form @\@\<name\>@ where @name@ is
-- equivalent (but not necessarily equal) to @a@.
-pNick :: (Ord e) => T.Text -> Parsec e T.Text T.Text
-pNick name = do
-  name' <- pAnyNick
-  guard $ nickEqual name name'
-  pure name'
-
-- | Consume the rest of the input. This parser should never fail.
-pUntilEof :: (Ord e) => Parsec e T.Text T.Text
-pUntilEof = takeWhileP Nothing (const True)
-
-- | @'pCmdGeneral' cmd@ parses a general command of the form @!\<cmd\>@.
-pCmdGeneral :: (Ord e) => T.Text -> Parsec e T.Text T.Text
-pCmdGeneral cmd = pCmd cmd *> space *> pUntilEof
-
-- | @'pCmdSpecific' cmd name@ parses a specific command of the form @!\<cmd\> \@\<name\>@.
-pCmdSpecific :: (Ord e) => T.Text -> T.Text -> Parsec e T.Text T.Text
-pCmdSpecific cmd name = pCmd cmd *> space1 *> pNick name *> space *> pUntilEof
-
-- | @'cmdGeneral' cmd f@ is a general command with no arguments in the form of
-- @!cmd@.
-cmdGeneral :: T.Text -> (Message -> Client e ()) -> Command e
-cmdGeneral cmd f = cmdGeneral' cmd $ \msg -> True <$ f msg
-
-- | A version of 'cmdGeneral' that allows the command function to decide
-- whether the command was successful or not.
-cmdGeneral' :: T.Text -> (Message -> Client e Bool) -> Command e
-cmdGeneral' cmd f = cmdGeneralArgs' cmd $ \msg args -> if T.null args
-  then f msg
-  else pure False
-
-- | @'cmdGeneralArgs' cmd f@ is a general command with arguments in the form of
-- @!cmd args@. @f@ is called with the source message and the arguments as
-- 'T.Text'.
-cmdGeneralArgs :: T.Text -> (Message -> T.Text -> Client e ()) -> Command e
-cmdGeneralArgs cmd f = cmdGeneralArgs' cmd $ \msg args -> True <$ f msg args
-
-- | A version of 'cmdGeneralArgs' that allows the command function to decide
-- whether the command was successful or not.
-cmdGeneralArgs' :: T.Text -> (Message -> T.Text -> Client e Bool) -> Command e
-cmdGeneralArgs' cmd = cmdMega' (pCmdGeneral cmd :: Parsec () T.Text T.Text)
-
-- | @'cmdSpecific' cmd nick f@ is a specific command with no arguments in the
-- form of @!cmd \@nick@.
-cmdSpecific :: T.Text -> T.Text -> (Message -> Client e ()) -> Command e
-cmdSpecific cmd name f = cmdSpecific' cmd name $ \msg -> True <$ f msg
-
-- | A version of 'cmdSpecific' that allows the command function to decide
-- whether the command was successful or not.
-cmdSpecific' :: T.Text -> T.Text -> (Message -> Client e Bool) -> Command e
-cmdSpecific' cmd name f = cmdSpecificArgs' cmd name $ \msg args -> if T.null args
-  then f msg
-  else pure False
-
-- | @'cmdSpecificArgs' cmd nick f@ is a specific command with arguments in the
-- form of @!cmd \@nick args@. @f@ is called with the source message and the
-- arguments as 'T.Text'.
-cmdSpecificArgs :: T.Text -> T.Text -> (Message -> T.Text -> Client e ()) -> Command e
-cmdSpecificArgs cmd name f = cmdSpecificArgs' cmd name $ \msg args -> True <$ f msg args
-
-- | A version of 'cmdSpecificArgs' that allows the command function to decide
-- whether the command was successful or not.
-cmdSpecificArgs' :: T.Text -> T.Text -> (Message -> T.Text -> Client e Bool) -> Command e
-cmdSpecificArgs' cmd name = cmdMega' (pCmdSpecific cmd name :: Parsec () T.Text T.Text)
--- a/src/Haboli/Euphoria/Example.hs
+++ b/src/Haboli/Euphoria/Example.hs
@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | This module contains a few basic example bots.
+module Haboli.Euphoria.Example where
+
+import           Control.Concurrent
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Data.Foldable
+import           Haboli.Euphoria.Api
+import           Haboli.Euphoria.Client
+
+printAllEventsBot :: Client () ()
+printAllEventsBot = forever $ do
+  liftIO $ putStrLn "\nWaiting for the next event...\n"
+  liftIO . print =<< respondingToPing nextEvent
+
+setNickAndThenWaitBot :: Client () ()
+setNickAndThenWaitBot = forever $ do
+  event <- respondingToPing nextEvent
+  case event of
+    EventSnapshot _ -> void $ nick "HaboliTestBot"
+    _               -> pure ()
+
+throwCustomExceptionBot :: Client String ()
+throwCustomExceptionBot = throw "Hello world"
+
+immediatelyDisconnectBot :: Client () ()
+immediatelyDisconnectBot = pure ()
+
+sendMessagesUntilThrottledBot :: Client () ()
+sendMessagesUntilThrottledBot = forever $ do
+  event <- respondingToPing nextEvent
+  case event of
+    EventSnapshot _ -> do
+      void $ nick "SpamBot"
+      msg <- send "start thread"
+      void $ fork $ handle (\_ -> reply msg "got throttled") $
+        forever $ reply msg "continue thread"
+    _ -> pure ()
+
+sendMessagesThreadedBot :: Client () ()
+sendMessagesThreadedBot = forever $ do
+  event <- respondingToPing nextEvent
+  case event of
+    EventSnapshot _ -> void $ nick "TreeBot"
+    EventSend e ->
+      let msg = sendMessage e
+      in  when (msgContent msg == "!tree") $
+            void $ fork $ buildTree msg
+    _ -> pure ()
+  where
+    buildTree msg = do
+      t1 <- fork $ reply msg "subtree 1"
+      t2 <- fork $ reply msg "subtree 2"
+      subtree1 <- wait t1
+      subtree2 <- wait t2
+      t3 <- fork $ reply subtree1 "subtree 1.1"
+      t4 <- fork $ reply subtree1 "subtree 1.2"
+      t5 <- fork $ reply subtree2 "subtree 2.1"
+      t6 <- fork $ reply subtree2 "subtree 2.2"
+      for_ [t3, t4, t5, t6] wait
+      reply msg "tree done"
+
+cloneItselfBot :: Client () ()
+cloneItselfBot = forever $ do
+  event <- respondingToPing nextEvent
+  case event of
+    EventSnapshot _ -> void $ nick "CloneBot"
+    EventSend e
+      | msgContent (sendMessage e) == "!clone" -> do
+        config <- getConnectionConfig
+        void $ liftIO $ forkIO $ void $ runClient config cloneItselfBot
+      | otherwise -> pure ()
+    _ -> pure ()
--- a/src/Haboli/Euphoria/ExampleBot.hs
+++ b/src/Haboli/Euphoria/ExampleBot.hs
@ -1,89 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-
-- | This module contains an example implementation of a small bot. It is a good
-- starting point if you want to create your own bot.
--
-- The example bot uses lenses for its state because they vastly reduce the
-- amount of code required to update the 'Listing' inside the state. It is
-- entirely possible to use haboli without lenses though, should you want to do
-- that.
-
-module Haboli.Euphoria.ExampleBot
-  ( exampleBot
-  ) where
-
-import           Control.Concurrent
-import           Control.Monad
-import           Control.Monad.IO.Class
-import           Data.List
-import qualified Data.Map.Strict          as Map
-import qualified Data.Text                as T
-import           Data.Time
-import           Lens.Micro
-import           Lens.Micro.TH
-
-import           Haboli.Euphoria
-import           Haboli.Euphoria.Botrulez
-
-data BotState = BotState
-  { _botStartTime :: UTCTime
-  , _botListing   :: Listing
-  } deriving (Show)
-
-makeLenses ''BotState
-
-- | A small example bot. Takes a room password as its first argument. You can
-- run this bot in [&test](https://euphoria.io/room/test) like this:
--
-- > runClient defaultConfig $ exampleBot Nothing
-exampleBot :: Maybe T.Text -> Client T.Text ()
-exampleBot mPasswd = do
-  startTime <- liftIO getCurrentTime
-  initialEvents <- untilConnected $
-    respondingToBounce mPasswd $
-    respondingToPing nextEvent
-  let initialState = BotState startTime $ newListing initialEvents
-  stateVar <- liftIO $ newMVar initialState
-  preferNickVia botListing stateVar "ExampleBot"
-  botMain stateVar
-
-botMain :: MVar BotState -> Client T.Text ()
-botMain stateVar = forever $ do
-  event <- respondingToCommand (getCommand stateVar) $
-    respondingToPing nextEvent
-  updateFromEventVia botListing stateVar event
-
-getCommand :: MVar BotState -> Client e (Command T.Text)
-getCommand stateVar = do
-  state <- liftIO $ readMVar stateVar
-  let name = state ^. botListing . lsSelfL . svNickL
-  pure $ cmdSequential
-    [ botrulezPingGeneral
-    , botrulezPingSpecific name
-    , botrulezHelpSpecific name
-        "I am an example bot for https://github.com/Garmelon/haboli/."
-    , botrulezUptimeSpecific name $ state ^. botStartTime
-    , botrulezKillSpecific name
-    , cmdSpecific "hug" name $ \msg -> void $ reply msg "/me hugs back"
-    , cmdHello
-    , cmdNick stateVar name
-    , cmdWho stateVar
-    ]
-
-cmdHello :: Command e
-cmdHello = cmdGeneral "hello" $ \msg -> do
-  let mention = nickMention $ svNick $ msgSender msg
-  void $ reply msg $ "Hi there, @" <> mention <> "!"
-
-cmdNick :: MVar BotState -> T.Text -> Command e
-cmdNick stateVar name = cmdSpecificArgs "nick" name $ \msg args -> do
-  preferNickVia botListing stateVar args
-  void $ reply msg "Is this better?"
-
-cmdWho :: MVar BotState -> Command e
-cmdWho stateVar = cmdGeneral "who" $ \msg -> do
-  state <- liftIO $ readMVar stateVar
-  let people = state ^. botListing . lsOthersL
-      nicks = sort $ map svNick $ Map.elems people
-  void $ reply msg $ T.intercalate "\n" nicks
--- a/src/Haboli/Euphoria/Lens.hs
+++ b/src/Haboli/Euphoria/Lens.hs
@ -1,13 +0,0 @@
-module Haboli.Euphoria.Lens
-  ( makeLensesL
-  ) where
-
-import Language.Haskell.TH
-import Lens.Micro.TH
-import Lens.Micro
-
-rename :: Name -> [Name] -> Name -> [DefName]
-rename _ _ name = [TopName $ mkName $ nameBase name ++ "L"]
-
-makeLensesL :: Name -> DecsQ
-makeLensesL = makeLensesWith $ lensRules & lensField .~ rename
--- a/src/Haboli/Euphoria/Listing.hs
+++ b/src/Haboli/Euphoria/Listing.hs
@ -1,116 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
-{-# LANGUAGE TemplateHaskell   #-}
-
-- | A 'Listing' helps keep track of a bot's own 'SessionView' as well as all
-- other clients connected to a room. It must be kept up-to-date manually.
-
-module Haboli.Euphoria.Listing
-  ( Listing(..)
-  , lsSelfL
-  , lsOthersL
-  , newListing
-  , updateOwnNick
-  , preferNick
-  , preferNickVia
-  , updateFromList
-  , updateFromListVia
-  , updateFromEvent
-  , updateFromEventVia
-  ) where
-
-import           Control.Concurrent
-import           Control.Monad.IO.Class
-import qualified Data.Map.Strict        as Map
-import           Data.Maybe
-import qualified Data.Text              as T
-import           Lens.Micro
-
-import           Haboli.Euphoria.Api
-import           Haboli.Euphoria.Client
-import           Haboli.Euphoria.Lens
-
-- | A listing contains a bot's own 'SessionView' (accessible via 'lsSelf') and a
-- map of all other clients currently connected to the room (accessible via
-- 'lsOthers'). The latter never includes the bot itself.
-data Listing = Listing
-  { lsSelf   :: SessionView
-  -- ^ The 'SessionView' describing the bot itself.
-  , lsOthers :: Map.Map UserId SessionView
-  -- ^ The 'SessionView's describing the other clients connected to the current
-  -- room. Does not include the bot's own 'SessionView' (use 'lsSelf' to access
-  -- that).
-  } deriving (Show)
-
-makeLensesL ''Listing
-
-othersFromList :: [SessionView] -> Map.Map UserId SessionView
-othersFromList sessions = Map.fromList [(svId sv, sv) | sv <- sessions]
-
-- | Create a new 'Listing' based on a 'HelloEvent' and a 'SnapshotEvent'.
-newListing :: (HelloEvent, SnapshotEvent) -> Listing
-newListing (h, s) = Listing
-  { lsSelf   = helloSessionView h
-  , lsOthers = othersFromList $ snapshotListing s
-  }
-
-- | Set the bot's own nick to a new nick.
-updateOwnNick :: T.Text -> Listing -> Listing
-updateOwnNick name = lsSelfL . svNickL .~ name
-
-- | Set the bot's nick and update the 'Listing' with the server's reply in one
-- go.
-preferNick :: T.Text -> Listing -> Client e Listing
-preferNick name listing
-  | name == listing ^. lsSelfL . svNickL = pure listing
-  | otherwise = do
-      (_, newNick) <- nick name
-      pure $ updateOwnNick newNick listing
-
-- | Like 'preferNick', but updates a 'Listing' inside a data type inside an
-- 'MVar'.
-preferNickVia :: Lens' a Listing -> MVar a -> T.Text -> Client e ()
-preferNickVia field mvar name = do
-  a <- liftIO $ takeMVar mvar
-  listing' <- preferNick name $ a ^. field
-  let a' = a & field .~ listing'
-  liftIO $ putMVar mvar a'
-
-- | Update a 'Listing' from a list of sessions currently connected to the room.
-- Afterwards, the 'Listing' will contain only those sessions present in the
-- list.
-updateFromList :: [SessionView] -> Listing -> Listing
-updateFromList sessions listing =
-  let ownId = svId $ lsSelf listing
-      others' = othersFromList sessions
-      newSelf = fromMaybe (lsSelf listing) $ others' Map.!? ownId
-      newOthers = Map.filterWithKey (\k _ -> k /= ownId) others'
-  in  Listing newSelf newOthers
-
-- | Like 'updateFromList', but updates a 'Listing' inside a data type inside an
-- 'MVar'.
-updateFromListVia :: Lens' a Listing -> MVar a -> [SessionView] -> Client e ()
-updateFromListVia field mvar list =
-  liftIO $ modifyMVar_ mvar $ pure . (field %~ updateFromList list)
-
-- | Update a 'Listing' based on an 'Event'. Follows the euphoria documentation
-- for 'JoinEvent', 'PartEvent' and 'NetworkEvent'.
-updateFromEvent :: Event -> Listing -> Listing
-updateFromEvent (EventJoin e) listing =
-  let sv = joinSession e
-  in  listing & lsOthersL %~ Map.insert (svId sv) sv
-updateFromEvent (EventPart e) listing =
-  let sv = partSession e
-  in  listing & lsOthersL %~ Map.delete (svId sv)
-updateFromEvent (EventNetwork e) listing | networkType e == "partition" =
-  let sId = networkServerId e
-      sEra = networkServerEra e
-      isAffected sv = svServerId sv == sId && svServerEra sv == sEra
-  in  listing & lsOthersL %~ Map.filter (not . isAffected)
-updateFromEvent _ listing = listing
-
-- | Like 'updateFromEvent', but updates a 'Listing' inside a data type inside
-- an 'MVar'.
-updateFromEventVia :: Lens' a Listing -> MVar a -> Event -> Client e ()
-updateFromEventVia field mvar event =
-  liftIO $ modifyMVar_ mvar $ pure . (field %~ updateFromEvent event)
--- a/src/Haboli/Euphoria/Util.hs
+++ b/src/Haboli/Euphoria/Util.hs
@ -1,154 +0,0 @@
-{-# LANGUAGE MultiWayIf        #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-- | This module contains a few utility functions that don't deserve their own
-- modules.
-
-module Haboli.Euphoria.Util
-  (
-  -- * Events
-    respondingToPing
-  , respondingToBounce
-  , respondingToBounce'
-  , untilConnected
-  , untilConnected'
-  -- * Nick
-  , nickMention
-  , nickNormalize
-  , nickEqual
-  -- * Time formatting
-  , formatUTCTime
-  , formatNominalDiffTime
-  ) where
-
-import           Control.Monad.Trans.Class
-import           Control.Monad.Trans.State
-import           Data.Char
-import           Data.Function
-import qualified Data.Set                  as Set
-import qualified Data.Text                 as T
-import           Data.Time
-
-import           Haboli.Euphoria.Api
-import           Haboli.Euphoria.Client
-
-{- Events -}
-
-- | Respond to 'EventPing's according to the euphoria documentation (see
-- <http://api.euphoria.io/#ping-event>). Passes through all events unmodified.
--
-- This utility function is meant to be wrapped directly or indirectly around
-- 'nextEvent':
--
-- > event <- respondingToPing nextEvent
-respondingToPing :: Client e Event -> Client e Event
-respondingToPing getEvent = do
-  event <- getEvent
-  case event of
-    EventPing e -> pingReply (pingTime e)
-    _           -> pure ()
-  pure event
-
-- | Respond to 'EventBounce's according to the euphoria documentation. If no
-- password is provided but an 'EventBounce' is encountered, throw a 'T.Text'
-- exception.
--
-- This utility function is meant to be wrapped directly or indirectly around
-- 'nextEvent':
--
-- > event <- respondingToBounce (Just passwd) nextEvent
-respondingToBounce :: Maybe T.Text -> Client T.Text Event -> Client T.Text Event
-respondingToBounce = respondingToBounce' id
-
-- | A variant of 'respondingToBounce' that allows wrapping the exception into a
-- custom type.
-respondingToBounce' :: (T.Text -> e) -> Maybe T.Text -> Client e Event -> Client e Event
-respondingToBounce' onError mPasswd getEvent = do
-  event <- getEvent
-  case event of
-    EventBounce e
-      | Passcode `elem` bounceAuthOption e -> case mPasswd of
-          Nothing -> throw $ onError "Password required but no password given"
-          Just passwd -> do
-            response <- auth passwd
-            case response of
-              Left msg -> throw $ onError $ "Could not authenticate: " <> msg
-              Right () -> pure ()
-    _ -> pure ()
-  pure event
-
-- | Receive events until both an 'EventHello' and 'EventSnapshot' were
-- received, then return those. Throw a 'T.Text' exception if an invalid 'Event'
-- was encountered. Valid events are 'EventPing', 'EventBounce', 'EventHello'
-- and 'EventSnapshot'.
-untilConnected :: Client T.Text Event -> Client T.Text (HelloEvent, SnapshotEvent)
-untilConnected = untilConnected' id
-
-- | A variant of 'untilConnected' that allows wrapping the exception into a
-- custom type.
-untilConnected' :: (T.Text -> e) -> Client e Event -> Client e (HelloEvent, SnapshotEvent)
-untilConnected' onError getEvent = evalStateT helper (Nothing, Nothing)
-  where
-    helper = do
-      event <- lift getEvent
-      case event of
-        EventPing _     -> pure ()
-        EventBounce _   -> pure ()
-        EventHello e    -> modify $ \(_, s) -> (Just e, s)
-        EventSnapshot e -> modify $ \(h, _) -> (h, Just e)
-        _ -> lift $ throw $ onError "Received disallowed packet while connecting"
-      receivedEvents <- get
-      case receivedEvents of
-        (Just h, Just s) -> pure (h, s)
-        _                -> helper
-
-{- Nick -}
-
-- | Modify a nick such that — when prepended with an @\@@ — it will (hopefully)
-- ping the person with that nick on euphoria.
-nickMention :: T.Text -> T.Text
-nickMention name
-  | T.length name > 1 = T.filter isMentionChar name
-  | otherwise         = name
-  where
-    isMentionChar c = not $ isSpace c || c `Set.member` terminatingChars
-    terminatingChars = Set.fromList ",.!?;&<'\""
-
-- | Normalize nicks (for nick comparison purposes) by removing all space
-- characters and converting the rest into a case-insensitive representation.
-nickNormalize :: T.Text -> T.Text
-nickNormalize name
-  | T.length name > 1 = T.toCaseFold $ T.filter (not . isSpace) name
-  | otherwise         = T.toCaseFold name
-
-- | Check two nicks for equality by comparing their normalized versions.
-nickEqual :: T.Text -> T.Text -> Bool
-nickEqual = (==) `on` nickNormalize
-
-{- Time formatting -}
-
-- | Convert a 'UTCTime' into the format @yyyy-mm-dd HH:MM:SS@.
-formatUTCTime :: UTCTime -> T.Text
-formatUTCTime t = T.pack $ formatTime defaultTimeLocale "%F %T" t
-
-- | Convert a 'NominalDiffTime' into the format @[[[\<days\>d ]\<hours\>h
-- ]\<minutes\>m ]\<seconds\>s@ where the square brackets denote optional parts.
-- Only those parts required to fully display the time span are output. If the
-- 'NominalDiffTime' is negative, a @-@ is prefixed.
-formatNominalDiffTime :: NominalDiffTime -> T.Text
-formatNominalDiffTime t = (sign <>) $ T.intercalate " " $ map T.pack $ if
-  | days    /= 0 -> [fDays, fHours, fMinutes, fSeconds]
-  | hours   /= 0 -> [       fHours, fMinutes, fSeconds]
-  | minutes /= 0 -> [               fMinutes, fSeconds]
-  | otherwise    -> [                         fSeconds]
-  where
-    diffSeconds = round $ nominalDiffTimeToSeconds t :: Integer
-    sign = if diffSeconds < 0 then "-" else ""
-    totalSeconds = abs diffSeconds
-    (days,    secondsAfterDays)  = totalSeconds      `quotRem` (60 * 60 * 24)
-    (hours,   secondsAfterHours) = secondsAfterDays  `quotRem` (60 * 60)
-    (minutes, seconds)           = secondsAfterHours `quotRem`  60
-    fDays    = show days    ++ "d"
-    fHours   = show hours   ++ "h"
-    fMinutes = show minutes ++ "m"
-    fSeconds = show seconds ++ "s"
--- a/stack.yaml
+++ b/stack.yaml
@ -1,3 +1,66 @@
-resolver: lts-15.7
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: lts-14.19
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
 packages:
 - .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.1"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 491389
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/7.yaml
-    sha256: 92ab6303fe20ec928461c82ce0980b4d17c06f4e66205a2967e476474f686c17
-  original: lts-15.7
+    size: 524155
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/19.yaml
+    sha256: 9f79f6494473c9b46911364b94c4b5ef19ca8d35ebf62e46697cf651f198ee19
+  original: lts-14.19
--- a/test/Spec.hs
+++ b/test/Spec.hs
@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"