{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Lambdabot.Command 
    ( Command(..)
    , cmdNames
    , command
    , runCommand
    , Cmd
    , execCmd
    , getCmdName
    , withMsg
    , readNick
    , showNick
    , getServer
    , getSender
    , getTarget
    , getLambdabotName
    , say
    ) where

import Lambdabot.Config
import Lambdabot.Logging
import qualified Lambdabot.Message as Msg
import Lambdabot.Nick

import Control.Applicative
import Control.Monad.Fail (MonadFail)
import qualified Control.Monad.Fail
import Control.Monad.Base
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Control.Monad.Writer

data CmdArgs = forall a. Msg.Message a => CmdArgs
    { ()
_message  :: a
    , CmdArgs -> Nick
target    :: Nick
    , CmdArgs -> String
invokedAs :: String
    }

newtype Cmd m a = Cmd { forall (m :: * -> *) a.
Cmd m a -> ReaderT CmdArgs (WriterT [String] m) a
unCmd :: ReaderT CmdArgs (WriterT [String] m) a }
instance Functor f => Functor (Cmd f) where
    fmap :: forall a b. (a -> b) -> Cmd f a -> Cmd f b
fmap a -> b
f (Cmd ReaderT CmdArgs (WriterT [String] f) a
x) = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ReaderT CmdArgs (WriterT [String] f) a
x)
instance Applicative f => Applicative (Cmd f) where
    pure :: forall a. a -> Cmd f a
pure = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Cmd ReaderT CmdArgs (WriterT [String] f) (a -> b)
f <*> :: forall a b. Cmd f (a -> b) -> Cmd f a -> Cmd f b
<*> Cmd ReaderT CmdArgs (WriterT [String] f) a
x = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd (ReaderT CmdArgs (WriterT [String] f) (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT CmdArgs (WriterT [String] f) a
x)
instance Monad m => Monad (Cmd m) where
    return :: forall a. a -> Cmd m a
return = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
    Cmd ReaderT CmdArgs (WriterT [String] m) a
x >>= :: forall a b. Cmd m a -> (a -> Cmd m b) -> Cmd m b
>>= a -> Cmd m b
f = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd (ReaderT CmdArgs (WriterT [String] m) a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a.
Cmd m a -> ReaderT CmdArgs (WriterT [String] m) a
unCmd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Cmd m b
f))
instance MonadFail m => MonadFail (Cmd m) where
    fail :: forall a. String -> Cmd m a
fail = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail
instance MonadIO m => MonadIO (Cmd m) where
    liftIO :: forall a. IO a -> Cmd m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadBase b m => MonadBase b (Cmd m) where
    liftBase :: forall α. b α -> Cmd m α
liftBase = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
instance MonadTrans Cmd where
    lift :: forall (m :: * -> *) a. Monad m => m a -> Cmd m a
lift = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadTransControl Cmd where
    type StT Cmd a = (a, [String])
    liftWith :: forall (m :: * -> *) a. Monad m => (Run Cmd -> m a) -> Cmd m a
liftWith Run Cmd -> m a
f = do
        CmdArgs
r <- forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd forall r (m :: * -> *). MonadReader r m => m r
ask
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Run Cmd -> m a
f forall a b. (a -> b) -> a -> b
$ \Cmd n b
t -> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a.
Cmd m a -> ReaderT CmdArgs (WriterT [String] m) a
unCmd Cmd n b
t) CmdArgs
r)
    restoreT :: forall (m :: * -> *) a. Monad m => m (StT Cmd a) -> Cmd m a
restoreT = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT
    {-# INLINE liftWith #-}
    {-# INLINE restoreT #-}
instance MonadBaseControl b m => MonadBaseControl b (Cmd m) where
    type StM (Cmd m) a = ComposeSt Cmd m a
    liftBaseWith :: forall a. (RunInBase (Cmd m) b -> b a) -> Cmd m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: forall a. StM (Cmd m) a -> Cmd m a
restoreM     = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
    {-# INLINE liftBaseWith #-}
    {-# INLINE restoreM #-}
instance MonadConfig m => MonadConfig (Cmd m) where
    getConfig :: forall a. Config a -> Cmd m a
getConfig = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig
instance MonadLogging m => MonadLogging (Cmd m) where
    getCurrentLogger :: Cmd m [String]
getCurrentLogger = do
        [String]
parent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadLogging m => m [String]
getCurrentLogger
        String
self   <- forall (m :: * -> *). Monad m => Cmd m String
getCmdName
        forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
parent forall a. [a] -> [a] -> [a]
++ [String
"Command", String
self])
    logM :: String -> Priority -> String -> Cmd m ()
logM String
a Priority
b String
c = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
MonadLogging m =>
String -> Priority -> String -> m ()
logM String
a Priority
b String
c)

data Command m = Command
    { forall (m :: * -> *). Command m -> String
cmdName       :: String
    , forall (m :: * -> *). Command m -> [String]
aliases       :: [String]
    , forall (m :: * -> *). Command m -> Bool
privileged    :: Bool
    , forall (m :: * -> *). Command m -> Cmd m ()
help          :: Cmd m ()
    , forall (m :: * -> *). Command m -> String -> Cmd m ()
process       :: String -> Cmd m ()
    }

cmdNames :: Command m -> [String]
cmdNames :: forall (m :: * -> *). Command m -> [String]
cmdNames Command m
c = forall (m :: * -> *). Command m -> String
cmdName Command m
c forall a. a -> [a] -> [a]
: forall (m :: * -> *). Command m -> [String]
aliases Command m
c

command :: String -> Command Identity
command :: String -> Command Identity
command String
name = Command
    { cmdName :: String
cmdName       = String
name
    , aliases :: [String]
aliases       = []
    , privileged :: Bool
privileged    = Bool
False
    , help :: Cmd Identity ()
help          = String -> Cmd Identity ()
bug String
"they haven't created any help text!"
    , process :: String -> Cmd Identity ()
process       = forall a b. a -> b -> a
const (String -> Cmd Identity ()
bug String
"they haven't implemented this command!")
    } where
        bug :: String -> Cmd Identity ()
bug String
reason = forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [ String
"You should bug the author of the", forall a. Show a => a -> String
show String
name, String
"command, because", String
reason]

runCommand :: (Monad m, Msg.Message a) => Command m -> a -> Nick -> String -> String -> m [String]
runCommand :: forall (m :: * -> *) a.
(Monad m, Message a) =>
Command m -> a -> Nick -> String -> String -> m [String]
runCommand Command m
cmd a
msg Nick
tgt String
arg0 String
args = forall (m :: * -> *) a t.
(Monad m, Message a) =>
Cmd m t -> a -> Nick -> String -> m [String]
execCmd (forall (m :: * -> *). Command m -> String -> Cmd m ()
process Command m
cmd String
args) a
msg Nick
tgt String
arg0

execCmd ::  (Monad m, Msg.Message a) => Cmd m t -> a -> Nick -> String -> m [String]
execCmd :: forall (m :: * -> *) a t.
(Monad m, Message a) =>
Cmd m t -> a -> Nick -> String -> m [String]
execCmd Cmd m t
cmd a
msg Nick
tgt String
arg0 = forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a.
Cmd m a -> ReaderT CmdArgs (WriterT [String] m) a
unCmd Cmd m t
cmd) (forall a. Message a => a -> Nick -> String -> CmdArgs
CmdArgs a
msg Nick
tgt String
arg0))

getTarget :: Monad m => Cmd m Nick
getTarget :: forall (m :: * -> *). Monad m => Cmd m Nick
getTarget = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CmdArgs -> Nick
target)

getCmdName :: Monad m => Cmd m String
getCmdName :: forall (m :: * -> *). Monad m => Cmd m String
getCmdName = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CmdArgs -> String
invokedAs)

say :: Monad m => String -> Cmd m ()
say :: forall (m :: * -> *). Monad m => String -> Cmd m ()
say [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
say String
it = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd (forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
it])

withMsg :: Monad m => (forall a. Msg.Message a => a -> Cmd m t) -> Cmd m t
withMsg :: forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg forall a. Message a => a -> Cmd m t
f = forall (m :: * -> *) a.
ReaderT CmdArgs (WriterT [String] m) a -> Cmd m a
Cmd forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CmdArgs -> Cmd m t
f'
    where f' :: CmdArgs -> Cmd m t
f' (CmdArgs a
msg Nick
_ String
_) = forall a. Message a => a -> Cmd m t
f a
msg

readNick :: Monad m => String -> Cmd m Nick
readNick :: forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
nick = forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (\a
msg -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String -> Nick
parseNick (forall a. Message a => a -> String
Msg.server a
msg) String
nick))

showNick :: Monad m => Nick -> Cmd m String
showNick :: forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick Nick
nick = forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (\a
msg -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Nick -> String
fmtNick (forall a. Message a => a -> String
Msg.server a
msg) Nick
nick))

getServer :: Monad m => Cmd m String
getServer :: forall (m :: * -> *). Monad m => Cmd m String
getServer = forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Message a => a -> String
Msg.server)

getSender :: Monad m => Cmd m Nick
getSender :: forall (m :: * -> *). Monad m => Cmd m Nick
getSender = forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Message a => a -> Nick
Msg.nick)

getLambdabotName :: Monad m => Cmd m Nick
getLambdabotName :: forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName = forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Message a => a -> Nick
Msg.lambdabotName)