[testbot] Create testbot for future testing endavours
This commit is contained in:
parent
49efa94331
commit
6c28d16a6e
6 changed files with 165 additions and 0 deletions
1
haboli-testbot/README.md
Normal file
1
haboli-testbot/README.md
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
# haboli-testbot
|
||||||
9
haboli-testbot/app/Main.hs
Normal file
9
haboli-testbot/app/Main.hs
Normal file
|
|
@ -0,0 +1,9 @@
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
|
|
||||||
|
import Haboli.Bots.TestBot
|
||||||
|
import Haboli.Euphoria
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = void $ runClient defaultConfig $ testBot Nothing
|
||||||
58
haboli-testbot/haboli-testbot.cabal
Normal file
58
haboli-testbot/haboli-testbot.cabal
Normal file
|
|
@ -0,0 +1,58 @@
|
||||||
|
cabal-version: 1.12
|
||||||
|
|
||||||
|
-- This file has been generated from package.yaml by hpack version 0.31.2.
|
||||||
|
--
|
||||||
|
-- see: https://github.com/sol/hpack
|
||||||
|
--
|
||||||
|
-- hash: c59191837f2f234376576136c23122cdc5288703e37b782ee1908d225e22dcee
|
||||||
|
|
||||||
|
name: haboli-testbot
|
||||||
|
version: 0.1.0.0
|
||||||
|
synopsis: A bot used for testing small things
|
||||||
|
description: See <https://github.com/Garmelon/haboli-bot-collection/haboli-testbot#readme>
|
||||||
|
homepage: https://github.com/Garmelon/haboli-bot-collection#readme
|
||||||
|
bug-reports: https://github.com/Garmelon/haboli-bot-collection/issues
|
||||||
|
author: Garmelon <joscha@plugh.de>
|
||||||
|
maintainer: Garmelon <joscha@plugh.de>
|
||||||
|
copyright: 2020 Garmelon
|
||||||
|
license: MIT
|
||||||
|
build-type: Simple
|
||||||
|
extra-source-files:
|
||||||
|
README.md
|
||||||
|
|
||||||
|
source-repository head
|
||||||
|
type: git
|
||||||
|
location: https://github.com/Garmelon/haboli-bot-collection
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules:
|
||||||
|
Haboli.Bots.TestBot
|
||||||
|
other-modules:
|
||||||
|
Paths_haboli_testbot
|
||||||
|
hs-source-dirs:
|
||||||
|
src
|
||||||
|
build-depends:
|
||||||
|
base >=4.7 && <5
|
||||||
|
, containers
|
||||||
|
, haboli
|
||||||
|
, microlens-platform
|
||||||
|
, text
|
||||||
|
, time
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable haboli-testbot
|
||||||
|
main-is: Main.hs
|
||||||
|
other-modules:
|
||||||
|
Paths_haboli_testbot
|
||||||
|
hs-source-dirs:
|
||||||
|
app
|
||||||
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
|
build-depends:
|
||||||
|
base >=4.7 && <5
|
||||||
|
, containers
|
||||||
|
, haboli
|
||||||
|
, haboli-testbot
|
||||||
|
, microlens-platform
|
||||||
|
, text
|
||||||
|
, time
|
||||||
|
default-language: Haskell2010
|
||||||
34
haboli-testbot/package.yaml
Normal file
34
haboli-testbot/package.yaml
Normal file
|
|
@ -0,0 +1,34 @@
|
||||||
|
name: haboli-testbot
|
||||||
|
version: 0.1.0.0
|
||||||
|
license: MIT
|
||||||
|
author: Garmelon <joscha@plugh.de>
|
||||||
|
copyright: 2020 Garmelon
|
||||||
|
|
||||||
|
synopsis: A bot used for testing small things
|
||||||
|
description: See <https://github.com/Garmelon/haboli-bot-collection/haboli-testbot#readme>
|
||||||
|
github: Garmelon/haboli-bot-collection
|
||||||
|
|
||||||
|
extra-source-files:
|
||||||
|
- README.md
|
||||||
|
|
||||||
|
dependencies:
|
||||||
|
- base >= 4.7 && < 5
|
||||||
|
- containers
|
||||||
|
- haboli
|
||||||
|
- microlens-platform
|
||||||
|
- text
|
||||||
|
- time
|
||||||
|
|
||||||
|
library:
|
||||||
|
source-dirs: src
|
||||||
|
|
||||||
|
executables:
|
||||||
|
haboli-testbot:
|
||||||
|
main: Main.hs
|
||||||
|
source-dirs: app
|
||||||
|
ghc-options:
|
||||||
|
- -threaded
|
||||||
|
- -rtsopts
|
||||||
|
- -with-rtsopts=-N
|
||||||
|
dependencies:
|
||||||
|
- haboli-testbot
|
||||||
62
haboli-testbot/src/Haboli/Bots/TestBot.hs
Normal file
62
haboli-testbot/src/Haboli/Bots/TestBot.hs
Normal file
|
|
@ -0,0 +1,62 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
|
module Haboli.Bots.TestBot
|
||||||
|
( testBot
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Concurrent
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import Data.Time
|
||||||
|
import Lens.Micro.Platform
|
||||||
|
|
||||||
|
import Haboli.Euphoria
|
||||||
|
import Haboli.Euphoria.Botrulez
|
||||||
|
|
||||||
|
data BotState = BotState
|
||||||
|
{ _botStartTime :: UTCTime
|
||||||
|
, _botListing :: Listing
|
||||||
|
} deriving (Show)
|
||||||
|
|
||||||
|
makeLenses ''BotState
|
||||||
|
|
||||||
|
testBot :: Maybe T.Text -> Client T.Text ()
|
||||||
|
testBot mPasswd = do
|
||||||
|
startTime <- liftIO getCurrentTime
|
||||||
|
initialEvents <- untilConnected $
|
||||||
|
respondingToBounce mPasswd $
|
||||||
|
respondingToPing nextEvent
|
||||||
|
let initialState = BotState startTime $ newListing initialEvents
|
||||||
|
stateVar <- liftIO $ newMVar initialState
|
||||||
|
preferNickVia botListing stateVar "TestBot"
|
||||||
|
botMain stateVar
|
||||||
|
|
||||||
|
botMain :: MVar BotState -> Client T.Text ()
|
||||||
|
botMain stateVar = forever $ do
|
||||||
|
event <- respondingToCommands (getCommands stateVar) $
|
||||||
|
respondingToPing nextEvent
|
||||||
|
updateFromEventVia botListing stateVar event
|
||||||
|
|
||||||
|
longHelp :: T.Text
|
||||||
|
longHelp = T.concat
|
||||||
|
[ "This bot exists to test various things."
|
||||||
|
, "\n"
|
||||||
|
, "\n"
|
||||||
|
, "Made by @Garmy using https://github.com/Garmelon/haboli/."
|
||||||
|
, "\n"
|
||||||
|
, "Source code available at https://github.com/Garmelon/haboli-bot-collection."
|
||||||
|
]
|
||||||
|
|
||||||
|
getCommands :: MVar BotState -> Client e [Command T.Text]
|
||||||
|
getCommands stateVar = do
|
||||||
|
state <- liftIO $ readMVar stateVar
|
||||||
|
let name = state ^. botListing . lsSelfL . svNickL
|
||||||
|
pure
|
||||||
|
[ botrulezPingGeneral
|
||||||
|
, botrulezPingSpecific name
|
||||||
|
, botrulezHelpSpecific name longHelp
|
||||||
|
, botrulezUptimeSpecific name $ state ^. botStartTime
|
||||||
|
, botrulezKillSpecific name
|
||||||
|
]
|
||||||
|
|
@ -2,6 +2,7 @@ resolver: lts-15.7
|
||||||
|
|
||||||
packages:
|
packages:
|
||||||
- haboli-infobot
|
- haboli-infobot
|
||||||
|
- haboli-testbot
|
||||||
|
|
||||||
extra-deps:
|
extra-deps:
|
||||||
- github: Garmelon/haboli
|
- github: Garmelon/haboli
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue