~singpolyma/cheogram

386eb97d08fd03ee2e77351410fbe1e401d92f6f — Christopher Vollick 4 months ago 7164558
AdHoc Bot Continues on Result Forms

Previously it would display results and then be done, but I may want to
display resutlts and then continue, so I pulled the logic out of the
normal form-filling path and put it in result so it will continue
automatically if we're still executing.

This means that the bot will render back-to-back result forms as just a
dump of their output, but honestly that's probably fine.
What's the point in asking if they'd like to continue if I can just
continue until we hit a question we actually need the human to answer!
1 files changed, 17 insertions(+), 10 deletions(-)

M Adhoc.hs
M Adhoc.hs => Adhoc.hs +17 -10
@@ 483,6 483,21 @@ adhocBotRunCommand db componentJid routeFrom sendMessage sendIQ getMessage from 
			]) cmdIQ
	threadedMessage Nothing msg = msg
	threadedMessage (Just sessionid) msg = msg { messagePayloads = (Element (s"thread") [] [NodeContent $ ContentText sessionid]) : messagePayloads msg }
	continueExecution resultIQ responseBody
		| Just payload <- iqPayload resultIQ,
		  Just sessionid <- attributeText (s"sessionid") payload,
		  Just "executing" <- T.unpack <$> attributeText (s"status") payload = do
			let actions = listToMaybe $ isNamed(s"{http://jabber.org/protocol/commands}actions") =<< elementChildren payload
			-- The standard says if actions is present, with no "execute" attribute, that the default is "next"
			-- But if there is no actions, the default is "execute"
			let defaultAction = maybe (s"execute") (fromMaybe (s"next") . attributeText (s"execute")) actions
			let cmdIQ' = (emptyIQ IQSet) {
				iqFrom = Just routeFrom,
				iqTo = iqFrom resultIQ,
				iqPayload = Just $ Element (s"{http://jabber.org/protocol/commands}command") [(s"node", [ContentText $ fromMaybe mempty $ attributeText (s"node") payload]), (s"sessionid", [ContentText sessionid]), (s"action", [ContentText defaultAction])] responseBody
			}
			sendAndRespondTo Nothing cmdIQ'
	continueExecution _ _ = return ()
	sendAndRespondTo intro cmdIQ = do
		mcmdResult <- atomicUIO =<< UIO.lift (sendIQ cmdIQ)
		case mcmdResult of


@@ 493,6 508,7 @@ adhocBotRunCommand db componentJid routeFrom sendMessage sendIQ getMessage from 
				  attributeText (s"type") form == Just (s"result") -> do
					let sendText = sendMessage . threadedMessage (attributeText (s"sessionid") payload) . mkSMS componentJid from
					sendText $ renderResultForm form
					continueExecution resultIQ []
				| IQResult == iqType resultIQ,
				  Just payload <- iqPayload resultIQ,
				  Just sessionid <- attributeText (s"sessionid") payload,


@@ 508,16 524,7 @@ adhocBotRunCommand db componentJid routeFrom sendMessage sendIQ getMessage from 
					let cancelText = sendText . ((cmd ++ s" ") ++)
					forM_ intro sendText
					returnForm <- adhocBotAnswerForm sendText (withCancel sessionLifespan cancelText cancel getMessage) form
					let actions = listToMaybe $ isNamed(s"{http://jabber.org/protocol/commands}actions") =<< elementChildren payload
					-- The standard says if actions is present, with no "execute" attribute, that the default is "next"
					-- But if there is no actions, the default is "execute"
					let defaultAction = maybe (s"execute") (fromMaybe (s"next") . attributeText (s"execute")) actions
					let cmdIQ' = (emptyIQ IQSet) {
						iqFrom = Just routeFrom,
						iqTo = iqFrom resultIQ,
						iqPayload = Just $ Element (s"{http://jabber.org/protocol/commands}command") [(s"node", [ContentText $ fromMaybe mempty $ attributeText (s"node") payload]), (s"sessionid", [ContentText sessionid]), (s"action", [ContentText defaultAction])] [NodeElement returnForm]
					}
					sendAndRespondTo Nothing cmdIQ'
					continueExecution resultIQ [NodeElement returnForm]
				| IQResult == iqType resultIQ,
				  Just payload <- iqPayload resultIQ,
				  notes@(_:_) <- isNamed (s"{http://jabber.org/protocol/commands}note") =<< elementChildren payload -> do