Add hash map for persisting channel state

Author: tonyd256

docker-compose.yml

@@ -3,6 +3,8 @@ web:
   command: cabal run
   environment:
     SLACK_API_TOKEN: "xoxb-4375956194-kvlljrTk9LWIi5RxhqfrScu4"
+    LONG_ALPHA: 0.2
+    SHORT_ALPHA: 0.8
   stdin_open: true
   tty: true
   volumes:

fomobot.cabal

@@ -34,6 +34,8 @@ executable fomobot
                      , wuss
                      , mtl
                      , monad-loops
+                     , hashmap
+                     , time
 
   hs-source-dirs:      src
   default-language:    Haskell2010

src/FOMObot/App.hs

@@ -6,7 +6,7 @@ import System.Environment (getEnv)
 import Data.Maybe (fromJust)
 import Network.URI (parseURI)
 import Control.Monad.Trans (liftIO)
-import Control.Monad.State (get, modify)
+import Control.Monad.State (get)
 import qualified Data.Text as T
 import Data.List (find)
 
@@ -21,19 +21,20 @@ import FOMObot.Types.BotConfig
 
 runApp :: Bot ()
 runApp = do
-    state <- get
-
     message@Message{..} <- receiveMessage
     printMessage message
+    updateState message
     alertFOMOChannel _text
+    state <- get
     liftIO $ print $ "state: " ++ (show state)
-    modify (+1)
 
 initApp :: IO ()
 initApp = do
     token <- T.pack <$> getEnv "SLACK_API_TOKEN"
     response <- rtmStartResponse token
-    let partialConfig = BotConfig (getFOMOChannelID response) (_selfID response)
+    longAlpha <- read <$> getEnv "LONG_ALPHA"
+    shortAlpha <- read <$> getEnv "SHORT_ALPHA"
+    let partialConfig = BotConfig (getFOMOChannelID response) (_selfID response) longAlpha shortAlpha
     let uri = fromJust $ parseURI $ _url response
     runSecureClient uri partialConfig runApp
     where

src/FOMObot/Helpers/Bot.hs

@@ -3,17 +3,23 @@ module FOMObot.Helpers.Bot
     , printMessage
     , sendMessage
     , alertFOMOChannel
+    , updateState
     ) where
 
 import Control.Monad.Trans (liftIO)
+import Control.Monad.State (modify)
 import Control.Monad.Reader (ask)
 import Control.Monad.Loops (untilJust)
 import Data.Aeson (decode, encode)
+import Data.HashMap (member, insert, adjust)
 import qualified Network.WebSockets as WS
 
 import FOMObot.Types.Message
 import FOMObot.Types.Bot
 import FOMObot.Types.BotConfig
+import FOMObot.Types.ChannelState
+import FOMObot.Helpers.Time
+import FOMObot.Helpers.MovingAverage
 
 receiveMessage :: Bot Message
 receiveMessage = do
@@ -43,3 +49,22 @@ alertFOMOChannel message = (sendMessage message) =<< _channelID <$> ask
 
 connection :: Bot WS.Connection
 connection = _connection <$> ask
+
+updateState :: Message -> Bot ()
+updateState message = modify =<< (alterState message) <$> ask
+
+alterState :: Message -> BotConfig -> BotState -> BotState
+alterState Message{..} config state
+    | member _channel state = adjust (updateChannelState config _ts) _channel state
+    | otherwise = insert _channel newChannelState state
+    where
+        newChannelState = ChannelState 1 0 0 _ts
+
+updateChannelState :: BotConfig -> String -> ChannelState -> ChannelState
+updateChannelState BotConfig{..} ts ChannelState{..} = ChannelState (_count + 1) longAvg shortAvg ts
+    where
+        longAvg = singleExpSmoothing longAlpha _longAvg diff
+        shortAvg = singleExpSmoothing shortAlpha _shortAvg diff
+        longAlpha = realToFrac _longAlpha
+        shortAlpha = realToFrac _shortAlpha
+        diff = diffTime ts _lastTimeStamp 

src/FOMObot/Helpers/MovingAverage.hs

@@ -0,0 +1,6 @@
+module FOMObot.Helpers.MovingAverage
+    ( singleExpSmoothing
+    ) where
+
+singleExpSmoothing :: Num a => a -> a -> a -> a
+singleExpSmoothing alpha avg datum = (1 - alpha) * avg + alpha * datum

src/FOMObot/Helpers/Time.hs

@@ -0,0 +1,12 @@
+module FOMObot.Helpers.Time
+    ( diffTime
+    )where
+
+import Data.Maybe (fromJust)
+import Data.Time (parseTimeM, defaultTimeLocale)
+import Data.Time.Clock (diffUTCTime, NominalDiffTime)
+
+diffTime :: String -> String -> NominalDiffTime
+diffTime ts1 ts2 = fromJust $ diffUTCTime <$> (parse ts1) <*> (parse ts2)
+    where
+        parse = parseTimeM True defaultTimeLocale "%s%Q"

src/FOMObot/Types/Bot.hs

@@ -3,12 +3,16 @@ module FOMObot.Types.Bot where
 import Control.Monad (forever, void)
 import Control.Monad.Reader (ReaderT, runReaderT)
 import Control.Monad.State (StateT, execStateT)
+import Data.HashMap (Map)
 
 import FOMObot.Types.BotConfig
+import FOMObot.Types.ChannelState
 
-type Bot = ReaderT BotConfig (StateT Int IO)
+type BotState = Map String ChannelState
 
-runBot :: Int -> BotConfig -> Bot () -> IO ()
+type Bot = ReaderT BotConfig (StateT BotState IO)
+
+runBot :: BotState -> BotConfig -> Bot () -> IO ()
 runBot initialState config bot = void $ execInitialState $ runReaderT foreverBot config
     where
         foreverBot = forever bot

src/FOMObot/Types/BotConfig.hs

@@ -7,5 +7,7 @@ type PartialConfig = WS.Connection -> BotConfig
 data BotConfig = BotConfig
     { _channelID :: String
     , _botID :: String
+    , _longAlpha :: Double
+    , _shortAlpha :: Double
     , _connection :: WS.Connection
     }

src/FOMObot/Types/ChannelState.hs

@@ -0,0 +1,10 @@
+module FOMObot.Types.ChannelState where
+
+import Data.Time.Clock (NominalDiffTime)
+
+data ChannelState = ChannelState
+    { _count :: Int
+    , _longAvg :: NominalDiffTime
+    , _shortAvg :: NominalDiffTime
+    , _lastTimeStamp :: String
+    } deriving (Show)

src/FOMObot/Websockets.hs

@@ -7,6 +7,7 @@ import Network.URI (URI(..), uriRegName)
 import qualified Wuss
 import qualified Network.WebSockets as WS
 import qualified Data.Text as T
+import Data.HashMap (empty)
 
 import FOMObot.Types.Bot
 import FOMObot.Types.BotConfig
@@ -16,8 +17,8 @@ app partialConfig bot connection = do
     putStrLn "Connected!"
 
     let config = partialConfig connection
-    let initialMessageCount = 0
-    runBot initialMessageCount config bot
+    let initialState = empty
+    runBot initialState config bot
 
     WS.sendClose connection $ T.pack "Bye!"