dbls/bots/dbri.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 BedrockLinux info version of daskeb (digit's haskell bot).
--       ____        __
--   ___/ / /_______/_/
--  / _  /  _  / __/ /
-- /____/_____/_/ /_/
--
-- digit's bedrock
-- info bot, dbri

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   = "##bedrock-treehouse"
nick   = "dbri"
 
-- 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)

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

-- -- extra features
-- list of exit commands, in case of annoyance/abuse.
riddances = ["exit", "quit", "stop", "mute", "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", "leave", "annoying", "anoying"]
-- -- features in dev
-- for dbribot, can haz tuples
--interrogatives = ["bipity", "bopity"] --for testing purposes only.
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 "]
--eval x | "?" `isSuffixOf` x = privmsg (if any (`isInfixOf` x) interrogatives then "that would be an ecumenical matter" else "yes")
-- idea for dbribot is a list of commands to call forth basic 
--eval x | "~" `isPrefixOf` x = privmsg (if any (`isInfixOf` x) interrogatives then "here i'd execute the relevant command/tuple for $interrogatives" else "idk about that yet")
--eval x | "?" `isSuffixOf` x = privmsg (if any (`isInfixOf` x) interrogatives then "that would be an ecumenical matter" else "yes")
--
-- -------------------------------------------------------------------------------------------

-- another way of grouping multiple commands... (needs work so can neatly have all commands contained in one eval, following the command character, e.g. "~")
-- from -- --eval x | "!bedrock" `isInfixOf` x = privmsg (if "FatherJack:" `isPrefixOf` x then "glug glug glug" else "DRINK!")
--
-- homepage = ["bedrock", "website"]
------eval x | homepage `isPrefixOf` x =  privmsg "https://bedrocklinux.org/"
-------eval x | homepage `isPrefixOf` x = privmsg (if any (`isInfixOf` x) homepage then "https://bedrocklinux.org/" else "idk about that yet")
-- eval x | "~" `isPrefixOf` x = privmsg (if any (`isInfixOf` x) homepage then "https://bedrocklinux.org/" else "idk about that yet")

-- -------------------------------------------------------------------------------------------
-- -------------------------------------------------------------------------------------------

--
--------------------------------------
----------------------------------------------------------------------------
------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------------------------------
-- ---------------------------------------------------------------------------------------- -----\\\\\\\\\\\\-------------------------------
--                                                                                          ------\\\      \\\------------------------------
-- ____ ** ------------------------------------------------------------------------ ** ____ -------\\\      \\\-----------------------------
-- __** --                                                                             **__ --------\\\      \\\\\\\\\\\\\\\\\--------------
-- _** --  _____      ____      _____      _ _        _   _____      ____      _____    **_ ---------\\\                    \\\-------------
-- _** -- |___\ \    / /\ \    / /___|  __| | |__ _ _(_) |___\ \    / /\ \    / /___|   **_ ----------\\\                    \\\------------
-- _** --      \ \  | |  | |  / /      / _` | '_ \ '_| |      \ \  | |  | |  / /        **_ -----------\\\        ______      \\\-----------
-- _** --       \_\_| |  | |_/_/       \__,_|_.__/_| |_|       \_\_| |  | |_/_/         **_ ------------\\\                   ///-----------
-- _** --        |___\_\/_/___|  GPL digit's bedrock info bot.  |___\_\/_/___|          **_ -------------\\\                 ///------------
-- _** --                                                                               **_ --------------\\\               ///-------------
-- __** --                                                                             **__ ---------------\\\////////////////--------------
-- ____ ** ------------------------------------------------      -----------------  ** ____ -- __          __             __       ---------
--                                                       ----      ----                     -- \ \_________\ \____________\ \___   ---------
-- ------------------------------------------------------------      -------------------------  \  _ \  _\ _  \  _\ __ \ __\   /   ---------
-- --------------------------------------------------------------      -----------------------   \___/\__/\__/ \_\ \___/\__/\_\_\  ---------
-- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----      for 0.7 ( poki )                             BedrockLinux ---------
-- -----------------------------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------------------------------
-- dbri

-- INDEX/HELP/CONTENTS/COMMANDSLIST
eval x | "!help" `isPrefixOf` x = privmsg "!bedrock !intro !faq !releaseoverview !install !basic !distrocompatibility !featurecompatibility !issues !commands !advanced !debug !addfetch !addpm !addo !beta !version !v | (+!more)"
eval x | "!more" `isPrefixOf` x = privmsg "(in-dev...) terminology/faq: !base !main !tute !concepts !init | bot housekeeping: !leave !version !dbri !about | etc: !search | temp issues: !grub !btrfs !zfs !grub+btrfs !fonts"
eval x | "!concepts" `isPrefixOf` x = privmsg "!concepts : !basic : !local !global " -- !misconcepts: !base&!main ?  or rephrase as a !nobase ?

-- INFO FEATURE
-- INFO PAGES
--eval x | "~" `isPrefixOf` x = privmsg (if any (`isInfixOf` x) homepage then "https://bedrocklinux.org/")
-- BEDROCK
eval x | "!bedrock" `isPrefixOf` x = privmsg "https://bedrocklinux.org/"
-- INTRODUCTORY MATERIAL
eval x | "!intro" `isPrefixOf` x = privmsg "https://bedrocklinux.org/introduction.html"
eval x | "!faq" `isPrefixOf` x = privmsg "https://bedrocklinux.org/faq.html"
-- 0.7
--
eval x | "!0.7" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/index.html"
eval x | "!releaseoverview" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/index.html"
eval x | "!install" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/installation-instructions.html"
eval x | "!basic" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/basic-usage.html" -- + see:"-- FURTHER BASIC INFO (subsections ..."
---- LIMITATIONS
eval x | "!distrocompatibility" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/distro-compatibility.html"
eval x | "!featurecompatibility" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/feature-compatibility.html"
eval x | "!issues" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/known-issues.html grub&btrfs: https://bedrocklinux.org/0.7/feature-compatibility.html#grub-btrfs-zfs "
eval x | "!grub+btrfs" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/feature-compatibility.html#grub-btrfs-zfs This will cause boot failures.  Until this is resolved, it is strongly recommended not to use Bedrock, GRUB, and BTRFS/ZFS."
eval x | "!commands" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/commands.html"
-- commands
-- 
eval x | "!configuration" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/configuration.html"
eval x | "!advanced" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/workflows.html"
--eval x | "!workflows" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/workflows.html"
-- advanced workflows
-- 
eval x | "!debug" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/debugging.html"
-- extending
eval x | "!addfetch" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/extending.html#brl-fetch-new-distros"
eval x | "!addpm" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/extending.html#pmm-new-package-managers"
eval x | "!addo" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/extending.html#pmm-new-operations"
-- version
eval x | "!beta" `isPrefixOf` x = privmsg "https://bedrocklinux.org/0.7/beta-channel.html"
eval x | "!v" `isPrefixOf` x = privmsg "0.7"
-- FURTHER BASIC INFO (subsections of !basic https://bedrocklinux.org/0.7/basic-usage.html
-- !concepts
--eval x | "!concepts" `isPrefixOf` x = privmsg "!concepts" --
-- global & local
eval x | "!global" `isPrefixOf` x = privmsg " https://bedrocklinux.org/0.7/basic-usage.html#global-file-paths "
eval x | "!local" `isPrefixOf` x = privmsg " https://bedrocklinux.org/0.7/basic-usage.html#local-file-paths "
eval x | "!init" `isPrefixOf` x = privmsg " https://bedrocklinux.org/0.7/basic-usage.html#special-strata https://bedrocklinux.org/0.7/basic-usage.html#removing-strata "
-- /0.7
-- FURTHER INFO ADDITIONS (!more)
-- !tute
eval x | "!tute" `isPrefixOf` x = privmsg "Bedrock has an interactive tutorial you can go thorugh via `brl tutorial basics`.  Consider giving that a go.  It may clarify questions like this."
eval x | "!tutorial" `isPrefixOf` x = privmsg  "Bedrock has an interactive tutorial you can go thorugh via `brl tutorial basics`.  Consider giving that a go.  It may clarify questions like this."
-- base stratum / main stratum 
eval x | "!base" `isPrefixOf` x = privmsg "there is no base distro but bedrock.  the stratum used for install (and defaults to being init stratum), is much like any other strata, and can be removed, or other strata can be switched to init.  think of each strata like equal players on bedrock."
eval x | "!main" `isPrefixOf` x = privmsg "see !base.  similarly, while you're free to think of any of your strata as your main, there's nothing in bedrock insistently making it so."
-- temp issues
-- !grub + !btrfs
eval x | "!grub" `isPrefixOf` x = privmsg " https://bedrocklinux.org/0.7/feature-compatibility.html#grub-btrfs-zfs "
eval x | "!btrfs" `isPrefixOf` x = privmsg " https://bedrocklinux.org/0.7/feature-compatibility.html#grub-btrfs-zfs "
eval x | "!zfs" `isPrefixOf` x = privmsg " https://bedrocklinux.org/0.7/feature-compatibility.html#grub-btrfs-zfs "
eval x | "!fonts" `isPrefixOf` x = privmsg "  fonts across strata are supposed to just-work, but there's an issue with caching that sadly won't be fixed until 0.8.  For now, manually run `strat <stratum> fc-cache -fv` to update the cache.  You may need to do this both as root and non-root. "
---------------------------------------------
---------------------------------------------
---------------------------------------------
---------------------------------------------
-------------------------------------------
-----------------------------------
---------------------------
-------------------
-------------
-----
--
-- // BOT HOUSEKEEPING
eval x | "!version" `isPrefixOf` x = privmsg "This version of Digits BedRock Info bot is for 0.7 https://bedrocklinux.org/0.7/index.html" -- see !v for bedrock version
eval x | "!dbri" `isPrefixOf` x = privmsg "This version of Digits BedRock Info bot is for 0.7 https://bedrocklinux.org/0.7/index.html"
eval x | "!about" `isPrefixOf` x = privmsg "This version of Digits BedRock Info bot is for 0.7 https://bedrocklinux.org/0.7/index.html"
eval x | "!source" `isPrefixOf` x = privmsg "https://notabug.org/Digit/dbls/src/master/bots/dbri.hs"
-- EXIT FEATURE
--old basic leave, straight n clean, for reference: 
eval     "!leave"               = write "QUIT" ":Exiting" >> io (exitWith ExitSuccess)
-- RIDDANCE FEATURE
-- issues any of the exit commands if dbri is mentioned with them, in case of annoyance/abuse.
--disabled while fatherjack feature is addressing dbri directly.  -- need get this into the one "eval x | "dbri" for when being spoken to, to fathom the if/thens.   ... fuckit... disable the riddances for now.  keep directaddressingfatherjackmode on for testing/dev purposes.
eval x | "dbri" `isInfixOf` x = (if any (`isInfixOf` x) riddances then write "QUIT" ":Exiting" >> io (exitWith ExitSuccess) else return())
--

-- 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) -- comment out to minimise a11buse

-- FATHERJACK FEATURE -- as currently is at time of writing, can only have one eval x | dbri.  jack or exit... your choice.
--(... is that a case of simply needing use something other than x?, ~(izata calda "scope colision" or summin?))
--    ... shud be able to suss how to ifif or something to mend that... when brain switched on.   for goodness sake, dont commit with this bilge still here...
-- or, i need be savvy and move this into the one "eval x | "dbri" for when being spoken to, to fathom the if/thens.   ... fuckit... disable the riddances for now.  keep this for testing/dev purposes.  --- noh, leave the riddances, on.  " riddances more important than jack feature.  leaving as is (with commenting).   until i suss a way to get them merged into one.... like the if statements not already clunky, heh."
--eval x | "dbri:" `isPrefixOf` x = privmsg (if any (`isInfixOf` x) interrogatives then "that would be an ecumenical matter" else "yes")

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