Implement some botrulez

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

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

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)

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
 

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