{-# LANGUAGE TypeFamilies #-}
module Lambdabot.Plugin.Social.Poll (pollPlugin) where
import Lambdabot.Plugin
import qualified Data.ByteString.Char8 as P
import Data.List
import qualified Data.Map as M
newPoll :: Poll
newPoll :: Poll
newPoll = (Bool
True,[])
appendPoll :: Choice -> Poll -> (Maybe Poll)
appendPoll :: PollName -> Poll -> Maybe Poll
appendPoll PollName
choice (Bool
o,[(PollName, Count)]
ls) = forall a. a -> Maybe a
Just (Bool
o,(PollName
choice,Count
0)forall a. a -> [a] -> [a]
:[(PollName, Count)]
ls)
voteOnPoll :: Poll -> Choice -> (Poll,String)
voteOnPoll :: Poll -> PollName -> (Poll, String)
voteOnPoll (Bool
o,[(PollName, Count)]
poll) PollName
choice =
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(PollName
x,Count
_) -> PollName
x forall a. Eq a => a -> a -> Bool
== PollName
choice) [(PollName, Count)]
poll
then ((Bool
o,forall a b. (a -> b) -> [a] -> [b]
map (\(PollName
c,Count
n) ->
if PollName
c forall a. Eq a => a -> a -> Bool
== PollName
choice then (PollName
c,Count
nforall a. Num a => a -> a -> a
+Count
1)
else (PollName
c,Count
n)) [(PollName, Count)]
poll)
,String
"voted on " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprChoice PollName
choice)
else ((Bool
o,[(PollName, Count)]
poll),PollName -> String
pprChoice PollName
choice forall a. [a] -> [a] -> [a]
++ String
" is not currently a candidate in this poll")
type Count = Int
type Choice = P.ByteString
type PollName = P.ByteString
type Poll = (Bool, [(Choice, Count)])
type VoteState = M.Map PollName Poll
type VoteWriter = VoteState -> Cmd Vote ()
type Vote = ModuleT VoteState LB
voteSerial :: Serial VoteState
voteSerial :: Serial VoteState
voteSerial = forall s.
(s -> Maybe PollName) -> (PollName -> Maybe s) -> Serial s
Serial (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Packable t => t -> PollName
showPacked) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Packable t => PollName -> t
readPacked)
pollPlugin :: Module (M.Map PollName Poll)
pollPlugin :: Module VoteState
pollPlugin = forall st. Module st
newModule
{ moduleCmds :: ModuleT VoteState LB [Command Vote]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
[ (String -> Command Identity
command String
"poll-list")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-list Shows all current polls"
, process :: String -> Cmd Vote ()
process = \String
_ -> do
String
result <- forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd Vote)
factFM LBState (Cmd Vote) -> Cmd Vote ()
writer -> VoteState -> VoteWriter -> String -> [PollName] -> Cmd Vote String
processCommand LBState (Cmd Vote)
factFM LBState (Cmd Vote) -> Cmd Vote ()
writer String
"poll-list" []
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
result
}
, (String -> Command Identity
command String
"poll-show")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-show <poll> Shows all choices for some poll"
, process :: String -> Cmd Vote ()
process = String -> String -> Cmd Vote ()
process_ String
"poll-show"
}
, (String -> Command Identity
command String
"poll-add")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-add <name> Adds a new poll, with no candidates"
, process :: String -> Cmd Vote ()
process = String -> String -> Cmd Vote ()
process_ String
"poll-add"
}
, (String -> Command Identity
command String
"choice-add")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"choice-add <poll> <choice> Adds a new choice to the given poll"
, process :: String -> Cmd Vote ()
process = String -> String -> Cmd Vote ()
process_ String
"choice-add"
}
, (String -> Command Identity
command String
"vote")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"vote <poll> <choice> Vote for <choice> in <poll>"
, process :: String -> Cmd Vote ()
process = String -> String -> Cmd Vote ()
process_ String
"vote"
}
, (String -> Command Identity
command String
"poll-result")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-result <poll> Show result for given poll"
, process :: String -> Cmd Vote ()
process = String -> String -> Cmd Vote ()
process_ String
"poll-result"
}
, (String -> Command Identity
command String
"poll-close")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-close <poll> Closes a poll"
, process :: String -> Cmd Vote ()
process = String -> String -> Cmd Vote ()
process_ String
"poll-close"
}
, (String -> Command Identity
command String
"poll-remove")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-remove <poll> Removes a poll"
, process :: String -> Cmd Vote ()
process = String -> String -> Cmd Vote ()
process_ String
"poll-remove"
}
, (String -> Command Identity
command String
"poll-reset")
{ help :: Cmd Vote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-reset <poll> Resets votes and reopens a poll"
, process :: String -> Cmd Vote ()
process = String -> String -> Cmd Vote ()
process_ String
"poll-reset"
}
]
, moduleDefState :: LB VoteState
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
M.empty
, moduleSerialize :: Maybe (Serial VoteState)
moduleSerialize = forall a. a -> Maybe a
Just Serial VoteState
voteSerial
}
process_ :: [Char] -> [Char] -> Cmd Vote ()
process_ :: String -> String -> Cmd Vote ()
process_ String
cmd [] = forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String
"Missing argument. Check @help " forall a. [a] -> [a] -> [a]
++ String
cmd forall a. [a] -> [a] -> [a]
++ String
" for info.")
process_ String
cmd String
dat
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c forall a. Ord a => a -> a -> Bool
< Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'"') String
dat
= forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Please do not use control characters or double quotes in polls."
process_ String
cmd String
dat = do
String
result <- forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd Vote)
fm LBState (Cmd Vote) -> Cmd Vote ()
writer ->
VoteState -> VoteWriter -> String -> [PollName] -> Cmd Vote String
processCommand LBState (Cmd Vote)
fm LBState (Cmd Vote) -> Cmd Vote ()
writer String
cmd (forall a b. (a -> b) -> [a] -> [b]
map String -> PollName
P.pack (String -> [String]
words String
dat))
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
result
processCommand :: VoteState -> VoteWriter -> String -> [P.ByteString] -> Cmd Vote String
processCommand :: VoteState -> VoteWriter -> String -> [PollName] -> Cmd Vote String
processCommand VoteState
fm VoteWriter
writer String
cmd [PollName]
dat = case String
cmd of
String
"poll-list" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ VoteState -> String
listPolls VoteState
fm
String
"poll-show" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [PollName]
dat of
[PollName
poll] -> VoteState -> PollName -> String
showPoll VoteState
fm PollName
poll
[PollName]
_ -> String
"usage: @poll-show <poll>"
String
"poll-add" -> case [PollName]
dat of
[PollName
poll] -> VoteState -> VoteWriter -> PollName -> Cmd Vote String
addPoll VoteState
fm VoteWriter
writer PollName
poll
[PollName]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @poll-add <poll> with \"ThisTopic\" style names"
String
"choice-add" -> case [PollName]
dat of
[PollName
poll,PollName
choice] -> VoteState -> VoteWriter -> PollName -> PollName -> Cmd Vote String
addChoice VoteState
fm VoteWriter
writer PollName
poll PollName
choice
[PollName]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @choice-add <poll> <choice>"
String
"vote" -> case [PollName]
dat of
[PollName
poll,PollName
choice] -> VoteState -> VoteWriter -> PollName -> PollName -> Cmd Vote String
vote VoteState
fm VoteWriter
writer PollName
poll PollName
choice
[PollName]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @vote <poll> <choice>"
String
"poll-result" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [PollName]
dat of
[PollName
poll] -> VoteState -> PollName -> String
showResult VoteState
fm PollName
poll
[PollName]
_ -> String
"usage: @poll-result <poll>"
String
"poll-close" -> case [PollName]
dat of
[PollName
poll] -> VoteState -> VoteWriter -> PollName -> Cmd Vote String
closePoll VoteState
fm VoteWriter
writer PollName
poll
[PollName]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @poll-close <poll>"
String
"poll-remove" -> case [PollName]
dat of
[PollName
poll] -> VoteState -> VoteWriter -> PollName -> Cmd Vote String
removePoll VoteState
fm VoteWriter
writer PollName
poll
[PollName]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @poll-remove <poll>"
String
"poll-reset" -> case [PollName]
dat of
[PollName
poll] -> VoteState -> VoteWriter -> PollName -> Cmd Vote String
resetPoll VoteState
fm VoteWriter
writer PollName
poll
[PollName]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @poll-reset <poll>"
String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"Unknown command."
listPolls :: VoteState -> String
listPolls :: VoteState -> String
listPolls VoteState
fm = forall a. (a -> String) -> [a] -> String
pprList PollName -> String
pprPoll forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall k a. Map k a -> [(k, a)]
M.toList VoteState
fm)
showPoll :: VoteState -> PollName -> String
showPoll :: VoteState -> PollName -> String
showPoll VoteState
fm PollName
poll =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PollName
poll VoteState
fm of
Maybe Poll
Nothing -> String
"No such poll: " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll forall a. [a] -> [a] -> [a]
++ String
" Use @poll-list to see the available polls."
Just Poll
p -> forall a. (a -> String) -> [a] -> String
pprList PollName -> String
pprChoice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a b. (a, b) -> b
snd Poll
p)
addPoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
addPoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
addPoll VoteState
fm VoteWriter
writer PollName
poll =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PollName
poll VoteState
fm of
Maybe Poll
Nothing -> do VoteWriter
writer forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PollName
poll Poll
newPoll VoteState
fm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"Added new poll: " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll
Just Poll
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"Poll " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll forall a. [a] -> [a] -> [a]
++
String
" already exists, choose another name for your poll"
addChoice :: VoteState -> VoteWriter -> PollName -> Choice -> Cmd Vote String
addChoice :: VoteState -> VoteWriter -> PollName -> PollName -> Cmd Vote String
addChoice VoteState
fm VoteWriter
writer PollName
poll PollName
choice = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PollName
poll VoteState
fm of
Maybe Poll
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No such poll: " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll
Just Poll
_ -> do VoteWriter
writer forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (PollName -> Poll -> Maybe Poll
appendPoll PollName
choice) PollName
poll VoteState
fm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"New candidate " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprChoice PollName
choice forall a. [a] -> [a] -> [a]
++
String
", added to poll " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll forall a. [a] -> [a] -> [a]
++ String
"."
vote :: VoteState -> VoteWriter -> PollName -> Choice -> Cmd Vote String
vote :: VoteState -> VoteWriter -> PollName -> PollName -> Cmd Vote String
vote VoteState
fm VoteWriter
writer PollName
poll PollName
choice = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PollName
poll VoteState
fm of
Maybe Poll
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No such poll: " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll
Just (Bool
False,[(PollName, Count)]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"The "forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll forall a. [a] -> [a] -> [a]
++ String
" poll is closed, sorry !"
Just p :: Poll
p@(Bool
True,[(PollName, Count)]
_) -> do let (Poll
np,String
msg) = Poll -> PollName -> (Poll, String)
voteOnPoll Poll
p PollName
choice
VoteWriter
writer forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Poll
np)) PollName
poll VoteState
fm
forall (m :: * -> *) a. Monad m => a -> m a
return String
msg
showResult :: VoteState -> PollName -> String
showResult :: VoteState -> PollName -> String
showResult VoteState
fm PollName
poll = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PollName
poll VoteState
fm of
Maybe Poll
Nothing -> String
"No such poll: " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll
Just (Bool
o,[(PollName, Count)]
p) -> String
"Poll results for " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ Bool -> String
status Bool
o forall a. [a] -> [a] -> [a]
++ String
"): "
forall a. [a] -> [a] -> [a]
++ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse String
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (PollName, a) -> String
ppr [(PollName, Count)]
p)
where
status :: Bool -> String
status Bool
s | Bool
s = String
"Open"
| Bool
otherwise = String
"Closed"
ppr :: (PollName, a) -> String
ppr (PollName
x,a
y) = PollName -> String
pprChoice PollName
x forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y
removePoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
removePoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
removePoll VoteState
fm VoteWriter
writer PollName
poll = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PollName
poll VoteState
fm of
Just (Bool
True,[(PollName, Count)]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"Poll should be closed before you can remove it."
Just (Bool
False,[(PollName, Count)]
_) -> do VoteWriter
writer forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
M.delete PollName
poll VoteState
fm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"poll " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll forall a. [a] -> [a] -> [a]
++ String
" removed."
Maybe Poll
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No such poll: " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll
closePoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
closePoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
closePoll VoteState
fm VoteWriter
writer PollName
poll = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PollName
poll VoteState
fm of
Maybe Poll
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No such poll: " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll
Just (Bool
_,[(PollName, Count)]
p) -> do VoteWriter
writer forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just (Bool
False,[(PollName, Count)]
p))) PollName
poll VoteState
fm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"Poll " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll forall a. [a] -> [a] -> [a]
++ String
" closed."
resetPoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
resetPoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
resetPoll VoteState
fm VoteWriter
writer PollName
poll = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PollName
poll VoteState
fm of
Just (Bool
_, [(PollName, Count)]
vs) -> do let np :: Poll
np = (Bool
True, forall a b. (a -> b) -> [a] -> [b]
map (\(PollName
c, Count
_) -> (PollName
c, Count
0)) [(PollName, Count)]
vs)
VoteWriter
writer forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Poll
np)) PollName
poll VoteState
fm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"Poll " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll forall a. [a] -> [a] -> [a]
++ String
" reset."
Maybe Poll
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No such poll: " forall a. [a] -> [a] -> [a]
++ PollName -> String
pprPoll PollName
poll
pprBS :: P.ByteString -> String
pprBS :: PollName -> String
pprBS PollName
p = String
"\"" forall a. [a] -> [a] -> [a]
++ PollName -> String
P.unpack PollName
p forall a. [a] -> [a] -> [a]
++ String
"\""
pprPoll :: PollName -> String
pprPoll :: PollName -> String
pprPoll = PollName -> String
pprBS
pprChoice :: Choice -> String
pprChoice :: PollName -> String
pprChoice = PollName -> String
pprBS
pprList :: (a -> String) -> [a] -> String
pprList :: forall a. (a -> String) -> [a] -> String
pprList a -> String
f [a]
as = String
"[" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a] -> [a]
intersperse String
"," (forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
as)) forall a. [a] -> [a] -> [a]
++ String
"]"