{-# 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 { BotPartT m a -> ReaderT BotEnv m a
unBotPartT :: ReaderT BotEnv m a }
    deriving (Functor (BotPartT m)
a -> BotPartT m a
Functor (BotPartT m)
-> (forall a. a -> BotPartT m a)
-> (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 a b. BotPartT m a -> BotPartT m b -> BotPartT m b)
-> (forall a b. BotPartT m a -> BotPartT m b -> BotPartT m a)
-> Applicative (BotPartT m)
BotPartT m a -> BotPartT m b -> BotPartT m b
BotPartT m a -> BotPartT m b -> BotPartT m a
BotPartT m (a -> b) -> BotPartT m a -> BotPartT m b
(a -> b -> c) -> BotPartT m a -> BotPartT m b -> BotPartT m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> BotPartT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> BotPartT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (BotPartT m)
Applicative, Applicative (BotPartT m)
BotPartT m a
Applicative (BotPartT m)
-> (forall a. BotPartT m a)
-> (forall a. BotPartT m a -> BotPartT m a -> BotPartT m a)
-> (forall a. BotPartT m a -> BotPartT m [a])
-> (forall a. BotPartT m a -> BotPartT m [a])
-> Alternative (BotPartT m)
BotPartT m a -> BotPartT m a -> BotPartT m a
BotPartT m a -> BotPartT m [a]
BotPartT m a -> BotPartT m [a]
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 :: BotPartT m a -> BotPartT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
BotPartT m a -> BotPartT m [a]
some :: BotPartT m a -> BotPartT m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
BotPartT m a -> BotPartT m [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 :: BotPartT m a
$cempty :: forall (m :: * -> *) a. Alternative m => BotPartT m a
$cp1Alternative :: forall (m :: * -> *). Alternative m => Applicative (BotPartT m)
Alternative, a -> BotPartT m b -> BotPartT m a
(a -> b) -> BotPartT m a -> BotPartT m b
(forall a b. (a -> b) -> BotPartT m a -> BotPartT m b)
-> (forall a b. a -> BotPartT m b -> BotPartT m a)
-> Functor (BotPartT m)
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
<$ :: a -> BotPartT m b -> BotPartT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> BotPartT m b -> BotPartT m a
fmap :: (a -> b) -> BotPartT m a -> BotPartT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> BotPartT m a -> BotPartT m b
Functor, Applicative (BotPartT m)
a -> BotPartT m a
Applicative (BotPartT m)
-> (forall a b.
    BotPartT m a -> (a -> BotPartT m b) -> BotPartT m b)
-> (forall a b. BotPartT m a -> BotPartT m b -> BotPartT m b)
-> (forall a. a -> BotPartT m a)
-> Monad (BotPartT m)
BotPartT m a -> (a -> BotPartT m b) -> BotPartT m b
BotPartT m a -> BotPartT m b -> BotPartT m b
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 :: a -> BotPartT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> BotPartT m a
>> :: 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
>>= :: 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
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (BotPartT m)
Monad, Monad (BotPartT m)
Monad (BotPartT m)
-> (forall a. (a -> BotPartT m a) -> BotPartT m a)
-> MonadFix (BotPartT m)
(a -> BotPartT m a) -> BotPartT m a
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 :: (a -> BotPartT m a) -> BotPartT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> BotPartT m a) -> BotPartT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (BotPartT m)
MonadFix, Monad (BotPartT m)
Alternative (BotPartT m)
BotPartT m a
Alternative (BotPartT m)
-> Monad (BotPartT m)
-> (forall a. BotPartT m a)
-> (forall a. BotPartT m a -> BotPartT m a -> BotPartT m a)
-> MonadPlus (BotPartT m)
BotPartT m a -> BotPartT m a -> BotPartT m a
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 :: 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 :: BotPartT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => BotPartT m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (BotPartT m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (BotPartT m)
MonadPlus, m a -> BotPartT m a
(forall (m :: * -> *) a. Monad m => m a -> BotPartT m a)
-> MonadTrans BotPartT
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 :: m a -> BotPartT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> BotPartT m a
MonadTrans, Monad (BotPartT m)
Monad (BotPartT m)
-> (forall a. IO a -> BotPartT m a) -> MonadIO (BotPartT m)
IO a -> BotPartT m a
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 :: IO a -> BotPartT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> BotPartT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (BotPartT m)
MonadIO, MonadWriter w, MonadState s, MonadError e, Monad (BotPartT m)
Monad (BotPartT m)
-> (forall a b.
    ((a -> BotPartT m b) -> BotPartT m a) -> BotPartT m a)
-> MonadCont (BotPartT m)
((a -> BotPartT m b) -> BotPartT m a) -> BotPartT m a
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 :: ((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
$cp1MonadCont :: forall (m :: * -> *). MonadCont m => Monad (BotPartT m)
MonadCont)

instance (MonadReader r m) => MonadReader r (BotPartT m) where
    ask :: BotPartT m r
ask     = ReaderT BotEnv m r -> BotPartT m r
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (m r -> ReaderT BotEnv m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask)
    local :: (r -> r) -> BotPartT m a -> BotPartT m a
local r -> r
f = ReaderT BotEnv m a -> BotPartT m a
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (ReaderT BotEnv m a -> BotPartT m a)
-> (BotPartT m a -> ReaderT BotEnv m a)
-> BotPartT m a
-> BotPartT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> m a) -> ReaderT BotEnv m a -> ReaderT BotEnv m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f) (ReaderT BotEnv m a -> ReaderT BotEnv m a)
-> (BotPartT m a -> ReaderT BotEnv m a)
-> BotPartT m a
-> ReaderT BotEnv m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotPartT m a -> ReaderT BotEnv m a
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 :: BotPartT m a -> BotEnv -> m a
runBotPartT BotPartT m a
botPartT = ReaderT BotEnv m a -> BotEnv -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (BotPartT m a -> ReaderT BotEnv m a
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 :: (m a -> n b) -> BotPartT m a -> BotPartT n b
mapBotPartT m a -> n b
f (BotPartT ReaderT BotEnv m a
r) = ReaderT BotEnv n b -> BotPartT n b
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (ReaderT BotEnv n b -> BotPartT n b)
-> ReaderT BotEnv n b -> BotPartT n b
forall a b. (a -> b) -> a -> b
$ (m a -> n b) -> ReaderT BotEnv m a -> ReaderT BotEnv n 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  = ReaderT BotEnv m BotEnv -> BotPartT m BotEnv
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT ReaderT BotEnv m BotEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  askMessage :: BotPartT m Message
askMessage = ReaderT BotEnv m Message -> BotPartT m Message
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (BotEnv -> Message
message (BotEnv -> Message)
-> ReaderT BotEnv m BotEnv -> ReaderT BotEnv m Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT BotEnv m BotEnv
forall r (m :: * -> *). MonadReader r m => m r
ask)
  askOutChan :: BotPartT m (Chan Message)
askOutChan = ReaderT BotEnv m (Chan Message) -> BotPartT m (Chan Message)
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (BotEnv -> Chan Message
outChan (BotEnv -> Chan Message)
-> ReaderT BotEnv m BotEnv -> ReaderT BotEnv m (Chan Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT BotEnv m BotEnv
forall r (m :: * -> *). MonadReader r m => m r
ask)
  localMessage :: (Message -> Message) -> BotPartT m a -> BotPartT m a
localMessage Message -> Message
f (BotPartT ReaderT BotEnv m a
r) = ReaderT BotEnv m a -> BotPartT m a
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT ((BotEnv -> BotEnv) -> ReaderT BotEnv m a -> ReaderT BotEnv m a
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 =
    ReaderT BotEnv m () -> BotPartT m ()
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (ReaderT BotEnv m () -> BotPartT m ())
-> ReaderT BotEnv m () -> BotPartT m ()
forall a b. (a -> b) -> a -> b
$ do Chan Message
out <- BotEnv -> Chan Message
outChan (BotEnv -> Chan Message)
-> ReaderT BotEnv m BotEnv -> ReaderT BotEnv m (Chan Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT BotEnv m BotEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
                  IO () -> ReaderT BotEnv m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT BotEnv m ()) -> IO () -> ReaderT BotEnv m ()
forall a b. (a -> b) -> a -> b
$ Chan Message -> Message -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Message
out Message
msg
                  () -> ReaderT BotEnv m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  logM :: LogLevel -> ByteString -> BotPartT m ()
logM LogLevel
lvl ByteString
msg =
    ReaderT BotEnv m () -> BotPartT m ()
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (ReaderT BotEnv m () -> BotPartT m ())
-> ReaderT BotEnv m () -> BotPartT m ()
forall a b. (a -> b) -> a -> b
$ do Logger
l <- BotEnv -> Logger
logFn (BotEnv -> Logger)
-> ReaderT BotEnv m BotEnv -> ReaderT BotEnv m Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT BotEnv m BotEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
                  IO () -> ReaderT BotEnv m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT BotEnv m ()) -> IO () -> ReaderT BotEnv m ()
forall a b. (a -> b) -> a -> b
$ Logger
l LogLevel
lvl ByteString
msg
  whoami :: BotPartT m ByteString
whoami       =  ReaderT BotEnv m ByteString -> BotPartT m ByteString
forall (m :: * -> *) a. ReaderT BotEnv m a -> BotPartT m a
BotPartT (ReaderT BotEnv m ByteString -> BotPartT m ByteString)
-> ReaderT BotEnv m ByteString -> BotPartT m ByteString
forall a b. (a -> b) -> a -> b
$ BotEnv -> ByteString
botName (BotEnv -> ByteString)
-> ReaderT BotEnv m BotEnv -> ReaderT BotEnv m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT BotEnv m BotEnv
forall r (m :: * -> *). MonadReader r m => m r
ask

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