Added banlist functionality

package.yaml

@@ -57,6 +57,7 @@ dependencies:
 - safe
 - edit-distance
 - unliftio
+- split
 
 library:
   source-dirs: src

src/Tablebot/Plugins/Netrunner/Command/BanList.hs

@@ -0,0 +1,116 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+-- |
+-- Module      : Tablebot.Plugins.Netrunner.Netrunner
+-- Description : Handles the internal functionality of the Netrunner command.
+-- License     : MIT
+-- Maintainer  : [email protected]
+-- Stability   : experimental
+-- Portability : POSIX
+--
+-- Backend for the banHistory and banList commands.
+module Tablebot.Plugins.Netrunner.Command.BanList
+  ( queryBanList,
+    listBanLists,
+    listAffectedCards,
+    listBanHistory,
+  )
+where
+
+import Data.List (nubBy)
+import Data.Map (keys)
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Text (Text, intercalate, isInfixOf, toLower, unpack)
+import qualified Data.Text as T (length, take)
+import Tablebot.Plugins.Netrunner.Type.BanList (BanList (active, affectedCards, listId, name), CardBan (..))
+import qualified Tablebot.Plugins.Netrunner.Type.BanList as BanList
+import Tablebot.Plugins.Netrunner.Type.Card (Card (code, keywords, sideCode, title))
+import Tablebot.Plugins.Netrunner.Type.NrApi (NrApi (..))
+import Tablebot.Plugins.Netrunner.Utility.BanList
+import Tablebot.Plugins.Netrunner.Utility.Card (toLink)
+import Tablebot.Utility.Search (FuzzyCosts (..), closestValueWithCosts)
+
+-- | @queryBanList@ matches the input to the banlist with the closest name.
+queryBanList :: NrApi -> Text -> BanList
+queryBanList api query =
+  let bls = ("active", activeBanList api) : ("latest", latestBanList api) : (zip (map (unpack . toLower . name) $ banLists api) $ banLists api)
+   in closestValueWithCosts editCosts bls $ unpack $ toLower query
+  where
+    editCosts =
+      FuzzyCosts
+        { deletion = 100,
+          insertion = 1,
+          substitution = 100,
+          transposition = 100
+        }
+
+-- | @listBanLists@ lists all banlists from Netrunner history.
+listBanLists :: NrApi -> Text
+listBanLists api = intercalate "\n" $ map format $ reverse $ banLists api
+  where
+    format :: BanList -> Text
+    format b = "• " <> name b <> if active b then " (active)" else ""
+
+-- | @listBanHistory@ lists each version of the Netrunner banlist and the state
+-- of the given card under each version.
+listBanHistory :: NrApi -> Card -> Text
+listBanHistory api card = intercalate "\n" $ map format $ reverse $ banLists api
+  where
+    format :: BanList -> Text
+    format b = symbol (toMwlStatus api b card) <> " " <> BanList.name b <> formatActive b
+    formatActive :: BanList -> Text
+    formatActive b = if active b then " (active)" else ""
+
+-- | @listAffectedCards@ lists all the cards affected by a banlist with links.
+-- The output pair is (additional text, list of linked cards). This is to
+-- account for large groups of cards being banned together resulting in
+-- otherwise excessively long lists of banned cards.
+listAffectedCards :: NrApi -> BanList -> (Text, [Text], [Text])
+listAffectedCards api b =
+  let banCurrents = listId b > 15 -- All banlists since list _all_ unrotated currents
+      allCards = nubBy (\c1 c2 -> title c1 == title c2) $ mapMaybe find $ keys $ affectedCards b
+      cards =
+        if banCurrents
+          then filter (not . ("current" `isInfixOf`) . toLower . (fromMaybe "") . keywords) allCards
+          else allCards
+      cCards = filter ((== Just "corp") . sideCode) cards
+      rCards = filter ((== Just "runner") . sideCode) cards
+      pre =
+        if banCurrents
+          then "🚫 All cards with the [Current](https://netrunnerdb.com/find/?q=s%3Acurrent) subtype."
+          else ""
+   in (pre, map format cCards, map format rCards)
+  where
+    find :: Text -> Maybe Card
+    find cCode = case filter ((Just cCode ==) . code) $ cards api of
+      [] -> Nothing
+      xs -> Just $ head xs
+    format :: Card -> Text
+    format card = symbol (toMwlStatus api b card) <> " [" <> condense (fromMaybe "?" $ title card) <> "](" <> ")"
+    condense :: Text -> Text
+    condense t =
+      if T.length t > 30
+        then T.take 27 t <> "..."
+        else t
+
+-- | @symbol@ gets the emoji corresponding to each type of card ban.
+symbol :: CardBan -> Text
+symbol Banned = "🚫"
+symbol Restricted = "🦄"
+symbol (UniversalInfluence x) = formatNum x
+symbol (GlobalPenalty x) = formatNum x
+symbol _ = "✅"
+
+-- | @formatNum@ formats a number to its Discord emoji.
+formatNum :: Int -> Text
+formatNum 1 = "1️⃣"
+formatNum 2 = "2️⃣"
+formatNum 3 = "3️⃣"
+formatNum 4 = "4️⃣"
+formatNum 5 = "5️⃣"
+formatNum 6 = "6️⃣"
+formatNum 7 = "7️⃣"
+formatNum 8 = "8️⃣"
+formatNum 9 = "9️⃣"
+formatNum 0 = "0️⃣"
+formatNum _ = "#️⃣"

src/Tablebot/Plugins/Netrunner/Plugin.hs

@@ -14,19 +14,20 @@ import Control.Monad.Trans.Reader (ask)
 import Data.Text (Text, pack)
 import Discord.Types
 import Tablebot.Internal.Handler.Command ()
-import Tablebot.Plugins.Netrunner.Command.BanHistory (listBanHistory)
-import Tablebot.Plugins.Netrunner.Command.Custom (customCard)
+import Tablebot.Plugins.Netrunner.Command.BanList
+import Tablebot.Plugins.Netrunner.Command.Custom
 import Tablebot.Plugins.Netrunner.Command.Find
 import Tablebot.Plugins.Netrunner.Command.Search
+import Tablebot.Plugins.Netrunner.Type.BanList (BanList (active))
+import qualified Tablebot.Plugins.Netrunner.Type.BanList as BanList
 import Tablebot.Plugins.Netrunner.Type.Card (Card)
 import Tablebot.Plugins.Netrunner.Type.NrApi (NrApi (..))
 import Tablebot.Plugins.Netrunner.Utility.Embed
 import Tablebot.Plugins.Netrunner.Utility.NrApi (getNrApi)
 import Tablebot.Utility
 import Tablebot.Utility.Discord (formatFromEmojiName, sendEmbedMessage, sendMessage)
-import Tablebot.Utility.Exception (BotException (NetrunnerException), throwBot)
 import Tablebot.Utility.Parser (NrQuery (..), keyValue, keyValuesSepOn, netrunnerQuery)
-import Tablebot.Utility.SmartParser (PComm (parseComm), Quoted (Qu), RestOfInput1 (ROI1), WithError (WErr))
+import Tablebot.Utility.SmartParser (PComm (parseComm), Quoted (Qu), RestOfInput (ROI), RestOfInput1 (ROI1), WithError (WErr))
 import Text.RawString.QQ (r)
 
 -- | @netrunner@ is the user-facing command that searches for Netrunner cards.
@@ -42,7 +43,9 @@ netrunner =
       nrSearch,
       nrCustom,
       nrBanHistory,
-      commandAlias "bh" nrBanHistory
+      commandAlias "bh" nrBanHistory,
+      nrBanList,
+      commandAlias "bl" nrBanList
     ]
   where
     nrComm ::
@@ -156,16 +159,30 @@ nrBanHistory :: EnvCommand NrApi
 nrBanHistory = Command "banHistory" (parseComm banHistoryComm) []
   where
     banHistoryComm ::
-      WithError "No card title given!" (Either (Quoted Text) (RestOfInput1 Text)) ->
+      WithError "No card title given!" (RestOfInput1 Text) ->
       Message ->
       EnvDatabaseDiscord NrApi ()
-    banHistoryComm (WErr (Left (Qu q))) = sendEmbed q
-    banHistoryComm (WErr (Right (ROI1 q))) = sendEmbed q
+    banHistoryComm (WErr (ROI1 q)) = sendEmbed q
     sendEmbed :: Text -> Message -> EnvDatabaseDiscord NrApi ()
     sendEmbed query m = do
       api <- ask
       embedBanHistory (queryCard api query) m
 
+-- | @nrBanList@ is a command listing all cards affected by a banlist.
+nrBanList :: EnvCommand NrApi
+nrBanList = Command "banList" (parseComm banListComm) []
+  where
+    banListComm ::
+      Either () (RestOfInput Text) ->
+      Message ->
+      EnvDatabaseDiscord NrApi ()
+    banListComm (Left ()) = embedBanLists
+    banListComm (Right (ROI q)) = sendEmbed q
+    sendEmbed :: Text -> Message -> EnvDatabaseDiscord NrApi ()
+    sendEmbed query m = do
+      api <- ask
+      embedBanList (queryBanList api query) m
+
 -- | @embedCard@ takes a card and embeds it in a message.
 embedCard :: Card -> Message -> EnvDatabaseDiscord NrApi ()
 embedCard card m = do
@@ -182,27 +199,41 @@ embedCards pre cards err m = do
 embedCardImg :: Card -> Message -> EnvDatabaseDiscord NrApi ()
 embedCardImg card m = do
   api <- ask
-  case cardToImgEmbed api card of
-    Nothing -> throwBot $ NetrunnerException "Could not get card art"
-    Just embed -> sendEmbedMessage m "" embed
+  sendEmbedMessage m "" $ cardToImgEmbed api card
 
 -- | @embedCardFlavour@ embeds a card's flavour in a message, if able.
 embedCardFlavour :: Card -> Message -> EnvDatabaseDiscord NrApi ()
 embedCardFlavour card m = do
   api <- ask
   embed <- cardToFlavourEmbed api card
-  case embed of
-    Nothing -> throwBot $ NetrunnerException "Card has no flavour text"
-    Just e -> sendEmbedMessage m "" e
+  sendEmbedMessage m "" embed
 
 -- | @embedBanHistory@ embeds a card's banlist history.
 embedBanHistory :: Card -> Message -> EnvDatabaseDiscord NrApi ()
 embedBanHistory card m = do
   api <- ask
   embed <- cardToEmbedWithText api card $ listBanHistory api card
-  case embed of
-    Nothing -> throwBot $ NetrunnerException "Could not generate history"
-    Just e -> sendEmbedMessage m "" e
+  sendEmbedMessage m "" embed
+
+-- | @embedBanLists@ embeds all banlists in Netrunner history.
+embedBanLists :: Message -> EnvDatabaseDiscord NrApi ()
+embedBanLists m = do
+  api <- ask
+  sendEmbedMessage m "" $ embedTextWithUrl "Standard Banlists" "https://netrunnerdb.com/en/banlists" $ listBanLists api
+
+-- | @embedBanList@ embeds a card's banlist history.
+embedBanList :: BanList -> Message -> EnvDatabaseDiscord NrApi ()
+embedBanList banList m = do
+  api <- ask
+  let (pre, cCards, rCards) = listAffectedCards api banList
+  sendEmbedMessage m "" $ embedColumns header pre [("Corp Cards", cCards), ("Runner Cards", rCards)]
+  where
+    header :: Text
+    header =
+      BanList.name banList
+        <> if active banList
+          then " (active)"
+          else ""
 
 netrunnerHelp :: HelpPage
 netrunnerHelp =
@@ -224,7 +255,14 @@ Add additional syntax to the start of the query to fetch only the card's image o
   - `{{!card image}}      ` -> fetches the image of the card matching "card image"
   - `{{|card flavour}}    ` -> fetches the flavour text of the card matching "card flavour"
   - `{{#banned card}}     ` -> fetches the ban history of the card matching "banned card"|]
-    [findHelp, findImgHelp, findFlavourHelp, searchHelp, customHelp, banHistoryHelp]
+    [ findHelp,
+      findImgHelp,
+      findFlavourHelp,
+      searchHelp,
+      customHelp,
+      banHistoryHelp,
+      banListHelp
+    ]
     None
 
 findHelp :: HelpPage
@@ -343,6 +381,22 @@ Shows the history of a card's legality in each version of Netrunner's MWL
     []
     None
 
+banListHelp :: HelpPage
+banListHelp =
+  HelpPage
+    "banList"
+    ["bl"]
+    "lists all cards affected by a given banlist"
+    [r|**Netrunner Banlists**
+Shows the list of cards affected by the given banlist
+"latest" and "active" will provide their respective banlists (they differ only when the latest banlist has not yet been made active)
+If no argument is given it will instead list all banlists from Netrunner history
+
+*Usage:*
+- `netrunner banList name` -> displays the history of the banlist version matching "name"|]
+    []
+    None
+
 beginnerText :: EnvDatabaseDiscord NrApi Text
 beginnerText = do
   subroutine <- formatFromEmojiName "subroutine"