{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances, OverloadedStrings #-}
module Network.IRC.Bot.BotMonad
    ( BotPartT(..)
    , BotMonad(..)
    , BotEnv(..)
    , runBotPartT
    , mapBotPartT
    , maybeZero
    ) where

import Control.Applicative (Alternative)
import Control.Monad (MonadPlus(mzero))
import Control.Monad.Cont   (MonadCont)
import Control.Monad.Except  (MonadError)
import Control.Monad.Reader (MonadReader(ask, local), ReaderT(runReaderT), mapReaderT)
import Control.Monad.Writer (MonadWriter)
import Control.Monad.State  (MonadState)
import Control.Monad.RWS    (MonadRWS)
import Control.Concurrent.Chan (Chan, writeChan)
import Control.Monad.Fix (MonadFix)
import Control.Monad.Trans
import Data.ByteString (ByteString)
import Network.IRC (Message)
import Network.IRC.Bot.Log

class (Functor m, MonadPlus m, MonadIO m) => BotMonad m where
  askBotEnv    :: m BotEnv
  askMessage   :: m Message
  askOutChan   :: m (Chan Message)
  localMessage :: (Message -> Message) -> m a -> m a
  sendMessage  :: Message -> m ()
  logM         :: LogLevel -> ByteString -> m ()
  whoami       :: m ByteString

data BotEnv = BotEnv
    { BotEnv -> Message
message   :: Message
    , BotEnv -> Chan Message
outChan   :: Chan Message
    , BotEnv -> Logger
logFn     :: Logger
    , BotEnv -> ByteString
botName   :: ByteString
    , BotEnv -> String
cmdPrefix :: String
    }

newtype BotPartT m a = BotPartT { forall (m :: * -> *) a. BotPartT m a -> ReaderT BotEnv m a
unBotPartT :: ReaderT BotEnv m a }
    deriving (forall a. a -> BotPartT m a
forall a b. BotPartT m a -> BotPartT m b -> BotPartT m a
forall a b. BotPartT m a -> BotPartT m b -> BotPartT m b
forall a b. BotPartT m (a -> b) -> BotPartT m a -> BotPartT m b
forall a b c.
(a -> b -> c) -> BotPartT m a -> BotPartT m b -> BotPartT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (BotPartT m)
forall (m :: * -> *) a. Applicative m => a -> BotPartT m a
forall (m :: * -> *) a b.
Applicative m =>
BotPartT m a -> BotPartT m b -> BotPartT m a
forall (m :: * -> *) a b.
Applicative m =>
BotPartT m a -> BotPartT m b -> BotPartT m b
forall (m :: * -> *) a b.
Applicative m =>
BotPartT m (a -> b) -> BotPartT m a -> BotPartT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> BotPartT m a -> BotPartT m b -> BotPartT m c
<* :: forall a b. BotPartT m a -> BotPartT m b -> BotPartT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
BotPartT m a -> BotPartT m b -> BotPartT m a
*> :: forall a b. BotPartT m a -> BotPartT m b -> BotPartT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
BotPartT m a -> BotPartT m b -> BotPartT m b
liftA2 :: forall a b c.
(a -> b -> c) -> BotPartT m a -> BotPartT m b -> BotPartT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> BotPartT m a -> BotPartT m b -> BotPartT m c
<*> :: forall a b. BotPartT m (a -> b) -> BotPartT m a -> BotPartT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
BotPartT m (a -> b) -> BotPartT m a -> BotPartT m b
pure :: forall a. a -> BotPartT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> BotPartT m a
Applicative, forall a. BotPartT m a
forall a. BotPartT m a -> BotPartT m [a]
forall a. BotPartT m a -> BotPartT m a -> BotPartT m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall {m :: * -> *}. Alternative m => Applicative (BotPartT m)
forall (m :: * -> *) a. Alternative m => BotPartT m a
forall (m :: * -> *) a.
Alternative m =>
BotPartT m a -> BotPartT m [a]
forall (m :: * -> *) a.
Alternative m =>
BotPartT m a -> BotPartT m a -> BotPartT m a
many :: forall a. BotPartT m a -> BotPartT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
BotPartT m a -> BotPartT m [a]
some :: forall a. BotPartT m a -> BotPartT m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
BotPartT m a -> BotPartT m [a]
<|> :: forall a. BotPartT m a -> BotPartT m a -> BotPartT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
BotPartT m a -> BotPartT m a -> BotPartT m a
empty :: forall a. BotPartT m a
$cempty :: forall (m :: * -> *) a. Alternative m => BotPartT m a
Alternative, forall a b. a -> BotPartT m b -> BotPartT m a
forall a b. (a -> b) -> BotPartT m a -> BotPartT m b
forall (m :: * -> *) a b.
Functor m =>
a -> BotPartT m b -> BotPartT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> BotPartT m a -> BotPartT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BotPartT m b -> BotPartT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> BotPartT m b -> BotPartT m a
fmap :: forall a b. (a -> b) -> BotPartT m a -> BotPartT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> BotPartT m a -> BotPartT m b
Functor, forall a. a -> BotPartT m a
forall a b. BotPartT m a -> BotPartT m b -> BotPartT m b
forall a b. BotPartT m a -> (a -> BotPartT m b) -> BotPartT m b
forall {m :: * -> *}. Monad m => Applicative (BotPartT m)
forall (m :: * -> *) a. Monad m => a -> BotPartT m a
forall (m :: * -> *) a b.
Monad m =>
BotPartT m a -> BotPartT m b -> BotPartT m b
forall (m :: * -> *) a b.
Monad m =>
BotPartT m a -> (a -> BotPartT m b) -> BotPartT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> BotPartT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> BotPartT m a
>> :: forall a b. BotPartT m a -> BotPartT m b -> BotPartT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
BotPartT m a -> BotPartT m b -> BotPartT m b
>>= :: forall a b. BotPartT m a -> (a -> BotPartT m b) -> BotPartT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
BotPartT m a -> (a -> BotPartT m b) -> BotPartT m b
Monad, forall a. (a -> BotPartT m a) -> BotPartT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (BotPartT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> BotPartT m a) -> BotPartT m a
mfix :: forall a. (a -> BotPartT m a) -> BotPartT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> BotPartT m a) -> BotPartT m a
MonadFix, forall a. BotPartT m a
forall a. BotPartT m a -> BotPartT m a -> BotPartT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall {m :: * -> *}. MonadPlus m => Monad (BotPartT m)
forall {m :: * -> *}. MonadPlus m => Alternative (BotPartT m)
forall (m :: * -> *) a. MonadPlus m => BotPartT m a
forall (m :: * -> *) a.
MonadPlus m =>
BotPartT m a -> BotPartT m a -> BotPartT m a
mplus :: forall a. BotPartT m a -> BotPartT m a -> BotPartT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
BotPartT m a -> BotPartT m a -> BotPartT m a
mzero :: forall a. BotPartT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => BotPartT m a
MonadPlus, forall (m :: * -> *) a. Monad m => m a -> BotPartT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> BotPartT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> BotPartT m a
MonadTrans, forall a. IO a -> BotPartT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (BotPartT m)
forall (m :: * -> *) a. MonadIO m => IO a -> BotPartT m a
liftIO :: forall a. IO a -> BotPartT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> BotPartT m a
MonadIO, MonadWriter w, MonadState s, MonadError e, forall a b. ((a -> BotPartT m b) -> BotPartT m a) -> BotPartT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall {m :: * -> *}. MonadCont m => Monad (BotPartT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> BotPartT m b) -> BotPartT m a) -> BotPartT m a
callCC :: forall a b. ((a -> BotPartT m b) -> BotPartT m a) -> BotPartT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> BotPartT m b) -> BotPartT m a) -> BotPartT m a
MonadCont)

instance (MonadReader r m) => MonadReader r (BotPartT m) where
    ask :: BotPartT m r
ask     = forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask)
    local :: forall a. (r -> r) -> BotPartT m a -> BotPartT m a
local r -> r
f = forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. BotPartT m a -> ReaderT BotEnv m a
unBotPartT

instance (MonadRWS r w s m) => MonadRWS r w s (BotPartT m)

runBotPartT :: BotPartT m a -> BotEnv -> m a
runBotPartT :: forall (m :: * -> *) a. BotPartT m a -> BotEnv -> m a
runBotPartT BotPartT m a
botPartT = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. BotPartT m a -> ReaderT BotEnv m a
unBotPartT BotPartT m a
botPartT)

mapBotPartT :: (m a -> n b) -> BotPartT m a -> BotPartT n b
mapBotPartT :: forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> BotPartT m a -> BotPartT n b
mapBotPartT m a -> n b
f (BotPartT ReaderT BotEnv m a
r) = forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> n b
f ReaderT BotEnv m a
r

instance (Functor m, MonadIO m, MonadPlus m) => BotMonad (BotPartT m) where
  askBotEnv :: BotPartT m BotEnv
askBotEnv  = forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT forall r (m :: * -> *). MonadReader r m => m r
ask
  askMessage :: BotPartT m Message
askMessage = forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (BotEnv -> Message
message forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask)
  askOutChan :: BotPartT m (Chan Message)
askOutChan = forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (BotEnv -> Chan Message
outChan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask)
  localMessage :: forall a. (Message -> Message) -> BotPartT m a -> BotPartT m a
localMessage Message -> Message
f (BotPartT ReaderT BotEnv m a
r) = forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\BotEnv
e -> BotEnv
e { message :: Message
message = Message -> Message
f (BotEnv -> Message
message BotEnv
e) }) ReaderT BotEnv m a
r)
  sendMessage :: Message -> BotPartT m ()
sendMessage Message
msg =
    forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT forall a b. (a -> b) -> a -> b
$ do Chan Message
out <- BotEnv -> Chan Message
outChan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
                  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> a -> IO ()
writeChan Chan Message
out Message
msg
                  forall (m :: * -> *) a. Monad m => a -> m a
return ()
  logM :: LogLevel -> ByteString -> BotPartT m ()
logM LogLevel
lvl ByteString
msg =
    forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT forall a b. (a -> b) -> a -> b
$ do Logger
l <- BotEnv -> Logger
logFn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask
                  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger
l LogLevel
lvl ByteString
msg
  whoami :: BotPartT m ByteString
whoami       =  forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT forall a b. (a -> b) -> a -> b
$ BotEnv -> ByteString
botName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
ask

maybeZero :: (MonadPlus m) => Maybe a -> m a
maybeZero :: forall (m :: * -> *) a. MonadPlus m => Maybe a -> m a
maybeZero Maybe a
Nothing = forall (m :: * -> *) a. MonadPlus m => m a
mzero
maybeZero (Just a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return a
a