(#560) Implement !urlencode command

HyperNerd.cabal

@@ -78,6 +78,7 @@ executable HyperNerd
                      , Bot.Twitch
                      , Bot.Variable
                      , Bot.Calc
+                     , Bot.Expr
                      , BotState
                      , Command
                      , Config

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)
 

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

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

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

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

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 $