{-# 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)