diff --git a/HyperNerd.cabal b/HyperNerd.cabal index 7a8e435..c4e6cfa 100644 --- a/HyperNerd.cabal +++ b/HyperNerd.cabal @@ -78,6 +78,7 @@ executable HyperNerd , Bot.Twitch , Bot.Variable , Bot.Calc + , Bot.Expr , BotState , Command , Config diff --git a/src/Bot.hs b/src/Bot.hs index 13e0284..30f39f5 100644 --- a/src/Bot.hs +++ b/src/Bot.hs @@ -306,6 +306,9 @@ builtinCommands = cmapR (return . minutesToTimeZone) $ liftR (flip (liftM2 utcToLocalTime) now) $ cmapR (T.pack . show) $ Reaction replyMessage)) + , ( "urlencode" + , ( "!google URL encode" + , liftR (callFun "urlencode" . return) $ ignoreNothing sayMessage)) ] combineDecks :: [a] -> [a] -> [a] @@ -432,7 +435,8 @@ messageReaction = dispatchRedirect :: Effect () -> Message (Command T.Text) -> Effect () dispatchRedirect effect cmd = do - effectOutput <- T.concat . concatMap (\x -> [" ", x]) <$> listen effect + effectOutput <- + T.strip . T.concat . concatMap (\x -> [" ", x]) <$> listen effect dispatchCommand $ getCompose ((\x -> T.concat [x, effectOutput]) <$> Compose cmd) diff --git a/src/Bot/CustomCommand.hs b/src/Bot/CustomCommand.hs index 448b854..82667d2 100644 --- a/src/Bot/CustomCommand.hs +++ b/src/Bot/CustomCommand.hs @@ -169,6 +169,7 @@ updateCustomCommand builtinCommands = (Nothing, Nothing) -> replyToSender sender [qms|Command '{name}' does not exist|] +-- TODO(#598): reimplement expandCustomCommandVars with Bot.Expr when it's ready expandCustomCommandVars :: Sender -> T.Text -> CustomCommand -> Effect CustomCommand expandCustomCommandVars sender args customCommand = do diff --git a/src/Bot/Expr.hs b/src/Bot/Expr.hs new file mode 100644 index 0000000..99a30d3 --- /dev/null +++ b/src/Bot/Expr.hs @@ -0,0 +1,22 @@ +module Bot.Expr + ( parseExprs + , interpretExprs + ) where + +import qualified Data.Text as T +import Effect + +data Expr + = TextExpr T.Text + | FunCallExpr T.Text + [Expr] + | VarExpr T.Text + deriving (Eq, Show) + +-- TODO(#599): parseExprs is not implemented +parseExprs :: T.Text -> Either String [Expr] +parseExprs = undefined + +-- TODO(#600): interpretExprs is not implemented +interpretExprs :: [Expr] -> Effect T.Text +interpretExprs = undefined diff --git a/src/BotState.hs b/src/BotState.hs index 5f4ad46..85869b2 100644 --- a/src/BotState.hs +++ b/src/BotState.hs @@ -28,6 +28,7 @@ import qualified Database.SQLite.Simple as SQLite import Effect import Markov import Network.HTTP.Simple +import qualified Network.URI.Encode as URI import qualified Sqlite.EntityPersistence as SEP import System.IO import Text.InterpolatedString.QM @@ -185,6 +186,12 @@ applyEffect (botState, Free (RandomMarkov s)) = do let markov = MaybeT $ return $ bsMarkov botState sentence <- runMaybeT (eventsAsText <$> (markov >>= lift . simulate)) return (botState, s sentence) +-- TODO(#601): GetVar Effect is ignored +applyEffect (botState, Free (GetVar _ s)) = return (botState, s Nothing) +applyEffect (botState, Free (CallFun "urlencode" [text] s)) = + return (botState, s $ Just $ T.pack $ URI.encode $ T.unpack text) +-- TODO(#602): CallFun Effect is ignored +applyEffect (botState, Free (CallFun _ _ s)) = return (botState, s Nothing) runEffectIO :: ((a, Effect ()) -> IO (a, Effect ())) -> (a, Effect ()) -> IO a runEffectIO _ (x, Pure _) = return x diff --git a/src/Effect.hs b/src/Effect.hs index 59f8eef..574f2e8 100644 --- a/src/Effect.hs +++ b/src/Effect.hs @@ -25,6 +25,7 @@ module Effect , periodicEffect , twitchCommand , randomMarkov + , callFun ) where import Control.Monad.Catch @@ -103,6 +104,11 @@ data EffectF s [T.Text] s | RandomMarkov (Maybe T.Text -> s) + | GetVar T.Text + (Maybe T.Text -> s) + | CallFun T.Text + [T.Text] + (Maybe T.Text -> s) deriving (Functor) type Effect = Free EffectF @@ -174,3 +180,6 @@ twitchCommand channel name args = liftF $ TwitchCommand channel name args () randomMarkov :: Effect (Maybe T.Text) randomMarkov = liftF $ RandomMarkov id + +callFun :: T.Text -> [T.Text] -> Effect (Maybe T.Text) +callFun name args = liftF $ CallFun name args id diff --git a/src/Transport/Twitch.hs b/src/Transport/Twitch.hs index fa33217..50a0300 100644 --- a/src/Transport/Twitch.hs +++ b/src/Transport/Twitch.hs @@ -83,28 +83,29 @@ receiveLoop conf incoming ircConn = do print cookedMsg case cookedMsg of (Ping xs) -> sendMsg ircConn (ircPong xs) - (Privmsg userInfo target msgText) -> - atomically $ - writeTQueue incoming $ - InMsg $ - Message - Sender - { senderName = name - , senderDisplayName = displayName - , senderChannel = TwitchChannel $ idText target - , senderRoles = - catMaybes - [ TwitchSub <$ find (T.isPrefixOf "subscriber") badges - , TwitchMod <$ find (T.isPrefixOf "moderator") badges - , TwitchBroadcaster <$ - find (T.isPrefixOf "broadcaster") badges - , toMaybe TwitchBotOwner (name == tpOwner conf) - ] + (Privmsg userInfo target msgText) + | T.toLower (tpNick conf) /= T.toLower (idText $ userNick userInfo) -> + atomically $ + writeTQueue incoming $ + InMsg $ + Message + Sender + { senderName = name + , senderDisplayName = displayName + , senderChannel = TwitchChannel $ idText target + , senderRoles = + catMaybes + [ TwitchSub <$ find (T.isPrefixOf "subscriber") badges + , TwitchMod <$ find (T.isPrefixOf "moderator") badges + , TwitchBroadcaster <$ + find (T.isPrefixOf "broadcaster") badges + , toMaybe TwitchBotOwner (name == tpOwner conf) + ] -- TODO(#468): Twitch does not provide the id of the user - , senderId = "" - } - (T.toLower (tpNick conf) `T.isInfixOf` T.toLower msgText) - msgText + , senderId = "" + } + (T.toLower (tpNick conf) `T.isInfixOf` T.toLower msgText) + msgText where name = idText $ userNick userInfo displayName = maybe name valueOfTag $