From ede194c5faf0d303b75774c751253a7ad84be810 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 01:36:28 +0700 Subject: [PATCH 01/12] (#560) Introduce Bot.Expr --- HyperNerd.cabal | 1 + src/Bot/CustomCommand.hs | 1 + src/Bot/Expr.hs | 17 +++++++++++++++++ 3 files changed, 19 insertions(+) create mode 100644 src/Bot/Expr.hs 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/CustomCommand.hs b/src/Bot/CustomCommand.hs index 448b854..e089024 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: 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..cf4fa90 --- /dev/null +++ b/src/Bot/Expr.hs @@ -0,0 +1,17 @@ +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: parseExprs is not implemented +parseExprs :: T.Text -> Either String [Expr] +parseExprs = undefined + +-- TODO: interpretExprs is not implemented +interpretExprs :: [Expr] -> Effect T.Text +interpretExprs = undefined From 470b0229d138b7a5c658aa34f25b3841aee942ae Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 01:44:43 +0700 Subject: [PATCH 02/12] (#560) Introduce GetVar and CallFun effects --- src/BotState.hs | 6 ++++++ src/Effect.hs | 2 ++ 2 files changed, 8 insertions(+) diff --git a/src/BotState.hs b/src/BotState.hs index 5f4ad46..2eb08e7 100644 --- a/src/BotState.hs +++ b/src/BotState.hs @@ -185,6 +185,12 @@ applyEffect (botState, Free (RandomMarkov s)) = do let markov = MaybeT $ return $ bsMarkov botState sentence <- runMaybeT (eventsAsText <$> (markov >>= lift . simulate)) return (botState, s sentence) +-- TODO: GetVar Effect is ignored +applyEffect (botState, Free (GetVar _ s)) = + return (botState, s Nothing) +-- TODO: 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..75a84dc 100644 --- a/src/Effect.hs +++ b/src/Effect.hs @@ -103,6 +103,8 @@ 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 From a621af2193b16e384d8353a93ca2094bf34fe931 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 01:55:55 +0700 Subject: [PATCH 03/12] (#560) Implement !urlencode command --- src/Bot.hs | 3 +++ src/BotState.hs | 3 +++ src/Effect.hs | 4 ++++ 3 files changed, 10 insertions(+) diff --git a/src/Bot.hs b/src/Bot.hs index 13e0284..add7a2d 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] diff --git a/src/BotState.hs b/src/BotState.hs index 2eb08e7..d587399 100644 --- a/src/BotState.hs +++ b/src/BotState.hs @@ -33,6 +33,7 @@ import System.IO import Text.InterpolatedString.QM import Text.Printf import Transport +import qualified Network.URI.Encode as URI data TransportState = TransportState { csConfig :: Config @@ -188,6 +189,8 @@ applyEffect (botState, Free (RandomMarkov s)) = do -- TODO: 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: CallFun Effect is ignored applyEffect (botState, Free (CallFun _ _ s)) = return (botState, s Nothing) diff --git a/src/Effect.hs b/src/Effect.hs index 75a84dc..811397b 100644 --- a/src/Effect.hs +++ b/src/Effect.hs @@ -25,6 +25,7 @@ module Effect , periodicEffect , twitchCommand , randomMarkov + , callFun ) where import Control.Monad.Catch @@ -176,3 +177,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 From 381133c2f2299d14dd4ae098ce6e6802430fd91c Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:08:43 +0700 Subject: [PATCH 04/12] (#560) Make Twitch transport ignore its own message Bot can hear its own messages when you have two Twitch IRC connections --- src/Transport/Twitch.hs | 43 +++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 21 deletions(-) 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 $ From b419340c0d97573f9412899093c229dfbe26df8e Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:15:55 +0700 Subject: [PATCH 05/12] (#560) strip outputs between pipe chains --- src/Bot.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Bot.hs b/src/Bot.hs index add7a2d..b594861 100644 --- a/src/Bot.hs +++ b/src/Bot.hs @@ -435,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) From b17b4a0d2b08410d252134b1c417cc1be88b972a Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:16:36 +0700 Subject: [PATCH 06/12] (#560) Fix hlint remarks --- src/Bot.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Bot.hs b/src/Bot.hs index b594861..30f39f5 100644 --- a/src/Bot.hs +++ b/src/Bot.hs @@ -308,7 +308,7 @@ builtinCommands = cmapR (T.pack . show) $ Reaction replyMessage)) , ( "urlencode" , ( "!google URL encode" - , liftR (callFun "urlencode" . return) $ ignoreNothing $ sayMessage)) + , liftR (callFun "urlencode" . return) $ ignoreNothing sayMessage)) ] combineDecks :: [a] -> [a] -> [a] From fc7423dd992c3c20e1c56f61a268b1bf51c906cc Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:16:57 +0700 Subject: [PATCH 07/12] (#560) Fix hindent remarks --- src/Bot/Expr.hs | 15 ++++++++++----- src/BotState.hs | 8 +++----- src/Effect.hs | 7 +++++-- 3 files changed, 18 insertions(+), 12 deletions(-) diff --git a/src/Bot/Expr.hs b/src/Bot/Expr.hs index cf4fa90..23b8a11 100644 --- a/src/Bot/Expr.hs +++ b/src/Bot/Expr.hs @@ -1,12 +1,17 @@ -module Bot.Expr (parseExprs, interpretExprs) where +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) +data Expr + = TextExpr T.Text + | FunCallExpr T.Text + [Expr] + | VarExpr T.Text + deriving (Eq, Show) -- TODO: parseExprs is not implemented parseExprs :: T.Text -> Either String [Expr] diff --git a/src/BotState.hs b/src/BotState.hs index d587399..a9fcd34 100644 --- a/src/BotState.hs +++ b/src/BotState.hs @@ -28,12 +28,12 @@ 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 import Text.Printf import Transport -import qualified Network.URI.Encode as URI data TransportState = TransportState { csConfig :: Config @@ -187,13 +187,11 @@ applyEffect (botState, Free (RandomMarkov s)) = do sentence <- runMaybeT (eventsAsText <$> (markov >>= lift . simulate)) return (botState, s sentence) -- TODO: GetVar Effect is ignored -applyEffect (botState, Free (GetVar _ s)) = - return (botState, s Nothing) +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: CallFun Effect is ignored -applyEffect (botState, Free (CallFun _ _ s)) = - return (botState, s Nothing) +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 811397b..574f2e8 100644 --- a/src/Effect.hs +++ b/src/Effect.hs @@ -104,8 +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) + | GetVar T.Text + (Maybe T.Text -> s) + | CallFun T.Text + [T.Text] + (Maybe T.Text -> s) deriving (Functor) type Effect = Free EffectF From ad7be7d591934eba8eadda6aa3334d6bac0671cf Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:18:01 +0700 Subject: [PATCH 08/12] Add TODO(#598) --- src/Bot/CustomCommand.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Bot/CustomCommand.hs b/src/Bot/CustomCommand.hs index e089024..82667d2 100644 --- a/src/Bot/CustomCommand.hs +++ b/src/Bot/CustomCommand.hs @@ -169,7 +169,7 @@ updateCustomCommand builtinCommands = (Nothing, Nothing) -> replyToSender sender [qms|Command '{name}' does not exist|] --- TODO: reimplement expandCustomCommandVars with Bot.Expr when it's ready +-- TODO(#598): reimplement expandCustomCommandVars with Bot.Expr when it's ready expandCustomCommandVars :: Sender -> T.Text -> CustomCommand -> Effect CustomCommand expandCustomCommandVars sender args customCommand = do From 20ce0bc89f9114fe0dc9353c4d46fa9cfdf58489 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:18:03 +0700 Subject: [PATCH 09/12] Add TODO(#599) --- src/Bot/Expr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Bot/Expr.hs b/src/Bot/Expr.hs index 23b8a11..def7436 100644 --- a/src/Bot/Expr.hs +++ b/src/Bot/Expr.hs @@ -13,7 +13,7 @@ data Expr | VarExpr T.Text deriving (Eq, Show) --- TODO: parseExprs is not implemented +-- TODO(#599): parseExprs is not implemented parseExprs :: T.Text -> Either String [Expr] parseExprs = undefined From 55da257324f8466d0a221b0eed871577eb810a0e Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:18:05 +0700 Subject: [PATCH 10/12] Add TODO(#600) --- src/Bot/Expr.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Bot/Expr.hs b/src/Bot/Expr.hs index def7436..99a30d3 100644 --- a/src/Bot/Expr.hs +++ b/src/Bot/Expr.hs @@ -17,6 +17,6 @@ data Expr parseExprs :: T.Text -> Either String [Expr] parseExprs = undefined --- TODO: interpretExprs is not implemented +-- TODO(#600): interpretExprs is not implemented interpretExprs :: [Expr] -> Effect T.Text interpretExprs = undefined From 5a5a3049337b82351ef03df5e164eff41de940de Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:18:06 +0700 Subject: [PATCH 11/12] Add TODO(#601) --- src/BotState.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/BotState.hs b/src/BotState.hs index a9fcd34..b2eb97f 100644 --- a/src/BotState.hs +++ b/src/BotState.hs @@ -186,7 +186,7 @@ applyEffect (botState, Free (RandomMarkov s)) = do let markov = MaybeT $ return $ bsMarkov botState sentence <- runMaybeT (eventsAsText <$> (markov >>= lift . simulate)) return (botState, s sentence) --- TODO: GetVar Effect is ignored +-- 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) From fd9092c1f6ebd971382ecd07898fffb87af9c9a4 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 3 May 2019 02:18:07 +0700 Subject: [PATCH 12/12] Add TODO(#602) --- src/BotState.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/BotState.hs b/src/BotState.hs index b2eb97f..85869b2 100644 --- a/src/BotState.hs +++ b/src/BotState.hs @@ -190,7 +190,7 @@ applyEffect (botState, Free (RandomMarkov s)) = do 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: CallFun Effect is ignored +-- 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