Merge pull request #121 from serokell/diogo/#108-improve-block-support

[#108] Improve block support

package.yaml

@@ -103,7 +103,6 @@ tests:
     - katip
     - nyan-interpolation
     - servant-client-core
-    - string-conversions
     - tasty
     - tasty-hspec
     - tasty-hunit

src/TzBot/Slack/API/MessageBlock.hs

@@ -202,15 +202,26 @@ extractPieces mBlocks = runWriter $ concat <$> mapM goMessageBlock mBlocks
     go :: Maybe Builder -> [Text] -> [WithUnknown BlockElementLevel2] -> Writer [ExtractError] [Text]
     go mbCurPiece prevPieces (e:es) = case unUnknown e of
       Left val -> do
-        let _type = fromMaybe "unknown" (val ^? key "type" . _String)
-        tell [EEUnknownBlockElementLevel2 $ UnknownBlockElementLevel2Error _type val]
-        go Nothing (prependMbCurrentToPrevious mbCurPiece prevPieces) es
+        let blockType = fromMaybe "unknown" (val ^? key "type" . _String)
+        case blockType of
+          "emoji" ->
+            -- skip over emoji blocks
+            go mbCurPiece prevPieces es
+          _ -> do
+            -- return an error if we find a block type we don't recognize.
+            when (blockType `notElem` knownBlockTypes) do
+              tell [EEUnknownBlockElementLevel2 $ UnknownBlockElementLevel2Error blockType val]
+            -- break the message in two separate `Text` pieces.
+            go Nothing (prependMbCurrentToPrevious mbCurPiece prevPieces) es
       Right (BEL2ElementText elementText) -> do
         let etTextB = fromText elementText.etText
         if (elementText.etStyle >>= styCode) == Just True
-          -- ignore inline code block
-          then go Nothing (prependMbCurrentToPrevious mbCurPiece prevPieces) es
-          else go (Just $ maybe etTextB (<> etTextB) mbCurPiece) prevPieces es
+          then
+            -- ignore inline code block
+            go Nothing (prependMbCurrentToPrevious mbCurPiece prevPieces) es
+          else
+            -- collate this block's text with any adjacent text-like block
+            go (Just $ maybe etTextB (<> etTextB) mbCurPiece) prevPieces es
       Right (BEL2ElementLink elementLink) -> do
         let linkText = fromText elementLink.elText
         go (Just $ maybe linkText (<> linkText) mbCurPiece) prevPieces es
@@ -220,3 +231,10 @@ extractPieces mBlocks = runWriter $ concat <$> mapM goMessageBlock mBlocks
     prependMbCurrentToPrevious :: Maybe Builder -> [Text] -> [Text]
     prependMbCurrentToPrevious mbCurPiece prevPieces =
       maybe prevPieces ((: prevPieces) . cs . toLazyText) mbCurPiece
+
+    knownBlockTypes :: [Text]
+    knownBlockTypes =
+      [ "user" -- A user tag, e.g. `@gromak`
+      , "usergroup" -- A tag for a user group, e.g. `@ligo-lsp-project
+      , "broadcast" -- A tag like `@here` or `@channel`
+      ]