From 086c55ef68c9ddb1a5a9038908722654160d71de Mon Sep 17 00:00:00 2001
From: Christopher Vollick <0@psycoti.ca>
Date: Fri, 22 Jan 2021 09:47:34 -0500
Subject: [PATCH] Change Case to Select

I was abusing the case syntax pretty hard, so this should be more accurate to
what's actually going on.

I was going to reintegrate this change back into the earlier commits, but I've
fixed that same ugly merge conflict when the new stuff gets added in the case
statement like 10 times by now, and I'm just not interested in doing it again.

So this is its own commit, at the end.
---
 Adhoc.hs       | 42 ++++++++++++++++++++----------------------
 cheogram.cabal |  1 +
 2 files changed, 21 insertions(+), 22 deletions(-)

diff --git a/Adhoc.hs b/Adhoc.hs
index 749875e..d0055cb 100644
--- a/Adhoc.hs
+++ b/Adhoc.hs
@@ -16,6 +16,7 @@ import qualified Data.UUID as UUID ( toString )
 import qualified Data.UUID.V1 as UUID ( nextUUID )
 import qualified Database.TokyoCabinet as TC
 import qualified UnexceptionalIO as UIO
+import qualified Data.Bool.HT as HT
 
 import StanzaRec
 import UniquePrefix
@@ -141,29 +142,26 @@ adhocBotAnswerListSingle componentJid sendMessage getMessage from field = do
 adhocBotAnswerForm :: (UIO.Unexceptional m) => JID -> (XMPP.Message -> STM ()) -> STM XMPP.Message -> JID -> Element -> m Element
 adhocBotAnswerForm componentJid sendMessage getMessage from form = do
 	fields <- forM (elementChildren form) $ \field -> do
-		case field of
-			_
-				| elementName field == s"{jabber:x:data}instructions" -> atomicUIO (sendMessage $ mkSMS componentJid from $ mconcat $ elementText field) >> return []
-			_
-				| elementName field == s"{jabber:x:data}field",
-				  attributeText (s"type") field == Just (s"list-single") ->
-					adhocBotAnswerListSingle componentJid sendMessage getMessage from field
-			_
-				| elementName field == s"{jabber:x:data}field",
-				  attributeText (s"type") field == Just (s"list-multi") ->
-					adhocBotAnswerListMulti componentJid sendMessage getMessage from field
-			_
-				| elementName field == s"{jabber:x:data}field",
-				  attributeText (s"type") field `elem` [Just (s"text-single"), Nothing] ->
-					-- The default if a type isn't specified is text-single
-					adhocBotAnswerTextSingle componentJid sendMessage getMessage from field
-			_
-				| elementName field == s"{jabber:x:data}field" -> do
-					-- The spec says a field type we don't understand should be treated as text-single
-					log "ADHOC BOT UNKNOWN FIELD" field
-					adhocBotAnswerTextSingle componentJid sendMessage getMessage from field
+		flip HT.select [
+			( elementName field == s"{jabber:x:data}instructions",
+				atomicUIO (sendMessage $ mkSMS componentJid from $ mconcat $ elementText field) >> return []),
+			( elementName field == s"{jabber:x:data}field" &&
+			  attributeText (s"type") field == Just (s"list-single"),
+				adhocBotAnswerListSingle componentJid sendMessage getMessage from field),
+			( elementName field == s"{jabber:x:data}field" &&
+			  attributeText (s"type") field == Just (s"list-multi"),
+				adhocBotAnswerListMulti componentJid sendMessage getMessage from field),
+			( elementName field == s"{jabber:x:data}field" &&
+			  attributeText (s"type") field `elem` [Just (s"text-single"), Nothing],
+				-- The default if a type isn't specified is text-single
+				adhocBotAnswerTextSingle componentJid sendMessage getMessage from field),
+			( elementName field == s"{jabber:x:data}field",
+				-- The spec says a field type we don't understand should be treated as text-single
+				log "ADHOC BOT UNKNOWN FIELD" field >>
+				adhocBotAnswerTextSingle componentJid sendMessage getMessage from field
+			)]
 			-- There can be other things in here that aren't fields, and we want to ignore them completely
-			_ -> return []
+			(return [])
 	return $ Element (s"{jabber:x:data}x") [(s"type", [ContentText $ s"submit"])] $ NodeElement <$> mconcat fields
 
 optionText :: Element -> Text
diff --git a/cheogram.cabal b/cheogram.cabal
index a8a9af5..672dfa8 100644
--- a/cheogram.cabal
+++ b/cheogram.cabal
@@ -60,6 +60,7 @@ executable cheogram
                 uuid,
                 unexceptionalio,
                 unexceptionalio-trans,
+                utility-ht,
                 xml-types
 
 source-repository head
-- 
2.45.2