diff --git a/CHANGELOG.md b/CHANGELOG.md index 501024a..f6c14b0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,7 @@ # Changelog for haboli ## upcoming +- add `Haboli.Euphoria.Botrulez` module - add `Haboli.Euphoria.Command` module and submodules - add `Haboli.Euphoria.Listing` module - add `Haboli.Euphoria.Util` module and move `respondingToPing` there diff --git a/haboli.cabal b/haboli.cabal index 772eb06..52f2eac 100644 --- a/haboli.cabal +++ b/haboli.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 15fd0a6cea4710f753e56b5d0232a7986b434e5fab8fee7855e81e311f87499c +-- hash: ae5e8a6e8abe1ff515797a54dfa9acd185df7699102b31190d569ccfe3a693f8 name: haboli version: 0.3.1.0 @@ -31,6 +31,7 @@ library exposed-modules: Haboli.Euphoria Haboli.Euphoria.Api + Haboli.Euphoria.Botrulez Haboli.Euphoria.Client Haboli.Euphoria.Command Haboli.Euphoria.Command.Megaparsec diff --git a/src/Haboli/Euphoria/Botrulez.hs b/src/Haboli/Euphoria/Botrulez.hs new file mode 100644 index 0000000..09deb05 --- /dev/null +++ b/src/Haboli/Euphoria/Botrulez.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Haboli.Euphoria.Botrulez + ( botrulezPingGeneral + , botrulezPingSpecific + , botrulezHelpGeneral + , botrulezHelpSpecific + , botrulezUptimeSpecific + , botrulezKillSpecific + ) where + +import Control.Monad +import Control.Monad.IO.Class +import qualified Data.Text as T +import Data.Time + +import Haboli.Euphoria.Api +import Haboli.Euphoria.Client +import Haboli.Euphoria.Command +import Haboli.Euphoria.Command.Simple +import Haboli.Euphoria.Util + +botrulezPingGeneral :: Command e +botrulezPingGeneral = cmdGeneral "ping" $ \msg -> + void $ reply msg "Pong!" + +botrulezPingSpecific :: T.Text -> Command e +botrulezPingSpecific name = cmdSpecific "ping" name $ \msg -> + void $ reply msg "Pong!" + +botrulezHelpGeneral :: T.Text -> Command e +botrulezHelpGeneral help = cmdGeneral "help" $ \msg -> + void $ reply msg help + +botrulezHelpSpecific :: T.Text -> T.Text -> Command e +botrulezHelpSpecific name help = cmdSpecific "help" name $ \msg -> + void $ reply msg help + +botrulezUptimeSpecific :: T.Text -> UTCTime -> Command e +botrulezUptimeSpecific name since = cmdSpecific "uptime" name $ \msg -> do + now <- liftIO getCurrentTime + let delta = diffUTCTime now since + void $ reply msg $ mconcat + [ "/me has been up since " + , formatUTCTime since + , " UTC (" + , formatNominalDiffTime delta + , ")" + ] + +botrulezKillSpecific :: T.Text -> Command T.Text +botrulezKillSpecific name = cmdSpecific "kill" name $ \msg -> do + void $ reply msg "/me dies" + throw $ "I was killed by " <> svNick (msgSender msg) diff --git a/src/Haboli/Euphoria/ExampleBot.hs b/src/Haboli/Euphoria/ExampleBot.hs index 3929499..cc69862 100644 --- a/src/Haboli/Euphoria/ExampleBot.hs +++ b/src/Haboli/Euphoria/ExampleBot.hs @@ -8,14 +8,18 @@ module Haboli.Euphoria.ExampleBot ) where import Control.Monad +import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.State import qualified Data.Text as T +import Data.Time import Haboli.Euphoria +import Haboli.Euphoria.Botrulez -newtype BotState = BotState - { botListing :: Listing +data BotState = BotState + { botStartTime :: UTCTime + , botListing :: Listing } deriving (Show) type Bot = StateT BotState (Client T.Text) @@ -26,23 +30,26 @@ type Bot = StateT BotState (Client T.Text) -- > runClient defaultConfig $ exampleBot Nothing exampleBot :: Maybe T.Text -> Client T.Text () exampleBot mPasswd = do + startTime <- liftIO getCurrentTime initialEvents <- untilConnected $ respondingToBounce mPasswd $ respondingToPing nextEvent listing <- preferNick "ExampleBot" $ newListing initialEvents - void $ runStateT botMain $ BotState listing + void $ runStateT botMain $ BotState startTime listing botMain :: Bot () botMain = forever $ do s <- get let name = svNick $ self $ botListing s lift $ respondingToCommands - [ cmdGeneral "ping" $ \msg -> void $ reply msg "Pong!" - , cmdSpecific "ping" name $ \msg -> void $ reply msg "Pong!" - , cmdSpecific "help" name $ \msg -> - void $ reply msg "I am an example bot for https://github.com/Garmelon/haboli/." - , cmdSpecific "kill" name $ \msg -> do - void $ reply msg "/me dies" - throw $ "I was killed by " <> svNick (msgSender msg) + [ botrulezPingGeneral + , botrulezPingSpecific name + , botrulezHelpSpecific name "I am an example bot for https://github.com/Garmelon/haboli/." + , botrulezUptimeSpecific name $ botStartTime s + , botrulezKillSpecific name + , cmdGeneral "hello" $ \msg -> + void $ reply msg $ "Hi there, " <> nickMention (svNick $ msgSender msg) <> "!" + , cmdSpecific "hug" name $ \msg -> + void $ reply msg "/me hugs back" ] $ respondingToPing nextEvent diff --git a/src/Haboli/Euphoria/Util.hs b/src/Haboli/Euphoria/Util.hs index 1da51a8..95cd835 100644 --- a/src/Haboli/Euphoria/Util.hs +++ b/src/Haboli/Euphoria/Util.hs @@ -1,9 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} module Haboli.Euphoria.Util - ( + ( formatUTCTime + , formatNominalDiffTime -- * Events - respondingToPing + , respondingToPing , respondingToBounce , respondingToBounce' , untilConnected @@ -20,10 +21,27 @@ import Data.Char import Data.Function import qualified Data.Set as Set import qualified Data.Text as T +import Data.Time import Haboli.Euphoria.Api import Haboli.Euphoria.Client +formatUTCTime :: UTCTime -> T.Text +formatUTCTime t = T.pack $ formatTime defaultTimeLocale "%F %T" t + +formatNominalDiffTime :: NominalDiffTime -> T.Text +formatNominalDiffTime t = T.intercalate " " $ map T.pack $ concat + [ [show days ++ "d" | days /= 0] + , [show hours ++ "h" | hours /= 0] + , [show minutes ++ "m" | minutes /= 0] + , [show seconds ++ "s"] + ] + where + totalSeconds = round $ nominalDiffTimeToSeconds t :: Integer + (days, secondsAfterDays) = totalSeconds `quotRem` (60 * 60 * 24) + (hours, secondsAfterHours) = secondsAfterDays `quotRem` (60 * 60) + (minutes, seconds) = secondsAfterHours `quotRem` 60 + {- Events -} -- | Respond to 'EventPing's according to the documentation (see