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

    , moduleCmds :: ModuleT
  (GlobalPrivate () [String])
  LB
  [Command (ModuleT (GlobalPrivate () [String]) LB)]
moduleCmds = [Command (ModuleT (GlobalPrivate () [String]) LB)]
-> ModuleT
     (GlobalPrivate () [String])
     LB
     [Command (ModuleT (GlobalPrivate () [String]) LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"more")
            { help :: Cmd (ModuleT (GlobalPrivate () [String]) LB) ()
help = String -> Cmd (ModuleT (GlobalPrivate () [String]) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"@more. Return more output from the bot buffer."
            , process :: String -> Cmd (ModuleT (GlobalPrivate () [String]) LB) ()
process = \String
_ -> do
                Nick
target <- Cmd (ModuleT (GlobalPrivate () [String]) LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
                Maybe [String]
morestate <- Nick
-> Cmd (ModuleT (GlobalPrivate () [String]) LB) (Maybe [String])
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 -> () -> Cmd (ModuleT (GlobalPrivate () [String]) LB) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just [String]
ls -> ModuleT (GlobalPrivate () [String]) LB [String]
-> Cmd (ModuleT (GlobalPrivate () [String]) LB) [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (OutputFilter (GlobalPrivate () [String])
moreFilter Nick
target [String]
ls)
                        Cmd (ModuleT (GlobalPrivate () [String]) LB) [String]
-> ([String] -> Cmd (ModuleT (GlobalPrivate () [String]) LB) ())
-> Cmd (ModuleT (GlobalPrivate () [String]) LB) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Cmd (ModuleT (GlobalPrivate () [String]) LB) ())
-> [String] -> Cmd (ModuleT (GlobalPrivate () [String]) LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LB () -> Cmd (ModuleT (GlobalPrivate () [String]) LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd (ModuleT (GlobalPrivate () [String]) LB) ())
-> (String -> LB ())
-> String
-> Cmd (ModuleT (GlobalPrivate () [String]) LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> String -> LB ()
ircPrivmsg' Nick
target)
            }
        ]
    }

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

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