module Network.Skype.Core (
ApplicationName,
Command,
CommandID,
Notification,
MonadSkype(..),
SkypeConfig(..),
SkypeError(..),
SkypeT,
defaultConfig,
runSkype,
runSkypeWith,
dupNotificationChan,
onNotification
) where
import Control.Applicative (Applicative)
import Control.Concurrent.STM.TChan (TChan, dupTChan, readTChan)
import Control.Monad (liftM)
import Control.Monad.Error (MonadError, Error(..), ErrorT(..))
import Control.Monad.Reader (MonadReader(..), ReaderT(..), runReaderT)
import Control.Monad.STM (atomically)
import Control.Monad.Base (MonadBase)
import Control.Monad.Trans (MonadIO, MonadTrans, lift, liftIO)
import Control.Monad.Trans.Control
import Data.String (fromString)
import Data.Typeable (Typeable)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
type ApplicationName = BS.ByteString
type Command = BS.ByteString
type CommandID = BS.ByteString
type Notification = BL.ByteString
class (Monad m) => MonadSkype m where
sendCommand :: Command -> m ()
getNotificationChan :: m (TChan Notification)
newtype SkypeT m a = SkypeT
{ runSkypeT :: ErrorT SkypeError (ReaderT SkypeConfig m) a
}
deriving ( Applicative
, Functor
, Monad
, MonadIO
, MonadError SkypeError
, MonadReader SkypeConfig
, MonadBase base
)
instance MonadTrans SkypeT where
lift = SkypeT . lift . lift
instance MonadTransControl SkypeT where
newtype StT SkypeT a = StSkype { unStSkype :: Either SkypeError a }
liftWith f = SkypeT . ErrorT . ReaderT $ \r ->
liftM Right $ f $ \t ->
liftM StSkype $ runReaderT (runErrorT (runSkypeT t)) r
restoreT = SkypeT . ErrorT . ReaderT . const . liftM unStSkype
instance MonadBaseControl base m => MonadBaseControl base (SkypeT m) where
newtype StM (SkypeT m) a = StMSkypeT { unStMSkypeT :: ComposeSt SkypeT m a }
liftBaseWith = defaultLiftBaseWith StMSkypeT
restoreM = defaultRestoreM unStMSkypeT
instance MonadSkype m => MonadSkype (SkypeT m) where
sendCommand = lift . sendCommand
getNotificationChan = lift getNotificationChan
data SkypeConfig = SkypeConfig
{ skypeTimeout :: Int }
defaultConfig :: SkypeConfig
defaultConfig = SkypeConfig
{ skypeTimeout = 10000 * 1000 }
data SkypeError = SkypeError
{ skypeErrorCode :: Int
, skypeErrorCommand :: Command
, skypeErrorDescription :: T.Text
}
deriving (Eq, Show, Typeable)
instance Error SkypeError where
noMsg = SkypeError 0 "" ""
strMsg = SkypeError 0 "" . fromString
runSkype :: (Monad m, MonadSkype (ReaderT connection m))
=> connection
-> SkypeT (ReaderT connection m) a
-> m (Either SkypeError a)
runSkype connection = runSkypeWith connection defaultConfig
runSkypeWith :: (Monad m, MonadSkype (ReaderT connection m))
=> connection
-> SkypeConfig
-> SkypeT (ReaderT connection m) a
-> m (Either SkypeError a)
runSkypeWith connection config skype =
runReaderT (runReaderT (runErrorT (runSkypeT skype)) config) connection
dupNotificationChan :: (MonadIO m, MonadSkype m) => m (TChan Notification)
dupNotificationChan = getNotificationChan >>= liftIO . atomically . dupTChan
onNotification :: (MonadIO m, MonadSkype m) => (Notification -> m a) -> m ()
onNotification f = dupNotificationChan >>= loop
where
loop chan = do
_ <- liftIO (atomically (readTChan chan)) >>= f
loop chan