~singpolyma/cheogram

e44d99c841d87f3f13e2777d2210461d994e2224 — Stephen Paul Weber 7 years ago 6722a16
Case-insensitive commands
1 files changed, 20 insertions(+), 11 deletions(-)

M Main.hs
M Main.hs => Main.hs +20 -11
@@ 15,6 15,7 @@ import System.Random.Shuffle (shuffleM)
import "monads-tf" Control.Monad.Error (catchError) -- ick
import Data.Attoparsec.Text (takeText, string, parseOnly, decimal)
import Data.XML.Types (Element(..), Node(NodeContent, NodeElement), Name(Name), Content(ContentText), isNamed, hasAttributeText, elementText, elementChildren, attributeText)
import qualified Data.CaseInsensitive as CI
import qualified Data.Text as T
import qualified Data.Map as Map
import qualified Data.UUID as UUID ( toString )


@@ 476,33 477,41 @@ parseJIDrequireNode txt
	where
	jid = parseJID txt

stripCIPrefix prefix str
	| CI.mk prefix' == prefix = Just rest
	| otherwise = Nothing
	where
	(prefix', rest) = T.splitAt (T.length $ CI.original prefix) str

data Command = Help | Create Text | Join JID | JoinInvited | Send Text | Who | List | Leave | InviteCmd JID | SetNick Text | Whisper JID Text
	deriving (Show, Eq)

parseCommand txt room nick componentHost
	| Just jid <- T.stripPrefix (fromString "/invite ") txt =
	| Just jid <- stripCIPrefix (fromString "/invite ") txt =
		InviteCmd <$> (
			parseJIDrequireNode jid <|>
			telToJid jid (fromString componentHost)
		)
	| Just room <- T.stripPrefix (fromString "/join ") txt =
	| Just room <- stripCIPrefix (fromString "/join ") txt =
		Join <$> (parseJID (room <> fromString "/" <> nick) <|> parseJID room)
	| Just t <- T.stripPrefix (fromString "/create ") txt = Just $ Create t
	| Just nick <- T.stripPrefix (fromString "/nick ") txt = Just $ SetNick nick
	| Just input <- T.stripPrefix (fromString "/msg ") txt =
	| Just t <- stripCIPrefix (fromString "/create ") txt = Just $ Create t
	| Just nick <- stripCIPrefix (fromString "/nick ") txt = Just $ SetNick nick
	| Just input <- stripCIPrefix (fromString "/msg ") txt =
		let (to, msg) = T.breakOn (fromString " ") input in
		Whisper <$> (
			parseJIDrequireNode to <|>
			telToJid to (fromString componentHost) <|>
			(parseJID =<< fmap (\r -> bareTxt r <> fromString "/" <> to) room)
		) <*> pure msg
	| txt == fromString "/join" = Just JoinInvited
	| txt == fromString "/leave" = Just Leave
	| txt == fromString "/part" = Just Leave
	| txt == fromString "/who" = Just Who
	| txt == fromString "/list" = Just List
	| txt == fromString "/help" = Just Help
	| citxt == fromString "/join" = Just JoinInvited
	| citxt == fromString "/leave" = Just Leave
	| citxt == fromString "/part" = Just Leave
	| citxt == fromString "/who" = Just Who
	| citxt == fromString "/list" = Just List
	| citxt == fromString "/help" = Just Help
	| otherwise = Just $ Send txt
	where
	citxt = CI.mk txt

getMessage (ReceivedMessage m) = Just m
getMessage _ = Nothing