-- | Support for more(1) buffering
module Lambdabot.Plugin.Core.More (morePlugin) where

import Lambdabot.Bot
import Lambdabot.Monad
import Lambdabot.Plugin

import Control.Monad.Trans

type MoreState = GlobalPrivate () [String]
type More = ModuleT MoreState LB

-- the @more state is handled centrally
morePlugin :: Module (GlobalPrivate () [String])
morePlugin :: Module MoreState
morePlugin = forall st. Module st
newModule
    { moduleDefState :: LB MoreState
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall g p. Int -> g -> GlobalPrivate g p
mkGlobalPrivate Int
20 ()
    , moduleInit :: ModuleT MoreState LB ()
moduleInit = forall st. OutputFilter st -> ModuleT st LB ()
registerOutputFilter Nick -> [String] -> More [String]
moreFilter
        -- TODO: improve output filter system...
        -- currently, @more output will bypass any filters in the
        -- chain after 'moreFilter'

    , moduleCmds :: ModuleT MoreState LB [Command (ModuleT MoreState LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"more")
            { help :: Cmd (ModuleT MoreState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"@more. Return more output from the bot buffer."
            , process :: String -> Cmd (ModuleT MoreState LB) ()
process = \String
_ -> do
                Nick
target <- forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
                Maybe [String]
morestate <- forall (m :: * -> *) g p.
(MonadLBState m, LBState m ~ GlobalPrivate g p) =>
Nick -> m (Maybe p)
readPS Nick
target
                -- TODO: test theory that we can just "say" morestate;
                --       it should end up going through the moreFilter as needed
                case Maybe [String]
morestate of
                    Maybe [String]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just [String]
ls -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Nick -> [String] -> More [String]
moreFilter Nick
target [String]
ls)
                        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> String -> LB ()
ircPrivmsg' Nick
target)
            }
        ]
    }

moreFilter :: Nick -> [String] -> More [String]
moreFilter :: Nick -> [String] -> More [String]
moreFilter Nick
target [String]
msglines = do
    let ([String]
morelines, [String]
thislines) = case forall a. Int -> [a] -> [a]
drop (Int
maxLinesforall a. Num a => a -> a -> a
+Int
2) [String]
msglines of
          [] -> ([],[String]
msglines)
          [String]
_  -> (forall a. Int -> [a] -> [a]
drop Int
maxLines [String]
msglines, forall a. Int -> [a] -> [a]
take Int
maxLines [String]
msglines)
    forall (m :: * -> *) g p.
(MonadLBState m, LBState m ~ GlobalPrivate g p) =>
Nick -> Maybe p -> m ()
writePS Nick
target forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
morelines then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [String]
morelines
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String]
thislines forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
morelines
                          then []
                          else [Char
'['forall a. a -> [a] -> [a]
:forall a. Show a => a -> ShowS
shows (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
morelines) String
" @more lines]"]

    where maxLines :: Int
maxLines = Int
5 -- arbitrary, really