{-# 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 = Module TodoState
forall st. Module st
newModule
    { moduleDefState :: LB TodoState
moduleDefState  = TodoState -> LB TodoState
forall (m :: * -> *) a. Monad m => a -> m a
return ([] :: TodoState)
    , moduleSerialize :: Maybe (Serial TodoState)
moduleSerialize = Serial TodoState -> Maybe (Serial TodoState)
forall a. a -> Maybe a
Just Serial TodoState
assocListPackedSerial

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

-- | Print todo list
getTodo :: String -> Cmd Todo ()
getTodo :: String -> Cmd (ModuleT TodoState LB) ()
getTodo [] = Cmd (ModuleT TodoState LB) TodoState
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS Cmd (ModuleT TodoState LB) TodoState
-> (TodoState -> Cmd (ModuleT TodoState LB) ())
-> Cmd (ModuleT TodoState LB) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TodoState -> Cmd (ModuleT TodoState LB) ()
sayTodo
getTodo String
_  = String -> Cmd (ModuleT TodoState LB) ()
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 (ModuleT TodoState LB) ()
sayTodo [] = String -> Cmd (ModuleT TodoState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Nothing to do!"
sayTodo TodoState
todoList = String -> Cmd (ModuleT TodoState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT TodoState LB) ())
-> ([String] -> String)
-> [String]
-> Cmd (ModuleT TodoState LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> Cmd (ModuleT TodoState LB) ())
-> Cmd (ModuleT TodoState LB) [String]
-> Cmd (ModuleT TodoState LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int
 -> (ByteString, ByteString) -> Cmd (ModuleT TodoState LB) String)
-> [Int] -> TodoState -> Cmd (ModuleT TodoState LB) [String]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int
-> (ByteString, ByteString) -> Cmd (ModuleT TodoState LB) 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 (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 ]

-- | Add new entry to list
addTodo :: String -> Cmd Todo ()
addTodo :: String -> Cmd (ModuleT TodoState LB) ()
addTodo String
rest = do
    ByteString
sender <- (Nick -> ByteString)
-> Cmd (ModuleT TodoState LB) Nick
-> Cmd (ModuleT TodoState LB) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Nick -> ByteString
packNick Cmd (ModuleT TodoState LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    (LBState (Cmd (ModuleT TodoState LB))
 -> LBState (Cmd (ModuleT TodoState LB)))
-> Cmd (ModuleT TodoState LB) ()
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 (ModuleT TodoState LB) ()
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 (ModuleT TodoState LB) ()
delTodo String
rest
    | Just Int
n <- String -> Maybe Int
forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM String
rest = String -> Cmd (ModuleT TodoState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT TodoState LB) ())
-> Cmd (ModuleT TodoState LB) String
-> Cmd (ModuleT TodoState LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (LBState (Cmd (ModuleT TodoState LB))
 -> (LBState (Cmd (ModuleT TodoState LB))
     -> Cmd (ModuleT TodoState LB) ())
 -> Cmd (ModuleT TodoState LB) String)
-> Cmd (ModuleT TodoState LB) String
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS (\LBState (Cmd (ModuleT TodoState LB))
ls LBState (Cmd (ModuleT TodoState LB))
-> Cmd (ModuleT TodoState LB) ()
write -> case () of
          ()
_ | TodoState -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TodoState
LBState (Cmd (ModuleT TodoState LB))
ls -> String -> Cmd (ModuleT TodoState LB) String
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 (t :: * -> *) a. Foldable t => t a -> Int
length TodoState
LBState (Cmd (ModuleT TodoState LB))
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 (ModuleT TodoState LB) String
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 (ModuleT TodoState LB))
-> Cmd (ModuleT TodoState LB) ()
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))] -> TodoState)
-> (TodoState -> [(Int, (ByteString, ByteString))])
-> TodoState
-> TodoState
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..] (TodoState -> TodoState) -> TodoState -> TodoState
forall a b. (a -> b) -> a -> b
$ TodoState
LBState (Cmd (ModuleT TodoState LB))
ls)
                let (ByteString
a,ByteString
_) = TodoState
LBState (Cmd (ModuleT TodoState LB))
ls TodoState -> Int -> (ByteString, ByteString)
forall a. [a] -> Int -> a
!! Int
n
                String -> Cmd (ModuleT TodoState LB) String
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 (ModuleT TodoState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Syntax error. @todo <n>, where n :: Int"