~singpolyma/cheogram

e9a3cf3a006446e30268c53cc6212664cc51745a — Stephen Paul Weber 1 year, 2 months ago 7bbccb1
Adhoc bot commands are case-insensitive

Because mobile users can't help but start messages with a captial
2 files changed, 4 insertions(+), 2 deletions(-)

M Adhoc.hs
M UniquePrefix.hs
M Adhoc.hs => Adhoc.hs +2 -1
@@ 10,6 10,7 @@ import Data.XML.Types as XML (Element(..), Node(NodeContent, NodeElement), Conte
import Network.Protocol.XMPP (JID(..), parseJID, formatJID, IQ(..), IQType(..), emptyIQ, Message(..))
import qualified Network.Protocol.XMPP as XMPP

import qualified Data.CaseInsensitive as CI
import qualified Control.Concurrent.STM.Delay as Delay
import qualified Data.Attoparsec.Text as Atto
import qualified Data.Bool.HT as HT


@@ 319,7 320,7 @@ sendHelp db componentJid sendMessage sendIQ from routeFrom = do
adhocBotRunCommand :: (TC.TCDB db, UIO.Unexceptional m) => db -> JID -> JID -> (XMPP.Message -> m ()) -> (XMPP.IQ -> UIO.UIO (STM (Maybe XMPP.IQ))) -> STM XMPP.Message -> JID -> Text -> [Element] -> m ()
adhocBotRunCommand db componentJid routeFrom sendMessage sendIQ getMessage from body cmdEls = do
	let (nodes, cmds) = unzip $ mapMaybe (\el -> (,) <$> attributeText (s"node") el <*> pure el) cmdEls
	case snd <$> find (\(prefixes, _) -> Set.member body prefixes) (zip (uniquePrefix nodes) cmds) of
	case snd <$> find (\(prefixes, _) -> Set.member (CI.mk body) prefixes) (zip (uniquePrefix nodes) cmds) of
		Just cmd -> do
			let cmdIQ = (emptyIQ IQSet) {
				iqFrom = Just routeFrom,

M UniquePrefix.hs => UniquePrefix.hs +2 -1
@@ 3,8 3,9 @@ module UniquePrefix where
import Data.List
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.CaseInsensitive as CI

uniquePrefix txts = helper [] $ map (S.fromList . tail . T.inits) txts
uniquePrefix txts = helper [] $ map (S.fromList . map CI.mk . tail . T.inits) txts

helper done (prefixes:otherPrefixes) =
	(foldl' S.difference prefixes (done ++ otherPrefixes)) : helper (prefixes:done) otherPrefixes