{-# LANGUAGE PatternGuards #-}
module Lambdabot.Plugin.Misc.Todo (todoPlugin) where
import Lambdabot.Compat.PackedNick
import Lambdabot.Plugin
import Control.Monad
import qualified Data.ByteString.Char8 as P
type TodoState = [(P.ByteString, P.ByteString)]
type Todo = ModuleT TodoState LB
todoPlugin :: Module TodoState
todoPlugin :: Module TodoState
todoPlugin = Module TodoState
forall st. Module st
newModule
{ moduleDefState = return ([] :: TodoState)
, moduleSerialize = Just assocListPackedSerial
, moduleCmds = return
[ (command "todo")
{ help = say "todo. List todo entries"
, process = getTodo
}
, (command "todo-add")
{ help = say "todo-add <idea>. Add a todo entry"
, process = addTodo
}
, (command "todo-delete")
{ privileged = True
, help = say "todo-delete <n>. Delete a todo entry (for admins)"
, process = delTodo
}
]
}
getTodo :: String -> Cmd Todo ()
getTodo :: String -> Cmd Todo ()
getTodo [] = Cmd Todo TodoState
Cmd Todo (LBState (Cmd Todo))
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS Cmd Todo TodoState -> (TodoState -> Cmd Todo ()) -> Cmd Todo ()
forall a b. Cmd Todo a -> (a -> Cmd Todo b) -> Cmd Todo b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TodoState -> Cmd Todo ()
sayTodo
getTodo String
_ = String -> Cmd Todo ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"@todo has no args, try @todo-add or @list todo"
sayTodo :: [(P.ByteString, P.ByteString)] -> Cmd Todo ()
sayTodo :: TodoState -> Cmd Todo ()
sayTodo [] = String -> Cmd Todo ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Nothing to do!"
sayTodo TodoState
todoList = String -> Cmd Todo ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd Todo ())
-> ([String] -> String) -> [String] -> Cmd Todo ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Cmd Todo ()) -> Cmd Todo [String] -> Cmd Todo ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> (ByteString, ByteString) -> Cmd Todo String)
-> [Int] -> TodoState -> Cmd Todo [String]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> (ByteString, ByteString) -> Cmd Todo String
forall {m :: * -> *} {a}.
(Monad m, Show a) =>
a -> (ByteString, ByteString) -> Cmd m String
fmtTodoItem ([Int
0..] :: [Int]) TodoState
todoList
where
fmtTodoItem :: a -> (ByteString, ByteString) -> Cmd m String
fmtTodoItem a
n (ByteString
idea, ByteString
nick_) = do
String
nick <- Nick -> Cmd m String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick (ByteString -> Nick
unpackNick ByteString
nick_)
String -> Cmd m String
forall a. a -> Cmd m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd m String) -> String -> Cmd m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ a -> String
forall a. Show a => a -> String
show a
n,String
". ", String
nick ,String
": ",ByteString -> String
P.unpack ByteString
idea ]
addTodo :: String -> Cmd Todo ()
addTodo :: String -> Cmd Todo ()
addTodo String
rest = do
ByteString
sender <- (Nick -> ByteString) -> Cmd Todo Nick -> Cmd Todo ByteString
forall a b. (a -> b) -> Cmd Todo a -> Cmd Todo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Nick -> ByteString
packNick Cmd Todo Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
(LBState (Cmd Todo) -> LBState (Cmd Todo)) -> Cmd Todo ()
forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS (TodoState -> TodoState -> TodoState
forall a. [a] -> [a] -> [a]
++[(String -> ByteString
P.pack String
rest, ByteString
sender)])
String -> Cmd Todo ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Entry added to the todo list"
delTodo :: String -> Cmd Todo ()
delTodo :: String -> Cmd Todo ()
delTodo String
rest
| Just Int
n <- String -> Maybe Int
forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM String
rest = String -> Cmd Todo ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd Todo ()) -> Cmd Todo String -> Cmd Todo ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (LBState (Cmd Todo)
-> (LBState (Cmd Todo) -> Cmd Todo ()) -> Cmd Todo String)
-> Cmd Todo String
forall a.
(LBState (Cmd Todo)
-> (LBState (Cmd Todo) -> Cmd Todo ()) -> Cmd Todo a)
-> Cmd Todo a
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS (\LBState (Cmd Todo)
ls LBState (Cmd Todo) -> Cmd Todo ()
write -> case () of
()
_ | TodoState -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TodoState
LBState (Cmd Todo)
ls -> String -> Cmd Todo String
forall a. a -> Cmd Todo a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Todo list is empty"
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> TodoState -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TodoState
LBState (Cmd Todo)
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
-> String -> Cmd Todo String
forall a. a -> Cmd Todo a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is out of range")
| Bool
otherwise -> do
LBState (Cmd Todo) -> Cmd Todo ()
write (((Int, (ByteString, ByteString)) -> (ByteString, ByteString))
-> [(Int, (ByteString, ByteString))] -> TodoState
forall a b. (a -> b) -> [a] -> [b]
map (Int, (ByteString, ByteString)) -> (ByteString, ByteString)
forall a b. (a, b) -> b
snd ([(Int, (ByteString, ByteString))] -> LBState (Cmd Todo))
-> (LBState (Cmd Todo) -> [(Int, (ByteString, ByteString))])
-> LBState (Cmd Todo)
-> LBState (Cmd Todo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (ByteString, ByteString)) -> Bool)
-> [(Int, (ByteString, ByteString))]
-> [(Int, (ByteString, ByteString))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n) (Int -> Bool)
-> ((Int, (ByteString, ByteString)) -> Int)
-> (Int, (ByteString, ByteString))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (ByteString, ByteString)) -> Int
forall a b. (a, b) -> a
fst) ([(Int, (ByteString, ByteString))]
-> [(Int, (ByteString, ByteString))])
-> (TodoState -> [(Int, (ByteString, ByteString))])
-> TodoState
-> [(Int, (ByteString, ByteString))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> TodoState -> [(Int, (ByteString, ByteString))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (LBState (Cmd Todo) -> LBState (Cmd Todo))
-> LBState (Cmd Todo) -> LBState (Cmd Todo)
forall a b. (a -> b) -> a -> b
$ LBState (Cmd Todo)
ls)
let (ByteString
a,ByteString
_) = TodoState
LBState (Cmd Todo)
ls TodoState -> Int -> (ByteString, ByteString)
forall a. HasCallStack => [a] -> Int -> a
!! Int
n
String -> Cmd Todo String
forall a. a -> Cmd Todo a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Removed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
P.unpack ByteString
a))
| Bool
otherwise = String -> Cmd Todo ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Syntax error. @todo <n>, where n :: Int"