fatherjackbot/fatherjack.hs

-- the comments are all outta wack too.

--important, reminder, Digit ! This is stage4 type, not stage 3 type.
--  therefor, mind your pastes from type 3 to type 4 need the " h" taken out of equations

-- This is the Father Jack version of daskeb (digit's haskell bot).
-- in this version
-- its sole feature is to answer any question with:
-- "Yes."
-- or ... 
-- "That would be an ecumenical matter."

import Data.List
import Network
import System.IO
import System.Exit
import Control.Arrow
import Control.Monad.Reader
import Control.Exception
import Text.Printf
import System.Random  -- import random, it said, surely they meant import Random, trying System.Random
       
--server = "irc.freenode.org"
server = "irc.libera.chat"
port   = 6667
--chan   = "#fatherjack"
--chan   = "#ss-nsfw"
--chan   = "#systemcrafters"
--chan   = "#gentoo-weed"
--chan   = "#akashicwhatever"
chan   = "##?"
--chan   = "#cow"
--chan   = "#botwar" 
--chan   = "#librespeech" -- :strontium.libera.chat 480 FatherJack #librespeech :Cannot join channel (+S) - SSL/TLS required 
--chan   = "##spiritscience"
--chan   = "##philosophy" --blocked
--chan   = "##"
----------------------------chan   = "#dbtfc"
--chan   = "#muhcows"
--chan   = "#twocows"
nick   = "FatherJack"
 
-- The 'Net' monad, a wrapper over IO, carrying the bot's immutable state.
type Net = ReaderT Bot IO
data Bot = Bot { socket :: Handle }
 
-- Set up actions to run on start and end, and run the main loop
main :: IO ()
main = bracket connect disconnect loop
  where
    disconnect = hClose . socket
    loop st    = runReaderT run st
 
-- Connect to the server and return the initial bot state
connect :: IO Bot
connect = notify $ do
    h <- connectTo server (PortNumber (fromIntegral port))
    hSetBuffering h NoBuffering
    return (Bot h)
  where
    notify a = bracket_
        (printf "Connecting to %s ... " server >> hFlush stdout)
        (putStrLn "done.")
        a
 
-- We're in the Net monad now, so we've connected successfully
-- Join a channel, and start processing commands
run :: Net ()
run = do
    write "NICK" nick
    write "USER" (nick++" 0 * :DigitsHaskellBot")
    write "JOIN" chan
    asks socket >>= listen
 
-- Process each line from the server
listen :: Handle -> Net ()
listen h = forever $ do
    s <- init `fmap` io (hGetLine h)
    io (putStrLn s)
    if ping s then pong s else eval (clean s)
  where
    forever a = a >> forever a
    clean     = drop 1 . dropWhile (/= ':') . drop 1
    ping x    = "PING :" `isPrefixOf` x
    pong x    = write "PONG" (':' : drop 6 x)

---- this is/was/willbe another way of doing it, with the randomised either answer.
--let ecumenical = ["yes","that would be an ecumenical matter."]
--let ecumenical = [("yes"),("that would be an ecumenical matter.")]
--ecumenical = [("yes"),("that would be an ecumenical matter.")]
-- oh oh array! lets try that!
--ecumenical = array (1, 3) [(1, "yes"),(2, "that would be an ecumenical matter."),(3, "drink!")]

-- Dispatch a command
eval :: String -> Net ()

---- fatherjackbot:
-- /THE/ FEATURE:
----iwishthisworkedsosomplesomethinglikesthis----eval x | "?" `isSuffixOf` x = privmsg (if "what""who""how""why""where""when" `isInfixOf` x then "that would be an ecumenical matter" else "yes")
-- with a little help: https://stackoverflow.com/questions/56944717/how-can-i-make-the-target-of-a-conditional-be-any-of-many-search-for-any-of-a-l/56944826#56944826 
--interrogatives = ["what", "who", "how", "why", "where", "when"]
--eval x | "?" `isSuffixOf` x = privmsg (if any (`isInfixOf` x) interrogatives then "that would be an ecumenical matter" else "yes")
--
--riddances = ["stfu", "shut up", "go away", "be quiet", "stop that", "enough", "!", "rage", "please stop", "Hush", "hush", "HUSH", "quiet you", "Quiet you", "QUIET", "please segfault", "segfault please", "fuckoff", "feckoff", "fuck off", "feck off", "fek off", "fekoff", "gtf", "please leave"] --standard
riddances = ["stfu", "shut up", "go away", "be quiet", "stop that", "enough", "!!!", "rage", "please stop", "Hush", "hush", "HUSH", "quiet you", "Quiet you", "QUIET", "please segfault", "segfault please", "fuckoff", "feckoff", "fuck off", "feck off", "fek off", "fekoff", "gtf", "please leave"] --hardcore
-----
-------------
------------------------
-----------------------------------
--------------------------------------------------------------
--interrogatives = ["what", "who", "how", "why", "where", "when", "which", " or ", "What", "Who", "How", "Why", "Where", "When", "Which", "Or ", "WHAT", "WHO", "HOW", "WHY", "WHERE", "WHEN", "WHICH", " OR "]
interrogatives = ["wat", "what", "who", "how", "why", "where", "when", "which", " or ", "wtf", "What", "Who", "How", "Why", "Where", "When", "Which", "Or ", "WHAT", "WHO", "HOW", "WHY", "WHERE", "WHEN", "WHICH", " OR ", "WTF"]
--
-- suffix   (use me, i worked fine!)
eval x | "?" `isSuffixOf` x = privmsg (if any (`isInfixOf` x) interrogatives then "that would be an ecumenical matter" else "yes")
--
-- infix   (testing)  ... dangerously irritating, triggered by many urls.
--eval x | "?" `isInfixOf` x = privmsg (if any (`isInfixOf` x) interrogatives then "that would be an ecumenical matter" else "yes")
--
--eval x | "?" `isSuffixOf` x = privmsg (if any (`isInfixOf` x) interrogatives then "that would be an ecumenical matter" else "yes")
--

---------------------------------------------
-------------------------------------------
-----------------------------------
---------------------------
-------------------
-------------
-----
-- old prior scraps, kept here for elucidation of simpler forms
--eval x | "?" `isSuffixOf` x = privmsg (if "FatherJackBot:" `isPrefixOf` x then "that would be an ecumenical matter" else "yes") -- well at least this one works.
--eval x | "?" `isInfixOf` x = privmsg (if "FatherJackBot:" `isPrefixOf` x then "That would be an ecumenical matter." else "Yes.") -- well at least this one works.

-- THE /ANTI/-FEATURE:
eval x | "drink" `isInfixOf` x = privmsg (if "FatherJack:" `isPrefixOf` x then "glug glug glug" else "DRINK!")
eval x | "Drink" `isInfixOf` x = privmsg (if "FatherJack:" `isPrefixOf` x then "glug glug glug" else "DRINK!")
eval x | "drink" `isInfixOf` x = privmsg (if "gives FatherJack" `isInfixOf` x then "glug glug glug" else "DRINK!")
eval x | "Drink" `isInfixOf` x = privmsg (if "givevs FatherJack" `isPrefixOf` x then "glug glug glug" else "DRINK!")

-- ( THE OTHER /ANTI/-FEATURES: ) e.g.
eval x | "Gerls!" `isInfixOf` x = privmsg (if "Fek!" `isInfixOf` x then "glug glug glug" else "DRINK!")
-- but make these several arrays.  gerls|Gerls|GERLS|girls|Girls|GIRLS etc and fek|Fek|FEK|feck|Feck|FECK etc etc.

-- SAFETY DE-ANNOYANCE FEATURE
--courtesy extra features: stfu & leave (/gtfo).
-- the stfu feature is still in development
       -- current form, leaves if told to stfu directly.
         -- next intended dev goal: have gtfo > leave, and stfu > unresponsive mode
           -- (considering simply having gives drink be what makes fatherted go into stfu mode)
           -- (also considering having stfu include an optional timer, rather than toggle.)
--eval x | "stfu" `isInfixOf` x = (if "FatherJackBot:" `isPrefixOf` x then write "QUIT" ":Exiting" >> io (exitWith ExitSuccess) else privmsg "hrm")
--
-- this version works great   ----- or did i break it again, doh.
--
--eval x | "STFU!" `isInfixOf` x = (if "FatherJackBot:" `isPrefixOf` x then write "QUIT" ":Exiting" >> io (exitWith ExitSuccess) else return())
--
-- but i'm going to have a go putting in an aray like before.
--
--riddances = ["stfu", "shut up", "go away", "be quiet", "stop that", "enough", "!", "rage", "please stop"]
--eval x | "!!!" `isInfixOf` x = privmsg (if any (`isInfixOf` x) riddances then write "QUIT" ":Exiting" >> io (exitWith ExitSuccess) else return())
--desperate stab in the dark...
--works but multiple declarations of eval... hrmmm
eval x | "FatherJack" `isInfixOf` x = (if any (`isInfixOf` x) riddances then write "QUIT" ":Exiting" >> io (exitWith ExitSuccess) else return())
--"that would be an ecumenical matter" else "yes")
--
-- TEMPORARY, For Morlog:
eval ".seen wal" = privmsg ("no morlog, we've not seen em yet.  keep looking.")
--tbd: also, "i'm SO, SO sorry.   :E :E :E" said before quitting...?  it does take jack out of the well trained mode of that episode with the cardinals.  twas sarcastic sorry to bishop brennan when he did that.
--old basic leave, straight n clean, for reference: 
eval     "!leave"               = write "QUIT" ":Exiting" >> io (exitWith ExitSuccess)

-- WEBSEARCH FEATURE
eval x | "!search " `isPrefixOf` x = privmsg ("https://lmddgtfy.net/?q=" ++ (drop 8 x) ++ " ok?") -- added this back in to be useful.

-- PARROT FEATURE
eval x | "!repeat " `isPrefixOf` x = privmsg (drop 8 x) -- commented this out to minimise abuse

eval     _                     = return () -- ignore everything else
 
-- Send a privmsg to the current chan + server
privmsg :: String -> Net ()
privmsg s = write "PRIVMSG" (chan ++ " :" ++ s)
 
-- Send a message out to the server we're currently connected to
write :: String -> String -> Net ()
write s t = do
    h <- asks socket
    io $ hPrintf h "%s %s\r\n" s t
    io $ printf    "> %s %s\n" s t
 
-- Convenience.
io :: IO a -> Net a
io = liftIO