{-# LANGUAGE PatternGuards #-}
-- | A todo list
--
-- (c) 2005 Samuel Bronson
module Lambdabot.Plugin.Misc.Todo (todoPlugin) where

import Lambdabot.Compat.PackedNick
import Lambdabot.Plugin
import Control.Monad
import qualified Data.ByteString.Char8 as P

-- A list of key/elem pairs with an ordering determined by its position in the list
type TodoState = [(P.ByteString, P.ByteString)]
type Todo = ModuleT TodoState LB

todoPlugin :: Module TodoState
todoPlugin :: Module TodoState
todoPlugin = forall st. Module st
newModule
    { moduleDefState :: LB TodoState
moduleDefState  = forall (m :: * -> *) a. Monad m => a -> m a
return ([] :: TodoState)
    , moduleSerialize :: Maybe (Serial TodoState)
moduleSerialize = forall a. a -> Maybe a
Just Serial TodoState
assocListPackedSerial

    , moduleCmds :: ModuleT TodoState LB [Command Todo]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"todo")
            { help :: Cmd Todo ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"todo. List todo entries"
            , process :: String -> Cmd Todo ()
process = String -> Cmd Todo ()
getTodo
            }
        , (String -> Command Identity
command String
"todo-add")
            { help :: Cmd Todo ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"todo-add <idea>. Add a todo entry"
            , process :: String -> Cmd Todo ()
process = String -> Cmd Todo ()
addTodo
            }
        , (String -> Command Identity
command String
"todo-delete")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd Todo ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"todo-delete <n>. Delete a todo entry (for admins)"
            , process :: String -> Cmd Todo ()
process = String -> Cmd Todo ()
delTodo
            }
        ]
    }

-- | Print todo list
getTodo :: String -> Cmd Todo ()
getTodo :: String -> Cmd Todo ()
getTodo [] = forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TodoState -> Cmd Todo ()
sayTodo
getTodo String
_  = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"@todo has no args, try @todo-add or @list todo"

-- | Pretty print todo list
sayTodo :: [(P.ByteString, P.ByteString)] -> Cmd Todo ()
sayTodo :: TodoState -> Cmd Todo ()
sayTodo [] = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Nothing to do!"
sayTodo TodoState
todoList = forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM 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 <- forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick (ByteString -> Nick
unpackNick ByteString
nick_)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
                [ forall a. Show a => a -> String
show a
n,String
". ", String
nick ,String
": ",ByteString -> String
P.unpack ByteString
idea ]

-- | Add new entry to list
addTodo :: String -> Cmd Todo ()
addTodo :: String -> Cmd Todo ()
addTodo String
rest = do
    ByteString
sender <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Nick -> ByteString
packNick forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS (forall a. [a] -> [a] -> [a]
++[(String -> ByteString
P.pack String
rest, ByteString
sender)])
    forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Entry added to the todo list"

-- | Delete an entry from the list
delTodo :: String -> Cmd Todo ()
delTodo :: String -> Cmd Todo ()
delTodo String
rest
    | Just Int
n <- forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM String
rest = forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
          ()
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null LBState (Cmd Todo)
ls -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"Todo list is empty"
            | Int
n forall a. Ord a => a -> a -> Bool
> forall (t :: * -> *) a. Foldable t => t a -> Int
length LBState (Cmd Todo)
ls forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
|| Int
n forall a. Ord a => a -> a -> Bool
< Int
0
            -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" is out of range")

            | Bool
otherwise -> do
                LBState (Cmd Todo) -> Cmd Todo ()
write (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$ LBState (Cmd Todo)
ls)
                let (ByteString
a,ByteString
_) = LBState (Cmd Todo)
ls forall a. [a] -> Int -> a
!! Int
n
                forall (m :: * -> *) a. Monad m => a -> m a
return (String
"Removed: " forall a. [a] -> [a] -> [a]
++ ByteString -> String
P.unpack ByteString
a))

    | Bool
otherwise = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Syntax error. @todo <n>, where n :: Int"