Joscha
133152286e
I'm just committing all unstaged files so they don't get lost when I delete this repo.
111 lines
3.4 KiB
Haskell
111 lines
3.4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Haboli.Euphoria.WegaBorad where
|
|
|
|
import Control.Monad
|
|
import Control.Monad.Trans.Class
|
|
import Control.Monad.Trans.State
|
|
import Data.Char
|
|
import Data.Foldable
|
|
import Data.List
|
|
import qualified Data.Map.Strict as Map
|
|
import qualified Data.Text as T
|
|
import Haboli.Euphoria.Api
|
|
import Haboli.Euphoria.Client
|
|
|
|
{- Range stuff -}
|
|
|
|
data Range = Range Char Char
|
|
deriving (Eq)
|
|
|
|
instance Show Range where
|
|
show (Range a b)
|
|
| a == b = [a]
|
|
| otherwise = "[" ++ [a] ++ ".." ++ [b] ++ "]"
|
|
|
|
letterRange :: Char -> Char -> Range
|
|
letterRange a b =
|
|
let realA = chr $ max (ord 'a') $ min (ord 'z') $ ord a
|
|
realB = chr $ max (ord 'a') $ min (ord 'z') $ ord b
|
|
in Range realA realB
|
|
|
|
fullRange :: Range
|
|
fullRange = Range 'a' 'z'
|
|
|
|
getRangeChar :: Range -> Maybe Char
|
|
getRangeChar (Range a b)
|
|
| a == b = Just a
|
|
| otherwise = Nothing
|
|
|
|
splitRange :: Int -> Range -> [Range]
|
|
splitRange steps (Range a b) =
|
|
let amount = ord b - ord a + 1
|
|
width = amount `div` steps
|
|
leftover = amount `mod` steps
|
|
widths = zipWith (+) (replicate steps width) (replicate leftover 1 ++ repeat 0)
|
|
skips = scanl (+) 0 (init widths)
|
|
in nub $ zipWith (\s w -> letterRange (chr $ ord a + s) (chr $ ord a + s + w - 1)) skips widths
|
|
|
|
{- Bot logic -}
|
|
|
|
data Search = Search
|
|
{ searchStartMsg :: Message
|
|
, searchOptions :: Map.Map Snowflake Range
|
|
} deriving (Show)
|
|
|
|
data MyState = MyState
|
|
{ msSplitInto :: Int
|
|
, msCurrentSearch :: Maybe Search
|
|
} deriving (Show)
|
|
|
|
defaultState :: MyState
|
|
defaultState = MyState 3 Nothing
|
|
|
|
type MyClient a = StateT MyState (Client ()) a
|
|
|
|
wegaBot :: MyClient ()
|
|
wegaBot = forever $ do
|
|
event <- lift $ respondingToPing nextEvent
|
|
case event of
|
|
EventSnapshot _ -> void $ lift $ nick "WegaBot"
|
|
EventSend e -> onMessage (sendMessage e)
|
|
_ -> pure ()
|
|
|
|
runWegaBot :: MyState -> MyClient a -> Client () a
|
|
runWegaBot start bot = fst <$> runStateT bot start
|
|
|
|
onMessage :: Message -> MyClient ()
|
|
onMessage msg
|
|
| msgContent msg == "!wega" = startNewWega msg
|
|
| otherwise = do
|
|
s <- get
|
|
for_ (msCurrentSearch s) $ \search -> do
|
|
let maybeRange = do
|
|
parent <- msgParent msg
|
|
searchOptions search Map.!? parent
|
|
for_ maybeRange $ closeInOn search msg
|
|
|
|
startNewWega :: Message -> MyClient ()
|
|
startNewWega msg = do
|
|
startMsg <- lift $ reply msg "New character!"
|
|
closeInOn (Search msg Map.empty) startMsg fullRange
|
|
|
|
-- | @'closeInOn' search msg range@ closes in on the currently running @search@,
|
|
-- where @msg@ has just selected @range@.
|
|
closeInOn :: Search -> Message -> Range -> MyClient ()
|
|
closeInOn search msg range =
|
|
case getRangeChar range of
|
|
Just char -> do
|
|
void $ lift $ reply msg $ "You've selected " <> T.pack (show char)
|
|
startNewWega $ searchStartMsg search
|
|
Nothing -> do
|
|
s <- get
|
|
let possibleRanges = splitRange (msSplitInto s) range
|
|
rangesWithMessageIds <- mapM (sendRange msg) possibleRanges
|
|
let options = Map.fromList rangesWithMessageIds
|
|
put s{msCurrentSearch = Just search{searchOptions = options}}
|
|
|
|
sendRange :: Message -> Range -> MyClient (Snowflake, Range)
|
|
sendRange msg range = do
|
|
msg' <- lift $ reply msg $ "Reply to this message to choose " <> T.pack (show range) <> "."
|
|
pure (msgId msg', range)
|