~singpolyma/cheogram

086c55ef68c9ddb1a5a9038908722654160d71de — Christopher Vollick a month ago 74c0964
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.
2 files changed, 21 insertions(+), 22 deletions(-)

M Adhoc.hs
M cheogram.cabal
M Adhoc.hs => Adhoc.hs +20 -22
@@ 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

M cheogram.cabal => cheogram.cabal +1 -0
@@ 60,6 60,7 @@ executable cheogram
                uuid,
                unexceptionalio,
                unexceptionalio-trans,
                utility-ht,
                xml-types

source-repository head