module Network.Slack.Types
(
SlackError,
parseStrippedPrefix,
Token,
Slack(..),
SlackState(..),
SlackResponse(..),
SlackResponseName(..),
ArgName,
ArgValue,
CommandName,
CommandArgs,
request,
request',
User(..),
users
)
where
import Network.Slack.Prelude
import Data.Char (toLower)
import Data.List (stripPrefix)
import qualified Data.Map as M
import Data.Aeson (genericParseJSON)
import Data.Aeson.Types(Options(..), defaultOptions)
import Network.HTTP.Conduit (simpleHttp)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.State (MonadState, StateT)
import Control.Monad.Trans.Either (EitherT)
import Control.Applicative(Applicative(..))
type SlackError = String
type Token = String
data User = User {
userId :: String,
userName :: String
} deriving (Show, Eq, Generic)
instance FromJSON User where
parseJSON = parseStrippedPrefix "user"
instance SlackResponseName [User] where
slackResponseName _ = "members"
users :: Slack [User]
users = _users <$> get
data SlackState = SlackState
{
_token :: Token,
_users :: [User]
}
deriving (Show)
newtype Slack a = Slack {runSlackInternal :: EitherT SlackError (StateT SlackState IO) a}
deriving (Functor, Applicative, Monad, MonadIO, MonadState SlackState)
parseStrippedPrefix prefix = genericParseJSON (defaultOptions {fieldLabelModifier = uncamel})
where
uncamel :: String -> String
uncamel str = lowercaseFirst . maybe str id . stripPrefix prefix $ str
lowercaseFirst [] = []
lowercaseFirst (x:xs) = toLower x : xs
type ArgName = String
type ArgValue = String
type CommandName = String
type CommandArgs = M.Map ArgName ArgValue
data SlackResponse a = SlackResponse { response :: Either SlackError a }
deriving (Show)
class SlackResponseName a where
slackResponseName :: a -> Text
instance (FromJSON a, SlackResponseName a) => FromJSON (SlackResponse a) where
parseJSON (Object v) = do
ok <- v .: "ok"
if ok
then SlackResponse . Right <$> v .: slackResponseName (undefined :: a)
else SlackResponse . Left <$> v .: "error"
parseJSON _ = fail "Expected an Object."
type URL = String
buildURL :: CommandName -> CommandArgs -> Slack URL
buildURL command args = do
tokenArg <- _token <$> get
let
queryArgs = M.insert "token" tokenArg args
queryString :: String
queryString = M.foldMapWithKey (printf "%s=%s&") queryArgs
url = printf "https://slack.com/api/%s?%s" command queryString
return url
request :: (SlackResponseName a, FromJSON a) => CommandName -> CommandArgs -> Slack a
request command args = do
url <- buildURL command args
raw <- liftIO (simpleHttp url)
resp <- Slack . hoistEither . eitherDecode $ raw
Slack . hoistEither . response $ resp
request' :: (SlackResponseName a, FromJSON a) => CommandName -> Slack a
request' command = request command M.empty