danibot-0.2.0.0: lib/Network/Danibot/Main.hs
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Danibot.Main (
mainWith
, readJSON
) where
import Data.Function ((&))
import qualified Data.ByteString as Bytes
import Data.Text (Text)
import Data.String
import Data.Aeson (FromJSON,eitherDecodeStrict')
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import qualified Control.Foldl as Foldl
import Control.Concurrent.Conceit
import System.Environment (lookupEnv)
import System.IO
import Network.Danibot.Slack
import Network.Danibot.Slack.Types (introUrl,introChat)
import Network.Danibot.Slack.API (startRTM)
import Network.Danibot.Slack.RTM (fromWSSURI,loopRTM)
slack_api_token_env_var :: String
slack_api_token_env_var = "DANIBOT_SLACK_API_TOKEN"
slack_api_token_env_var_missing :: String
slack_api_token_env_var_missing =
"Environment variable " ++
slack_api_token_env_var ++
" not found."
{-| Read a configuration value from a JSON file.
-}
readJSON :: FromJSON a => FilePath -> IO a
readJSON path = do
bytes <- Bytes.readFile path
case eitherDecodeStrict' bytes of
Right dict -> pure dict
Left err -> throwIO (userError err)
exceptMain :: IO (Either String (Text -> IO Text)) -> ExceptT String IO ()
exceptMain handlerio = do
slack_api_token <- ExceptT (fmap (maybe (Left slack_api_token_env_var_missing)
(Right . fromString))
(lookupEnv "DANIBOT_SLACK_API_TOKEN"))
handler <- ExceptT handlerio
intro <- ExceptT (startRTM slack_api_token)
liftIO (print intro)
endpoint <- fromWSSURI (introUrl intro)
& either throwE pure
(workChan,workerAction) <- liftIO (worker handler)
(chatState,source) <- liftIO (makeChatState (introChat intro))
let theEventFold = eventFold workChan chatState
liftIO (_runConceit (_Conceit (loopRTM theEventFold source endpoint)
*> _Conceit workerAction))
{-| Create a main from an action that either fails with an error or returns a
handler for incoming messages.
-}
mainWith :: IO (Either String (Text -> IO Text)) -> IO ()
mainWith handlerio = do
final <- runExceptT (exceptMain handlerio)
case final of
Left err -> print err
Right () -> pure ()