packages feed

slack-web 0.1.0 → 0.2.0

raw patch · 17 files changed

+1274/−178 lines, 17 filesdep +containersdep +errorsdep +hspecdep −generics-sopdep ~aesondep ~basedep ~http-api-datanew-uploader

Dependencies added: containers, errors, hspec, megaparsec, mtl, time

Dependencies removed: generics-sop

Dependency ranges changed: aeson, base, http-api-data, servant, servant-client, text

Files

CHANGELOG.md view
@@ -1,1 +1,10 @@ # 0.1.0++## Methods++### New++- `api.test`+- `auth.test`+- `channels.create`+- `chat.postMessage`
README.md view
@@ -1,5 +1,21 @@ # Haskell bindings for the Slack web API +[![][1]][0]++[![][3]][2]+[![][5]][4]++[0]: https://circleci.com/gh/jpvillaisaza/slack-web+[1]: https://circleci.com/gh/jpvillaisaza/slack-web.svg?style=svg+[2]: https://www.stackage.org/lts/package/slack-web+[3]: https://www.stackage.org/package/slack-web/badge/lts+[4]: https://www.stackage.org/nightly/package/slack-web+[5]: https://www.stackage.org/package/slack-web/badge/nightly++- Hackage: <https://hackage.haskell.org/package/slack-web>++- Slack web API: <https://api.slack.com/web>+ ## Example  ```@@ -11,25 +27,27 @@ ```  ```-> manager <- Slack.mkManager+> import Control.Monad.Reader ```  ```-> :set -XRecordWildCards-> Slack.Cli{..} = Slack.mkCli-apiTest :: ...-authTest :: ...-channelsCreate :: ...-chatPostMessage :: ...+> :set -XOverloadedStrings ```  ```-> Slack.run manager (apiTest Api.mkTestReq)+> slackConfig <- Slack.mkSlackConfig token+```++```+> flip runReaderT slackConfig (Slack.apiTest Api.mkTestReq) Right ... ```  ```-> :set -XOverloadedStrings-> Slack.run manager (apiTest Api.mkTestReq { testReqFoo = Just "bar" })+> flip runReaderT slackConfig (Slack.apiTest Api.mkTestReq { Api.testReqFoo = Just "bar" }) Right ... ```++## License++Licensed under the MIT license. See [LICENSE.md](LICENSE.md).
slack-web.cabal view
@@ -1,5 +1,5 @@ name: slack-web-version: 0.1.0+version: 0.2.0  build-type: Simple cabal-version: >= 1.21@@ -35,23 +35,62 @@       Web.Slack.Auth       Web.Slack.Channel       Web.Slack.Chat+      Web.Slack.Common+      Web.Slack.Group+      Web.Slack.Im+      Web.Slack.MessageParser+      Web.Slack.User+  other-modules:+      Web.Slack.Types       Web.Slack.Util   build-depends:-      aeson >= 1.1 && < 1.2-    , base >= 4.9 && < 4.10-    , generics-sop >= 0.2 && < 0.3+      aeson >= 1.0 && < 1.3+    , base >= 4.9 && < 4.11+    , containers     , http-api-data >= 0.3 && < 0.4     , http-client >= 0.5 && < 0.6     , http-client-tls >= 0.3 && < 0.4-    , servant >= 0.10 && < 0.11-    , servant-client >= 0.10 && < 0.11+    , servant >= 0.9 && < 0.12+    , servant-client >= 0.9 && < 0.12     , text >= 1.2 && < 1.3     , transformers+    , mtl+    , time+    , errors+    , megaparsec   default-language:       Haskell2010   ghc-options:       -Wall +-- the test suite doesn't depend on slack-web+-- but rather has the src as an extra source directory.+-- that allows us to refer to non exported modules from tests.+test-suite tests+  main-is:+      Spec.hs+  hs-source-dirs:+      src, tests+  type:+      exitcode-stdio-1.0+  other-modules:+      Web.Slack.MessageParser+      Web.Slack.MessageParserSpec+      Web.Slack.Types+  build-depends:+      base >= 4.9 && < 4.11+    , containers+    , aeson+    , errors+    , hspec+    , http-api-data+    , text+    , time+    , megaparsec+  default-language:+    Haskell2010+  ghc-options:+       -Wall  source-repository head   type: git
src/Web/Slack.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -15,160 +13,550 @@ ----------------------------------------------------------------------  module Web.Slack-  ( Cli(..)-  , mkCli-  , run-  , mkManager+  ( SlackConfig(..)+  , mkSlackConfig+  , apiTest+  , authTest+  , chatPostMessage+  , channelsCreate+  , channelsList+  , channelsHistory+  , groupsHistory+  , groupsList+  , historyFetchAll+  , imHistory+  , imList+  , mpimList+  , mpimHistory+  , getUserDesc+  , usersList+  , authenticateReq+  , Response+  , HasManager+  , HasToken   )   where +-- aeson+import Data.Aeson+ -- base+import Control.Arrow ((&&&))+import Data.Maybe import Data.Proxy (Proxy(..))-import GHC.Generics (Generic) --- generics-sop-import qualified Generics.SOP (Generic)+-- containers+import qualified Data.Map as Map +-- error+import Control.Error (lastZ, isNothing)+ -- http-client import Network.HTTP.Client (Manager, newManager)  -- http-client-tls import Network.HTTP.Client.TLS (tlsManagerSettings) +-- mtl+import Control.Monad.Reader+ -- servant import Servant.API  -- servant-client import Servant.Client-import Servant.Client.Generic+import Servant.Common.Req (Req, appendToQueryString)  -- slack-web import qualified Web.Slack.Api as Api import qualified Web.Slack.Auth as Auth import qualified Web.Slack.Channel as Channel import qualified Web.Slack.Chat as Chat+import qualified Web.Slack.Common as Common+import qualified Web.Slack.Im as Im+import qualified Web.Slack.Group as Group+import qualified Web.Slack.User as User --- transformers-import Control.Monad.IO.Class+-- text+import Data.Text (Text) +class HasManager a where+    getManager :: a -> Manager +class HasToken a where+    getToken :: a -> Text++-- | Implements the 'HasManager' and 'HasToken' typeclasses.+data SlackConfig+  = SlackConfig+  { slackConfigManager :: Manager+  , slackConfigToken :: Text+  }++instance HasManager SlackConfig where+    getManager = slackConfigManager+instance HasToken SlackConfig where+    getToken = slackConfigToken++-- contains errors that can be returned by the slack API.+-- constrast with 'SlackClientError' which additionally+-- contains errors which occured during the network communication.+data ResponseSlackError = ResponseSlackError Text+  deriving (Eq, Show)++type Response a =  Either Common.SlackClientError a+ -- |+-- Internal type! --+newtype ResponseJSON a = ResponseJSON (Either ResponseSlackError a)++instance FromJSON a => FromJSON (ResponseJSON a) where+    parseJSON = withObject "Response" $ \o -> do+        ok <- o .: "ok"+        ResponseJSON <$> if ok+           then Right <$> parseJSON (Object o)+           else Left . ResponseSlackError <$> o .: "error"+++-- | --+--  type Api =     "api.test"       :> ReqBody '[FormUrlEncoded] Api.TestReq-      :> Post '[JSON] Api.TestRsp+      :> Post '[JSON] (ResponseJSON Api.TestRsp)   :<|>     "auth.test"-      :> ReqBody '[FormUrlEncoded] Auth.TestReq-      :> Post '[JSON] Auth.TestRsp+      :> AuthProtect "token"+      :> Post '[JSON] (ResponseJSON Auth.TestRsp)   :<|>     "channels.create"+      :> AuthProtect "token"       :> ReqBody '[FormUrlEncoded] Channel.CreateReq-      :> Post '[JSON] Channel.CreateRsp+      :> Post '[JSON] (ResponseJSON Channel.CreateRsp)   :<|>+    "channels.history"+      :> AuthProtect "token"+      :> ReqBody '[FormUrlEncoded] Common.HistoryReq+      :> Post '[JSON] (ResponseJSON Common.HistoryRsp)+  :<|>+    "channels.list"+      :> AuthProtect "token"+      :> ReqBody '[FormUrlEncoded] Channel.ListReq+      :> Post '[JSON] (ResponseJSON Channel.ListRsp)+  :<|>     "chat.postMessage"+      :> AuthProtect "token"       :> ReqBody '[FormUrlEncoded] Chat.PostMsgReq-      :> Post '[JSON] Chat.PostMsgRsp+      :> Post '[JSON] (ResponseJSON Chat.PostMsgRsp)+  :<|>+    "groups.history"+      :> AuthProtect "token"+      :> ReqBody '[FormUrlEncoded] Common.HistoryReq+      :> Post '[JSON] (ResponseJSON Common.HistoryRsp)+  :<|>+     "groups.list"+      :> AuthProtect "token"+      :> Post '[JSON] (ResponseJSON Group.ListRsp)+  :<|>+    "im.history"+      :> AuthProtect "token"+      :> ReqBody '[FormUrlEncoded] Common.HistoryReq+      :> Post '[JSON] (ResponseJSON Common.HistoryRsp)+  :<|>+    "im.list"+      :> AuthProtect "token"+      :> Post '[JSON] (ResponseJSON Im.ListRsp)+  :<|>+    "mpim.list"+      :> AuthProtect "token"+      :> Post '[JSON] (ResponseJSON Group.ListRsp)+  :<|>+    "mpim.history"+      :> AuthProtect "token"+      :> ReqBody '[FormUrlEncoded] Common.HistoryReq+      :> Post '[JSON] (ResponseJSON Common.HistoryRsp)+  :<|>+    "users.list"+      :> AuthProtect "token"+      :> Post '[JSON] (ResponseJSON User.ListRsp)   -- | --+-- Check API calling code. --+-- <https://api.slack.com/methods/api.test> -data Cli =-  Cli-    { -- |-      ---      -- Check API calling code.-      ---      -- <https://api.slack.com/methods/api.test>+apiTest+  :: (MonadReader env m, HasManager env, MonadIO m)+  => Api.TestReq+  -> m (Response Api.TestRsp)+apiTest req = run (apiTest_ req) -      apiTest-        :: Api.TestReq-        -> ClientM Api.TestRsp+apiTest_+  :: Api.TestReq+  -> ClientM (ResponseJSON Api.TestRsp) -      -- |-      ---      -- Check authentication and identity.-      ---      -- <https://api.slack.com/methods/auth.test>+-- |+--+-- Check authentication and identity.+--+-- <https://api.slack.com/methods/auth.test> -    , authTest-        :: Auth.TestReq-        -> ClientM Auth.TestRsp+authTest+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => m (Response Auth.TestRsp)+authTest = do+  authR <- mkSlackAuthenticateReq+  run (authTest_ authR) -      -- |-      ---      -- Create a channel.-      ---      -- <https://api.slack.com/methods/channels.create>+authTest_+  :: AuthenticateReq (AuthProtect "token")+  -> ClientM (ResponseJSON Auth.TestRsp) -    , channelsCreate-        :: Channel.CreateReq-        -> ClientM Channel.CreateRsp -      -- |-      ---      -- Send a message to a channel.-      ---      -- <https://api.slack.com/methods/chat.postMessage>+-- |+--+-- Create a channel.+--+-- <https://api.slack.com/methods/channels.create> -    , chatPostMessage-        :: Chat.PostMsgReq-        -> ClientM Chat.PostMsgRsp+channelsCreate+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => Channel.CreateReq+  -> m (Response Channel.CreateRsp)+channelsCreate createReq = do+  authR <- mkSlackAuthenticateReq+  run (channelsCreate_ authR createReq) -    }-  deriving (Generic)+channelsCreate_+  :: AuthenticateReq (AuthProtect "token")+  -> Channel.CreateReq+  -> ClientM (ResponseJSON Channel.CreateRsp) +-- |+--+-- Retrieve channel list.+--+-- <https://api.slack.com/methods/channels.list> +channelsList+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => Channel.ListReq+  -> m (Response Channel.ListRsp)+channelsList listReq = do+  authR <- mkSlackAuthenticateReq+  run (channelsList_ authR listReq)++channelsList_+  :: AuthenticateReq (AuthProtect "token")+  -> Channel.ListReq+  -> ClientM (ResponseJSON Channel.ListRsp)+ -- | --+-- Retrieve channel history.+-- Consider using 'historyFetchAll' in combination with this function --+-- <https://api.slack.com/methods/channels.history> -instance Generics.SOP.Generic Cli+channelsHistory+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => Common.HistoryReq+  -> m (Response Common.HistoryRsp)+channelsHistory histReq = do+  authR <- mkSlackAuthenticateReq+  run (channelsHistory_ authR histReq) +channelsHistory_+  :: AuthenticateReq (AuthProtect "token")+  -> Common.HistoryReq+  -> ClientM (ResponseJSON Common.HistoryRsp)  -- | --+-- Send a message to a channel. --+-- <https://api.slack.com/methods/chat.postMessage> -instance (Client Api ~ cli) => ClientLike cli Cli+chatPostMessage+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => Chat.PostMsgReq+  -> m (Response Chat.PostMsgRsp)+chatPostMessage postReq = do+  authR <- mkSlackAuthenticateReq+  run (chatPostMessage_ authR postReq) +chatPostMessage_+  :: AuthenticateReq (AuthProtect "token")+  -> Chat.PostMsgReq+  -> ClientM (ResponseJSON Chat.PostMsgRsp)  -- | --+-- This method returns a list of private channels in the team that the caller+-- is in and archived groups that the caller was in. The list of+-- (non-deactivated) members in each private channel is also returned. --+-- <https://api.slack.com/methods/groups.list> -mkCli :: Cli-mkCli =-  mkClient (client (Proxy :: Proxy Api))+groupsList+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => m (Response Group.ListRsp)+groupsList = do+  authR <- mkSlackAuthenticateReq+  run (groupsList_ authR) +groupsList_+  :: AuthenticateReq (AuthProtect "token")+  -> ClientM (ResponseJSON Group.ListRsp)  -- | --+-- This method returns a portion of messages/events from the specified+-- private channel. To read the entire history for a private channel,+-- call the method with no latest or oldest arguments, and then continue paging.+-- Consider using 'historyFetchAll' in combination with this function --+-- <https://api.slack.com/methods/groups.history> -run-  :: MonadIO m-  => Manager-  -> ClientM a-  -> m (Either ServantError a)-run manager =-  let-    baseUrl =-      BaseUrl Https "slack.com" 443 "/api"+groupsHistory+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => Common.HistoryReq+  -> m (Response Common.HistoryRsp)+groupsHistory hisReq = do+  authR <- mkSlackAuthenticateReq+  run (groupsHistory_ authR hisReq) +groupsHistory_+  :: AuthenticateReq (AuthProtect "token")+  -> Common.HistoryReq+  -> ClientM (ResponseJSON Common.HistoryRsp)++-- |+--+-- Returns a list of all direct message channels that the user has+--+-- <https://api.slack.com/methods/im.list>++imList+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => m (Response Im.ListRsp)+imList = do+  authR <- mkSlackAuthenticateReq+  run (imList_ authR)++imList_+  :: AuthenticateReq (AuthProtect "token")+  -> ClientM (ResponseJSON Im.ListRsp)++-- |+--+-- Retrieve direct message channel history.+-- Consider using 'historyFetchAll' in combination with this function+--+-- <https://api.slack.com/methods/im.history>++imHistory+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => Common.HistoryReq+  -> m (Response Common.HistoryRsp)+imHistory histReq = do+  authR <- mkSlackAuthenticateReq+  run (imHistory_ authR histReq)++imHistory_+  :: AuthenticateReq (AuthProtect "token")+  -> Common.HistoryReq+  -> ClientM (ResponseJSON Common.HistoryRsp)++-- |+--+-- Returns a list of all multiparty direct message channels that the user has+--+-- <https://api.slack.com/methods/mpim.list>++mpimList+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => m (Response Group.ListRsp)+mpimList = do+  authR <- mkSlackAuthenticateReq+  run (mpimList_ authR)++mpimList_+  :: AuthenticateReq (AuthProtect "token")+  -> ClientM (ResponseJSON Group.ListRsp)++-- |+--+-- Retrieve multiparty direct message channel history.+-- Consider using 'historyFetchAll' in combination with this function+--+-- <https://api.slack.com/methods/mpim.history>++mpimHistory+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => Common.HistoryReq+  -> m (Response Common.HistoryRsp)+mpimHistory histReq = do+  authR <- mkSlackAuthenticateReq+  run (mpimHistory_ authR histReq)++mpimHistory_+  :: AuthenticateReq (AuthProtect "token")+  -> Common.HistoryReq+  -> ClientM (ResponseJSON Common.HistoryRsp)++-- |+--+-- This method returns a list of all users in the team.+-- This includes deleted/deactivated users.+--+-- <https://api.slack.com/methods/users.list>++usersList+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => m (Response User.ListRsp)+usersList = do+  authR <- mkSlackAuthenticateReq+  run (usersList_ authR)++usersList_+  :: AuthenticateReq (AuthProtect "token")+  -> ClientM (ResponseJSON User.ListRsp)++-- | Returns a function to get a username from a 'Common.UserId'.+-- Comes in handy to use 'Web.Slack.MessageParser.messageToHtml'+getUserDesc+  :: (Common.UserId -> Text)+  -- ^ A function to give a default username in case the username is unknown+  -> User.ListRsp+  -- ^ List of users as known by the slack server. See 'usersList'.+  -> (Common.UserId -> Text)+  -- ^ A function from 'Common.UserId' to username.+getUserDesc unknownUserFn users =+  let userMap = Map.fromList $ (User.userId &&& User.userName) <$> User.listRspMembers users   in-    liftIO . flip runClientM (ClientEnv manager baseUrl)+    \userId -> fromMaybe (unknownUserFn userId) $ Map.lookup userId userMap +-- |+-- Fetch all history items between two dates. The basic calls+-- 'channelsHistory', 'groupsHistory', 'imHistory' and so on+-- may not return exhaustive results if there were too many+-- records. You need to use 'Web.Slack.Common.historyRspHasMore' to find out+-- whether you got all the data.+--+-- This function will repeatedly call the underlying history+-- function until all the data is fetched or until a call+-- fails, merging the messages obtained from each call.+historyFetchAll+  :: (MonadReader env m, HasManager env, HasToken env, MonadIO m)+  => (Common.HistoryReq -> m (Response Common.HistoryRsp))+  -- ^ The request to make. Can be for instance 'mpimHistory', 'channelsHistory'...+  -> Text+  -- ^ The channel name to query+  -> Int+  -- ^ The number of entries to fetch at once.+  -> Common.SlackTimestamp+  -- ^ The oldest timestamp to fetch records from+  -> Common.SlackTimestamp+  -- ^ The newest timestamp to fetch records to+  -> m (Response Common.HistoryRsp)+  -- ^ A list merging all the history records that were fetched+  -- through the individual queries.+historyFetchAll makeReq channel count oldest latest = do+    -- From slack apidoc: If there are more than 100 messages between+    -- the two timestamps then the messages returned are the ones closest to latest.+    -- In most cases an application will want the most recent messages+    -- and will page backward from there.+    --+    -- for reference (does not apply here) => If oldest is provided but not+    -- latest then the messages returned are those closest to oldest,+    -- allowing you to page forward through history if desired.+    rsp <- makeReq $ Common.HistoryReq channel count (Just latest) (Just oldest) False+    case rsp of+      Left _ -> return rsp+      Right (Common.HistoryRsp msgs hasMore) -> do+          let oldestReceived = Common.messageTs <$> lastZ msgs+          if not hasMore || isNothing oldestReceived+              then return rsp+              else mergeResponses msgs <$>+                   historyFetchAll makeReq channel count oldest (fromJust oldestReceived) +mergeResponses+  :: [Common.Message]+  -> Response Common.HistoryRsp+  -> Response Common.HistoryRsp+mergeResponses _ err@(Left _) = err+mergeResponses msgs (Right rsp) =+    Right (rsp { Common.historyRspMessages = msgs ++ Common.historyRspMessages rsp })++apiTest_+  :<|> authTest_+  :<|> channelsCreate_+  :<|> channelsHistory_+  :<|> channelsList_+  :<|> chatPostMessage_+  :<|> groupsHistory_+  :<|> groupsList_+  :<|> imHistory_+  :<|> imList_+  :<|> mpimList_+  :<|> mpimHistory_+  :<|> usersList_+  =+  client (Proxy :: Proxy Api)++ -- | -- -- -mkManager :: IO Manager-mkManager =-  newManager tlsManagerSettings+type instance AuthClientData (AuthProtect "token") =+  Text+++-- |+--+--++authenticateReq+  :: Text+  -> Req+  -> Req+authenticateReq token =+  appendToQueryString "token" (Just token)+++-- |+--+--++run+  :: (MonadReader env m, HasManager env, MonadIO m)+  => ClientM (ResponseJSON a)+  -> m (Response a)+run clientAction = do+  env <- ask+  let baseUrl = BaseUrl Https "slack.com" 443 "/api"+  unnestErrors <$> liftIO (runClientM clientAction $ ClientEnv (getManager env) baseUrl)++mkSlackAuthenticateReq :: (MonadReader env m, HasToken env)+  => m (AuthenticateReq (AuthProtect "token"))+mkSlackAuthenticateReq = flip mkAuthenticateReq authenticateReq . getToken <$> ask++unnestErrors :: Either ServantError (ResponseJSON a) -> Response a+unnestErrors (Right (ResponseJSON (Right a))) = Right a+unnestErrors (Right (ResponseJSON (Left (ResponseSlackError serv))))+    = Left (Common.SlackError serv)+unnestErrors (Left slackErr) = Left (Common.ServantError slackErr)+++-- | Prepare a SlackConfig from a slack token.+-- You can then call the other functions providing this in a reader context.+--+mkSlackConfig :: Text -> IO SlackConfig+mkSlackConfig token = SlackConfig <$> newManager tlsManagerSettings <*> pure token
src/Web/Slack/Api.hs view
@@ -81,14 +81,11 @@  data TestRsp =   TestRsp-    { testRspOk :: Bool-    , testRspArgs :: Maybe TestReq+    { testRspArgs :: Maybe TestReq     }   deriving (Eq, Generic, Show) - -- | -- ----$(deriveJSON (jsonOpts "testRsp") ''TestRsp)+$(deriveFromJSON (jsonOpts "testRsp") ''TestRsp)
src/Web/Slack/Auth.hs view
@@ -21,9 +21,6 @@ -- base import GHC.Generics (Generic) --- http-api-data-import Web.FormUrlEncoded- -- slack-web import Web.Slack.Util @@ -35,48 +32,9 @@ -- -- -newtype TestReq =-  TestReq-    { testReqToken :: Text-    }-  deriving (Eq, Generic, Show)----- |--------$(deriveJSON (jsonOpts "testReq") ''TestReq)----- |--------instance ToForm TestReq where-  toForm =-    genericToForm (formOpts "testReq")----- |--------mkTestReq-  :: Text-  -> TestReq-mkTestReq =-  TestReq----- |------- data TestRsp =   TestRsp-    { testRspOk :: Bool-    , testRspUrl :: Text+    { testRspUrl :: Text     , testRspTeam :: Text     , testRspUser :: Text     , testRspTeamId :: Text@@ -85,9 +43,5 @@     }   deriving (Eq, Generic, Show) ---- |------  $(deriveJSON (jsonOpts "testRsp") ''TestRsp)
src/Web/Slack/Channel.hs view
@@ -18,6 +18,9 @@   , CreateReq(..)   , mkCreateReq   , CreateRsp(..)+  , ListReq(..)+  , mkListReq+  , ListRsp(..)   )   where @@ -31,6 +34,7 @@ import Web.FormUrlEncoded  -- slack-web+import Web.Slack.Common import Web.Slack.Util  -- text@@ -46,15 +50,15 @@     { channelId :: Text     , channelName :: Text     , channelCreated :: Integer-    , channelCreator :: Text+    , channelCreator :: UserId     , channelIsArchived :: Bool     , channelIsMember :: Bool     , channelIsGeneral :: Bool-    , channelLastRead :: Text+    , channelLastRead :: Maybe Text     , channelLatest :: Maybe Text-    , channelUnreadCount :: Integer-    , channelUnreadCountDisplay :: Integer-    , channelMembers :: [Text]+    , channelUnreadCount :: Maybe Integer+    , channelUnreadCountDisplay :: Maybe Integer+    , channelMembers :: [UserId]     , channelTopic :: Topic     , channelPurpose :: Purpose     }@@ -91,7 +95,7 @@ -- -- -$(deriveJSON (jsonOpts "channel") ''Channel)+$(deriveFromJSON (jsonOpts "channel") ''Channel)   -- |@@ -114,8 +118,7 @@  data CreateReq =   CreateReq-    { createReqToken :: Text-    , createReqName :: Text+    { createReqName :: Text     , createReqValidate :: Maybe Bool     }   deriving (Eq, Generic, Show)@@ -143,12 +146,10 @@  mkCreateReq   :: Text-  -> Text   -> CreateReq-mkCreateReq token name =+mkCreateReq name =   CreateReq-    { createReqToken = token-    , createReqName = name+    { createReqName = name     , createReqValidate = Nothing     } @@ -159,8 +160,7 @@  data CreateRsp =   CreateRsp-    { createRspOk :: Bool-    , createRspChannel :: Channel+    { createRspChannel :: Channel     }   deriving (Eq, Generic, Show) @@ -168,4 +168,53 @@ -- | -- ---$(deriveJSON (jsonOpts "createRsp") ''CreateRsp)+$(deriveFromJSON (jsonOpts "createRsp") ''CreateRsp)++data ListReq =+  ListReq+    { listReqExcludeArchived :: Maybe Bool+    , listReqExcludeMembers :: Maybe Bool+    }+  deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveJSON (jsonOpts "listReq") ''ListReq)+++-- |+--+--++instance ToForm ListReq where+  toForm =+    genericToForm (formOpts "listReq")+++-- |+--+--++mkListReq+  :: ListReq+mkListReq =+  ListReq+    { listReqExcludeArchived = Nothing+    , listReqExcludeMembers = Nothing+    }+++-- |+--+--++data ListRsp =+  ListRsp+    { listRspChannels :: [Channel]+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "listRsp") ''ListRsp)
src/Web/Slack/Chat.hs view
@@ -66,8 +66,7 @@  data PostMsgReq =   PostMsgReq-    { postMsgReqToken :: Text-    , postMsgReqChannel :: Text+    { postMsgReqChannel :: Text     , postMsgReqText :: Text     , postMsgReqParse :: Maybe Text     , postMsgReqLinkNames :: Maybe Bool@@ -107,12 +106,10 @@ mkPostMsgReq   :: Text   -> Text-  -> Text   -> PostMsgReq-mkPostMsgReq token channel text =+mkPostMsgReq channel text =   PostMsgReq-    { postMsgReqToken = token-    , postMsgReqChannel = channel+    { postMsgReqChannel = channel     , postMsgReqText = text     , postMsgReqParse = Nothing     , postMsgReqLinkNames = Nothing@@ -134,15 +131,9 @@  data PostMsgRsp =   PostMsgRsp-    { postMsgRspOk :: Bool-    , postMsgRspTs :: String+    { postMsgRspTs :: String     , postMsgRspMessage :: PostMsg     }   deriving (Eq, Generic, Show) ---- |--------$(deriveJSON (jsonOpts "postMsgRsp") ''PostMsgRsp)+$(deriveFromJSON (jsonOpts "postMsgRsp") ''PostMsgRsp)
+ src/Web/Slack/Common.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedLists #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Common+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack.Common+  ( Color(unColor)+  , UserId(unUserId)+  , SlackTimestamp(..)+  , mkSlackTimestamp+  , HistoryReq(..)+  , mkHistoryReq+  , HistoryRsp(..)+  , Message(..)+  , MessageType(..)+  , SlackClientError(..)+  , SlackMessageText(..)+  )+  where++-- aeson+import Data.Aeson+import Data.Aeson.TH++-- base+import GHC.Generics (Generic)++-- http-api-data+import Web.HttpApiData+import Web.FormUrlEncoded+  +-- servant-client+import Servant.Common.Req++-- slack-web+import Web.Slack.Types+import Web.Slack.Util++-- text+import Data.Text (Text)+++-- |+--+--++data HistoryReq =+  HistoryReq+    { historyReqChannel :: Text+    , historyReqCount :: Int+    , historyReqLatest :: Maybe SlackTimestamp+    , historyReqOldest :: Maybe SlackTimestamp+    , historyReqInclusive :: Bool+    }+  deriving (Eq, Generic, Show)+++-- |+--+--++$(deriveFromJSON (jsonOpts "historyReq") ''HistoryReq)+++-- |+--+--++instance ToForm HistoryReq where+  -- can't use genericToForm because slack expects booleans as 0/1+  toForm HistoryReq{..} =+      [ ("channel", toQueryParam historyReqChannel)+      , ("count", toQueryParam historyReqCount)+      , ("latest", toQueryParam historyReqLatest)+      , ("oldest", toQueryParam historyReqOldest)+      , ("inclusive", toQueryParam (if historyReqInclusive then 1::Int else 0))+      ]+++-- |+--+--++mkHistoryReq+  :: Text+  -> HistoryReq+mkHistoryReq channel =+  HistoryReq+    { historyReqChannel = channel+    , historyReqCount = 100+    , historyReqLatest = Nothing+    , historyReqOldest = Nothing+    , historyReqInclusive = True+    }++data MessageType = MessageTypeMessage+  deriving (Eq, Show)++instance FromJSON MessageType where+  parseJSON "message" = pure MessageTypeMessage+  parseJSON _ = fail "Invalid MessageType"++data Message =+  Message+    { messageType :: MessageType+    , messageUser :: Maybe UserId -- ^ not present for bot messages at least+    , messageText :: SlackMessageText+    -- ^ the message text is in a markdown-like slack-specific format.+    -- Use 'Web.Slack.MessageParser.messageToHtml' to convert it to HTML.+    , messageTs :: SlackTimestamp+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "message") ''Message)++data HistoryRsp =+  HistoryRsp+    { historyRspMessages :: [Message]+    , historyRspHasMore :: Bool+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "historyRsp") ''HistoryRsp)++-- |+-- Errors that can be triggered by a slack request.+data SlackClientError+    = ServantError ServantError+    -- ^ errors from the network connection+    | SlackError Text+    -- ^ errors returned by the slack API+  deriving (Eq, Generic, Show)
+ src/Web/Slack/Group.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Group+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack.Group+  ( Group(..)+  , ListRsp(..)+  )+  where++-- aeson+import Data.Aeson.TH++-- base+import GHC.Generics (Generic)++-- slack-web+import Web.Slack.Common+import Web.Slack.Util++-- text+import Data.Text (Text)++-- time+import Data.Time.Clock.POSIX++data Group =+  Group+    { groupId :: Text+    , groupName :: Text+    , groupIsMpim :: Bool+    , groupCreated :: POSIXTime+    , groupCreator :: UserId+    , groupIsArchived :: Bool+    , groupMembers :: [UserId]+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "group") ''Group)++data ListRsp =+  ListRsp+    { listRspGroups :: [Group]+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "listRsp") ''ListRsp)
+ src/Web/Slack/Im.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Im+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack.Im+  ( Im(..)+  , ListRsp(..)+  )+  where++-- aeson+import Data.Aeson.TH++-- base+import GHC.Generics (Generic)++-- slack-web+import Web.Slack.Util+import Web.Slack.Common++-- text+import Data.Text (Text)++-- time+import Data.Time.Clock.POSIX++data Im =+  Im+    { imId :: Text+    , imIsIm :: Bool+    , imUser :: UserId+    , imCreated :: POSIXTime+    , imIsUserDeleted :: Bool+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "im") ''Im)++data ListRsp =+  ListRsp+    { listRspIms :: [Im]+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "listRsp") ''ListRsp)
+ src/Web/Slack/MessageParser.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++-- | See https://api.slack.com/docs/message-formatting+--+module Web.Slack.MessageParser+  ( messageToHtml+  , HtmlRenderers(..)+  , defaultHtmlRenderers+  )+  where++-- base+import Control.Monad+import Data.List+import Data.Maybe+import Data.Monoid++-- megaparsec+import Text.Megaparsec++-- mtl+import Data.Functor.Identity++-- slack-web+import Web.Slack.Types++-- text+import Data.Text (Text)+import qualified Data.Text as T++newtype SlackUrl = SlackUrl { unSlackUrl :: Text }+  deriving (Show, Eq)++data SlackMsgItem+  = SlackMsgItemPlainText Text+  | SlackMsgItemBoldSection [SlackMsgItem]+  | SlackMsgItemItalicsSection [SlackMsgItem]+  | SlackMsgItemStrikethroughSection [SlackMsgItem]+  | SlackMsgItemLink Text SlackUrl+  | SlackMsgItemUserLink UserId (Maybe Text)+  | SlackMsgItemInlineCodeSection Text+  | SlackMsgItemCodeSection Text+  | SlackMsgItemQuoted [SlackMsgItem]+  | SlackMsgItemEmoticon Text+  deriving (Show, Eq)++type SlackParser a = ParsecT Dec T.Text Identity a++parseMessage :: Text -> [SlackMsgItem]+parseMessage input = fromMaybe [SlackMsgItemPlainText input] $+  parseMaybe (some $ parseMessageItem True) input++parseMessageItem :: Bool -> SlackParser SlackMsgItem+parseMessageItem acceptNewlines+  = parseBoldSection+  <|> parseItalicsSection+  <|> parseStrikethroughSection+  <|> try parseEmoticon+  <|> parseCode+  <|> parseInlineCode+  <|> parseUserLink+  <|> parseLink+  <|> parseBlockQuote+  <|> parsePlainText+  <|> parseWhitespace acceptNewlines++parsePlainText :: SlackParser SlackMsgItem+parsePlainText = SlackMsgItemPlainText . T.pack <$>+    someTill (noneOf stopChars) (void (lookAhead $ try $ oneOf stopChars)+                                   <|> lookAhead (try $ choice $ sectionEndSymbol <$> ['*', '_', ':', '~'])+                                   <|> lookAhead eof)+    where stopChars = [' ', '\n']++-- slack accepts bold/italics modifiers+-- only at word boundary. for instance 'my_word'+-- doesn't trigger an italics section.+parseWhitespace :: Bool -> SlackParser SlackMsgItem+parseWhitespace True =+  SlackMsgItemPlainText . T.pack <$> some (oneOf [' ', '\n'])+parseWhitespace False = SlackMsgItemPlainText . T.pack <$> some (oneOf [' '])++sectionEndSymbol :: Char -> SlackParser ()+sectionEndSymbol chr = void $ char chr >> lookAhead wordBoundary++parseCharDelimitedSection :: Char -> SlackParser [SlackMsgItem]+parseCharDelimitedSection chr = +  char chr *> someTill (parseMessageItem False) (sectionEndSymbol chr)++wordBoundary :: SlackParser ()+wordBoundary = void (oneOf [' ', '\n', '*', '_', ',', '`', '?', '!', ':', ';', '.']) <|> eof++parseBoldSection :: SlackParser SlackMsgItem+parseBoldSection =+  fmap SlackMsgItemBoldSection (parseCharDelimitedSection '*')++parseItalicsSection :: SlackParser SlackMsgItem+parseItalicsSection =+  fmap SlackMsgItemItalicsSection (parseCharDelimitedSection '_')++parseStrikethroughSection :: SlackParser SlackMsgItem+parseStrikethroughSection =+  fmap SlackMsgItemStrikethroughSection (parseCharDelimitedSection '~')++parseEmoticon :: SlackParser SlackMsgItem+parseEmoticon = fmap (SlackMsgItemEmoticon . T.pack) $+  char ':' *> someTill (alphaNumChar <|> char '_' <|> char '+') (sectionEndSymbol ':')++parseUserLink :: SlackParser SlackMsgItem+parseUserLink = do+  void (string "<@")+  userId <- UserId . T.pack <$> some (noneOf ['|', '>'])+  let linkWithoutDesc = char '>' >>+          pure (SlackMsgItemUserLink userId Nothing)+  let linkWithDesc = char '|' >>+          SlackMsgItemUserLink <$> pure userId <*> (Just <$> ((T.pack <$> some (noneOf ['>'])) <* char '>'))+  linkWithDesc <|> linkWithoutDesc++parseLink :: SlackParser SlackMsgItem+parseLink = do+  void (char '<')+  url <- SlackUrl . T.pack <$> some (noneOf ['|', '>'])+  let linkWithoutDesc = char '>' >>+          pure (SlackMsgItemLink (unSlackUrl url) url)+  let linkWithDesc = char '|' >>+          SlackMsgItemLink <$> ((T.pack <$> some (noneOf ['>'])) <* char '>') <*> pure url+  linkWithDesc <|> linkWithoutDesc++parseCode :: SlackParser SlackMsgItem+parseCode = SlackMsgItemCodeSection . T.pack <$>+  (string "```" >> manyTill anyChar (string "```"))++parseInlineCode :: SlackParser SlackMsgItem+parseInlineCode = SlackMsgItemInlineCodeSection . T.pack <$>+  (char '`' *> some (noneOf ['`']) <* char '`')++parseBlockQuote :: SlackParser SlackMsgItem+parseBlockQuote = SlackMsgItemQuoted . intercalate [SlackMsgItemPlainText "<br/>"] <$> some blockQuoteLine++blockQuoteLine :: SlackParser [SlackMsgItem]+blockQuoteLine = string "&gt;" *> optional (char ' ') *>+    manyTill (parseMessageItem False) (eof <|> void newline)++-- |+-- Convert the slack format for messages (markdown like, see+-- https://api.slack.com/docs/message-formatting ) to HTML.+messageToHtml+  :: HtmlRenderers+  -- ^ Renderers allow you to customize the message rendering.+  -- Give 'defaultHtmlRenderers' for a default implementation.+  -> (UserId -> Text)+  -- ^ A function giving a user name for a user id. You can use 'Web.Slack.getUserDesc'+  -> SlackMessageText+  -- ^ A slack message to convert to HTML+  -> Text+  -- ^ The HTML-formatted slack message+messageToHtml htmlRenderers getUserDesc =+  messageToHtml' htmlRenderers getUserDesc . parseMessage . unSlackMessageText++messageToHtml' :: HtmlRenderers -> (UserId -> Text) -> [SlackMsgItem] -> Text+messageToHtml' htmlRenderers getUserDesc = foldr ((<>) . msgItemToHtml htmlRenderers getUserDesc) ""++data HtmlRenderers+  = HtmlRenderers+  { emoticonRenderer :: Text -> Text+  }++defaultHtmlRenderers :: HtmlRenderers+defaultHtmlRenderers = HtmlRenderers+  { emoticonRenderer = \code -> ":" <> code <> ":"+  }+  +msgItemToHtml :: HtmlRenderers -> (UserId -> Text) -> SlackMsgItem -> Text+msgItemToHtml htmlRenderers@HtmlRenderers{..} getUserDesc = \case+  SlackMsgItemPlainText txt -> T.replace "\n" "<br/>" txt+  SlackMsgItemBoldSection cts ->+    "<b>" <> messageToHtml' htmlRenderers getUserDesc cts <> "</b>"+  SlackMsgItemItalicsSection cts ->+    "<i>" <> messageToHtml' htmlRenderers getUserDesc cts <> "</i>"+  SlackMsgItemStrikethroughSection cts ->+    "<strike>" <> messageToHtml' htmlRenderers getUserDesc cts <> "</strike>"+  SlackMsgItemLink txt url ->+    "<a href='" <> unSlackUrl url <> "'>" <> txt <> "</a>"+  SlackMsgItemUserLink userId mTxt -> "@" <> fromMaybe (getUserDesc userId) mTxt+  SlackMsgItemEmoticon code -> emoticonRenderer code+  SlackMsgItemInlineCodeSection code -> "<code>" <> code <> "</code>"+  SlackMsgItemCodeSection code -> "<pre>" <> code <> "</pre>"+  SlackMsgItemQuoted items ->+    "<blockquote>" <> messageToHtml' htmlRenderers getUserDesc items <> "</blockquote>"
+ src/Web/Slack/Types.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeApplications #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.Types+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack.Types+  ( Color(..)+  , UserId(..)+  , SlackTimestamp(..)+  , mkSlackTimestamp+  , SlackMessageText(..)+  )+  where++-- aeson+import Data.Aeson++-- base+import Data.Monoid+import GHC.Generics (Generic)++-- errors+import Control.Error (hush)++-- http-api-data+import Web.HttpApiData++-- text+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Read (decimal)++-- time+import Data.Time.Clock+import Data.Time.Clock.POSIX++-- Ord to allow it to be a key of a Map+newtype Color = Color { unColor :: Text }+  deriving (Eq, Ord, Generic, Show, FromJSON)++-- Ord to allow it to be a key of a Map+newtype UserId = UserId { unUserId :: Text }+  deriving (Eq, Ord, Generic, Show, FromJSON)++-- | Message text in the format returned by Slack,+-- see https://api.slack.com/docs/message-formatting+-- Consider using 'messageToHtml' for displaying.+newtype SlackMessageText = SlackMessageText { unSlackMessageText :: Text}+  deriving (Eq, Generic, Show, FromJSON)++data SlackTimestamp =+  SlackTimestamp+    { slackTimestampTs :: Text+    , slackTimestampTime :: UTCTime+    }+  deriving (Eq, Show)++instance Ord SlackTimestamp where+    compare (SlackTimestamp _ a) (SlackTimestamp _ b) = compare a b++mkSlackTimestamp :: UTCTime -> SlackTimestamp+mkSlackTimestamp utctime = SlackTimestamp (T.pack (show @Integer unixts) <> ".000000") utctime+  where unixts = floor $ toRational $ utcTimeToPOSIXSeconds utctime++instance ToHttpApiData SlackTimestamp where+  toQueryParam (SlackTimestamp contents _) = contents++instance FromJSON SlackTimestamp where+  parseJSON = withText "Slack ts" $ \contents ->+    maybe (fail "Invalid slack ts")+          (pure . SlackTimestamp contents)+          (slackTimestampToTime contents)++slackTimestampToTime :: Text -> Maybe UTCTime+slackTimestampToTime txt =+  posixSecondsToUTCTime . realToFrac @Integer . fst <$> hush (decimal txt)
+ src/Web/Slack/User.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++----------------------------------------------------------------------+-- |+-- Module: Web.Slack.User+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.Slack.User+  ( User(..)+  , ListRsp(..)+  )+  where++-- aeson+import Data.Aeson.TH++-- base+import GHC.Generics (Generic)++-- slack-web+import Web.Slack.Common+import Web.Slack.Util++-- text+import Data.Text (Text)++-- time+import Data.Time.Clock.POSIX++data User =+  User+    { userId :: UserId+    , userName :: Text+    , userDeleted :: Bool+    , userColor :: Maybe Color+    , userIsAdmin :: Maybe Bool+    , userIsOwner :: Maybe Bool+    , userIsPrimaryOwner :: Maybe Bool+    , userIsRestricted :: Maybe Bool+    , userIsUltraRestricted :: Maybe Bool+    , userUpdated :: POSIXTime+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "user") ''User)++data ListRsp =+  ListRsp+    { listRspMembers :: [User]+    }+  deriving (Eq, Generic, Show)++$(deriveFromJSON (jsonOpts "listRsp") ''ListRsp)
src/Web/Slack/Util.hs view
@@ -15,6 +15,7 @@  -- aeson import Data.Aeson.TH+import Data.Aeson.Types  -- base import Data.Char@@ -73,12 +74,4 @@   :: String   -> String addUnderscores =-  let-    go res [] = res-    go [] (x:xs) = go [toLower x] xs-    go res (x:xs)-      | isUpper x = go (toLower x : '_' : res) xs-      | otherwise = go (x : res) xs--  in-    reverse . go []+  camelTo2 '_'
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/Web/Slack/MessageParserSpec.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.Slack.MessageParserSpec (spec) where++-- base+import Data.Monoid++-- hspec+import Test.Hspec++-- slack-web+import Web.Slack.MessageParser+import Web.Slack.Types++-- text+import Data.Text (Text)++testGetUserDesc :: UserId -> Text+testGetUserDesc (UserId "USER1") = "user_one"+testGetUserDesc x = unUserId x++testHtmlRenderers :: HtmlRenderers+testHtmlRenderers = HtmlRenderers+  { emoticonRenderer = \x -> ":>" <> x <> "<:"+  }++msgToHtml :: Text -> Text+msgToHtml = messageToHtml testHtmlRenderers testGetUserDesc . SlackMessageText++spec :: Spec+spec =+  describe "message contents parsing" $ do+    it "handles the trivial case well" $+      msgToHtml "hello" `shouldBe` "hello"+    it "converts a simple message to HTML correctly" $+      msgToHtml "_hello_ *world* <http://www.google.com|google> `code` ```longer\ncode```"+        `shouldBe`+        "<i>hello</i> <b>world</b> <a href='http://www.google.com'>google</a> <code>code</code> <pre>longer\ncode</pre>"+    it "degrades properly to return the input message if it's incorrect" $+      msgToHtml "link not closed <bad"+        `shouldBe`+        "link not closed <bad"+    it "creates italics sections only at word boundaries" $+      msgToHtml "false_positive" `shouldBe` "false_positive"+    it "handles bold, strikethrough & italics simultaneously" $+      msgToHtml "*_~both~_*" `shouldBe` "<b><i><strike>both</strike></i></b>"+    it "aborts nicely on interspersed bold & italics" $+      msgToHtml "inter *sper_ *sed_" `shouldBe` "inter *sper_ *sed_"+    it "parses blockquotes properly" $+      msgToHtml "look at this:\n&gt; test *wow*" `shouldBe` "look at this:<br/><blockquote>test <b>wow</b></blockquote>"+    it "parses code blocks properly" $+      msgToHtml "look at this:\n```test *wow*```" `shouldBe` "look at this:<br/><pre>test *wow*</pre>"+    it "handles non-italics underscores in text well" $+      -- need to put other HTML symbols, otherwise if the parsing fails+      -- i won't find out since we default to returning the input on+      -- parsing failure+      msgToHtml "a:\n&gt;b.\n:slightly_smiling_face:" `shouldBe` "a:<br/><blockquote>b.</blockquote>:>slightly_smiling_face<:"+    it "properly parses multiline blockquotes" $+      msgToHtml "&gt; first row\n&gt; second row\nthird row\n&gt; fourth row"+        `shouldBe`+        "<blockquote>first row<br/>second row</blockquote>third row<br/><blockquote>fourth row</blockquote>"+    it "converts usernames" $+      msgToHtml "<@USER1> should be converted, <@USER1|default> stay default"+        `shouldBe`+        "@user_one should be converted, @default stay default"+    it "converts carriage returns" $+      msgToHtml "a\nb" `shouldBe` "a<br/>b"+    it "handles full stops as punctuation" $+      msgToHtml "*b*." `shouldBe` "<b>b</b>."