{-# LANGUAGE TypeFamilies #-}
-- | Module: Poll
-- | Support for voting
-- |
-- | License: lGPL
-- |
-- | added by Kenneth Hoste (boegel), 22/11/2005
-- |  inspiration: Where plugin (thanks shapr,dons)
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 :: Choice -> Poll -> Maybe Poll
appendPoll Choice
choice (Bool
o,[(Choice, Count)]
ls) = Poll -> Maybe Poll
forall a. a -> Maybe a
Just (Bool
o,(Choice
choice,Count
0)(Choice, Count) -> [(Choice, Count)] -> [(Choice, Count)]
forall a. a -> [a] -> [a]
:[(Choice, Count)]
ls)

voteOnPoll :: Poll -> Choice -> (Poll,String)
voteOnPoll :: Poll -> Choice -> (Poll, String)
voteOnPoll (Bool
o,[(Choice, Count)]
poll) Choice
choice =
    if ((Choice, Count) -> Bool) -> [(Choice, Count)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Choice
x,Count
_) -> Choice
x Choice -> Choice -> Bool
forall a. Eq a => a -> a -> Bool
== Choice
choice) [(Choice, Count)]
poll
        then ((Bool
o,((Choice, Count) -> (Choice, Count))
-> [(Choice, Count)] -> [(Choice, Count)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Choice
c,Count
n) ->
                    if Choice
c Choice -> Choice -> Bool
forall a. Eq a => a -> a -> Bool
== Choice
choice then (Choice
c,Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
+Count
1)
                                   else (Choice
c,Count
n)) [(Choice, Count)]
poll)
                                        ,String
"voted on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprChoice Choice
choice)
        else ((Bool
o,[(Choice, Count)]
poll),Choice -> String
pprChoice Choice
choice String -> String -> String
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

------------------------------------------------------------------------
-- Define a serialiser

voteSerial :: Serial VoteState
voteSerial :: Serial VoteState
voteSerial = (VoteState -> Maybe Choice)
-> (Choice -> Maybe VoteState) -> Serial VoteState
forall s. (s -> Maybe Choice) -> (Choice -> Maybe s) -> Serial s
Serial (Choice -> Maybe Choice
forall a. a -> Maybe a
Just (Choice -> Maybe Choice)
-> (VoteState -> Choice) -> VoteState -> Maybe Choice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VoteState -> Choice
forall t. Packable t => t -> Choice
showPacked) (VoteState -> Maybe VoteState
forall a. a -> Maybe a
Just (VoteState -> Maybe VoteState)
-> (Choice -> VoteState) -> Choice -> Maybe VoteState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choice -> VoteState
forall t. Packable t => Choice -> t
readPacked)

------------------------------------------------------------------------

pollPlugin :: Module (M.Map PollName Poll)
pollPlugin :: Module VoteState
pollPlugin = Module VoteState
forall st. Module st
newModule
    { moduleCmds :: ModuleT VoteState LB [Command (ModuleT VoteState LB)]
moduleCmds = [Command (ModuleT VoteState LB)]
-> ModuleT VoteState LB [Command (ModuleT VoteState LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"poll-list")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-list                   Shows all current polls"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = \String
_ -> do
                String
result <- (LBState (Cmd (ModuleT VoteState LB))
 -> (LBState (Cmd (ModuleT VoteState LB))
     -> Cmd (ModuleT VoteState LB) ())
 -> Cmd (ModuleT VoteState LB) String)
-> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (Cmd (ModuleT VoteState LB))
  -> (LBState (Cmd (ModuleT VoteState LB))
      -> Cmd (ModuleT VoteState LB) ())
  -> Cmd (ModuleT VoteState LB) String)
 -> Cmd (ModuleT VoteState LB) String)
-> (LBState (Cmd (ModuleT VoteState LB))
    -> (LBState (Cmd (ModuleT VoteState LB))
        -> Cmd (ModuleT VoteState LB) ())
    -> Cmd (ModuleT VoteState LB) String)
-> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ \LBState (Cmd (ModuleT VoteState LB))
factFM LBState (Cmd (ModuleT VoteState LB))
-> Cmd (ModuleT VoteState LB) ()
writer -> VoteState
-> VoteWriter
-> String
-> [Choice]
-> Cmd (ModuleT VoteState LB) String
processCommand VoteState
LBState (Cmd (ModuleT VoteState LB))
factFM VoteWriter
LBState (Cmd (ModuleT VoteState LB))
-> Cmd (ModuleT VoteState LB) ()
writer String
"poll-list" []
                String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
result
            }
        , (String -> Command Identity
command String
"poll-show")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-show <poll>            Shows all choices for some poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
"poll-show"
            }
        , (String -> Command Identity
command String
"poll-add")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-add <name>             Adds a new poll, with no candidates"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
"poll-add"
            }
        , (String -> Command Identity
command String
"choice-add")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"choice-add <poll> <choice>  Adds a new choice to the given poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
"choice-add"
            }
        , (String -> Command Identity
command String
"vote")
            -- todo, should @vote foo automagically add foo as a possibility?
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"vote <poll> <choice>        Vote for <choice> in <poll>"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
"vote"
            }
        , (String -> Command Identity
command String
"poll-result")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-result <poll>          Show result for given poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
"poll-result"
            }
        , (String -> Command Identity
command String
"poll-close")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-close <poll>           Closes a poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
"poll-close"
            }
        , (String -> Command Identity
command String
"poll-remove")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-remove <poll>          Removes a poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
"poll-remove"
            }
        , (String -> Command Identity
command String
"poll-reset")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"poll-reset <poll>           Resets votes and reopens a poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
"poll-reset"
            }
        ]

    , moduleDefState :: LB VoteState
moduleDefState  = VoteState -> LB VoteState
forall (m :: * -> *) a. Monad m => a -> m a
return VoteState
forall k a. Map k a
M.empty
    , moduleSerialize :: Maybe (Serial VoteState)
moduleSerialize = Serial VoteState -> Maybe (Serial VoteState)
forall a. a -> Maybe a
Just Serial VoteState
voteSerial
    }

process_ :: [Char] -> [Char] -> Cmd Vote ()
process_ :: String -> String -> Cmd (ModuleT VoteState LB) ()
process_ String
cmd [] = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String
"Missing argument. Check @help " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for info.")
process_ String
cmd String
dat
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') String
dat
    = String -> Cmd (ModuleT VoteState LB) ()
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 <- (LBState (Cmd (ModuleT VoteState LB))
 -> (LBState (Cmd (ModuleT VoteState LB))
     -> Cmd (ModuleT VoteState LB) ())
 -> Cmd (ModuleT VoteState LB) String)
-> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (Cmd (ModuleT VoteState LB))
  -> (LBState (Cmd (ModuleT VoteState LB))
      -> Cmd (ModuleT VoteState LB) ())
  -> Cmd (ModuleT VoteState LB) String)
 -> Cmd (ModuleT VoteState LB) String)
-> (LBState (Cmd (ModuleT VoteState LB))
    -> (LBState (Cmd (ModuleT VoteState LB))
        -> Cmd (ModuleT VoteState LB) ())
    -> Cmd (ModuleT VoteState LB) String)
-> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ \LBState (Cmd (ModuleT VoteState LB))
fm LBState (Cmd (ModuleT VoteState LB))
-> Cmd (ModuleT VoteState LB) ()
writer ->
        VoteState
-> VoteWriter
-> String
-> [Choice]
-> Cmd (ModuleT VoteState LB) String
processCommand VoteState
LBState (Cmd (ModuleT VoteState LB))
fm VoteWriter
LBState (Cmd (ModuleT VoteState LB))
-> Cmd (ModuleT VoteState LB) ()
writer String
cmd ((String -> Choice) -> [String] -> [Choice]
forall a b. (a -> b) -> [a] -> [b]
map String -> Choice
P.pack (String -> [String]
words String
dat))
    String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
result

------------------------------------------------------------------------

processCommand :: VoteState -> VoteWriter -> String -> [P.ByteString] -> Cmd Vote String
processCommand :: VoteState
-> VoteWriter
-> String
-> [Choice]
-> Cmd (ModuleT VoteState LB) String
processCommand VoteState
fm VoteWriter
writer String
cmd [Choice]
dat = case String
cmd of

    -- show all current polls
    String
"poll-list"  -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ VoteState -> String
listPolls VoteState
fm

    -- show candidates
    String
"poll-show"    -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ case [Choice]
dat of
                        [Choice
poll] -> VoteState -> Choice -> String
showPoll VoteState
fm Choice
poll
                        [Choice]
_ -> String
"usage: @poll-show <poll>"

    -- declare a new poll
    String
"poll-add"     -> case [Choice]
dat of
                        [Choice
poll] -> VoteState
-> VoteWriter -> Choice -> Cmd (ModuleT VoteState LB) String
addPoll VoteState
fm VoteWriter
writer Choice
poll
                        [Choice]
_ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @poll-add <poll>   with \"ThisTopic\" style names"

    String
"choice-add"   -> case [Choice]
dat of
                        [Choice
poll,Choice
choice] -> VoteState
-> VoteWriter
-> Choice
-> Choice
-> Cmd (ModuleT VoteState LB) String
addChoice VoteState
fm VoteWriter
writer Choice
poll Choice
choice
                        [Choice]
_ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @choice-add <poll> <choice>"

    String
"vote"          -> case [Choice]
dat of
                        [Choice
poll,Choice
choice] -> VoteState
-> VoteWriter
-> Choice
-> Choice
-> Cmd (ModuleT VoteState LB) String
vote VoteState
fm VoteWriter
writer Choice
poll Choice
choice
                        [Choice]
_ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @vote <poll> <choice>"

    String
"poll-result"   -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ case [Choice]
dat of
                        [Choice
poll] -> VoteState -> Choice -> String
showResult VoteState
fm Choice
poll
                        [Choice]
_ -> String
"usage: @poll-result <poll>"

    String
"poll-close"    -> case [Choice]
dat of
                        [Choice
poll] -> VoteState
-> VoteWriter -> Choice -> Cmd (ModuleT VoteState LB) String
closePoll VoteState
fm VoteWriter
writer Choice
poll
                        [Choice]
_ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @poll-close <poll>"

    String
"poll-remove"   -> case [Choice]
dat of
                        [Choice
poll] -> VoteState
-> VoteWriter -> Choice -> Cmd (ModuleT VoteState LB) String
removePoll VoteState
fm VoteWriter
writer Choice
poll
                        [Choice]
_ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @poll-remove <poll>"

    String
"poll-reset"    -> case [Choice]
dat of
                        [Choice
poll] -> VoteState
-> VoteWriter -> Choice -> Cmd (ModuleT VoteState LB) String
resetPoll VoteState
fm VoteWriter
writer Choice
poll
                        [Choice]
_ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"usage: @poll-reset <poll>"
    String
_ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Unknown command."

------------------------------------------------------------------------

listPolls :: VoteState -> String
listPolls :: VoteState -> String
listPolls VoteState
fm = (Choice -> String) -> [Choice] -> String
forall a. (a -> String) -> [a] -> String
pprList Choice -> String
pprPoll ([Choice] -> String) -> [Choice] -> String
forall a b. (a -> b) -> a -> b
$ ((Choice, Poll) -> Choice) -> [(Choice, Poll)] -> [Choice]
forall a b. (a -> b) -> [a] -> [b]
map (Choice, Poll) -> Choice
forall a b. (a, b) -> a
fst (VoteState -> [(Choice, Poll)]
forall k a. Map k a -> [(k, a)]
M.toList VoteState
fm)

showPoll :: VoteState -> PollName -> String
showPoll :: VoteState -> Choice -> String
showPoll VoteState
fm Choice
poll =
    case Choice -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Choice
poll VoteState
fm of
        Maybe Poll
Nothing -> String
"No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Use @poll-list to see the available polls."
        Just Poll
p  -> (Choice -> String) -> [Choice] -> String
forall a. (a -> String) -> [a] -> String
pprList Choice -> String
pprChoice ([Choice] -> String) -> [Choice] -> String
forall a b. (a -> b) -> a -> b
$ ((Choice, Count) -> Choice) -> [(Choice, Count)] -> [Choice]
forall a b. (a -> b) -> [a] -> [b]
map (Choice, Count) -> Choice
forall a b. (a, b) -> a
fst (Poll -> [(Choice, Count)]
forall a b. (a, b) -> b
snd Poll
p)

addPoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
addPoll :: VoteState
-> VoteWriter -> Choice -> Cmd (ModuleT VoteState LB) String
addPoll VoteState
fm VoteWriter
writer Choice
poll =
    case Choice -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Choice
poll VoteState
fm of
        Maybe Poll
Nothing -> do VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ Choice -> Poll -> VoteState -> VoteState
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Choice
poll Poll
newPoll VoteState
fm
                      String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"Added new poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll
        Just Poll
_  -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"Poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll String -> String -> String
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
-> Choice
-> Choice
-> Cmd (ModuleT VoteState LB) String
addChoice VoteState
fm VoteWriter
writer Choice
poll Choice
choice = case Choice -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Choice
poll VoteState
fm of
    Maybe Poll
Nothing -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll
    Just Poll
_  -> do VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ (Poll -> Maybe Poll) -> Choice -> VoteState -> VoteState
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (Choice -> Poll -> Maybe Poll
appendPoll Choice
choice) Choice
poll VoteState
fm
                  String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"New candidate " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprChoice Choice
choice String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String
", added to poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."

vote :: VoteState -> VoteWriter -> PollName -> Choice -> Cmd Vote String
vote :: VoteState
-> VoteWriter
-> Choice
-> Choice
-> Cmd (ModuleT VoteState LB) String
vote VoteState
fm VoteWriter
writer Choice
poll Choice
choice = case Choice -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Choice
poll VoteState
fm of
    Maybe Poll
Nothing          -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll
    Just (Bool
False,[(Choice, Count)]
_)   -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"The "String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" poll is closed, sorry !"
    Just p :: Poll
p@(Bool
True,[(Choice, Count)]
_)  -> do let (Poll
np,String
msg) = Poll -> Choice -> (Poll, String)
voteOnPoll Poll
p Choice
choice
                           VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ (Poll -> Maybe Poll) -> Choice -> VoteState -> VoteState
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (Maybe Poll -> Poll -> Maybe Poll
forall a b. a -> b -> a
const (Poll -> Maybe Poll
forall a. a -> Maybe a
Just Poll
np)) Choice
poll VoteState
fm
                           String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
msg

showResult :: VoteState -> PollName -> String
showResult :: VoteState -> Choice -> String
showResult VoteState
fm Choice
poll = case Choice -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Choice
poll VoteState
fm of
    Maybe Poll
Nothing     -> String
"No such poll: "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll
    Just (Bool
o,[(Choice, Count)]
p)  -> String
"Poll results for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
status Bool
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): "
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Choice, Count) -> String) -> [(Choice, Count)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Choice, Count) -> String
forall a. Show a => (Choice, a) -> String
ppr [(Choice, Count)]
p)
        where
            status :: Bool -> String
status Bool
s | Bool
s         = String
"Open"
                     | Bool
otherwise = String
"Closed"
            ppr :: (Choice, a) -> String
ppr (Choice
x,a
y) = Choice -> String
pprChoice Choice
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y

removePoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
removePoll :: VoteState
-> VoteWriter -> Choice -> Cmd (ModuleT VoteState LB) String
removePoll VoteState
fm VoteWriter
writer Choice
poll = case Choice -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Choice
poll VoteState
fm of
    Just (Bool
True,[(Choice, Count)]
_)  -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Poll should be closed before you can remove it."
    Just (Bool
False,[(Choice, Count)]
_) -> do VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ Choice -> VoteState -> VoteState
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Choice
poll VoteState
fm
                         String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" removed."
    Maybe Poll
Nothing        -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll

closePoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
closePoll :: VoteState
-> VoteWriter -> Choice -> Cmd (ModuleT VoteState LB) String
closePoll VoteState
fm VoteWriter
writer Choice
poll = case Choice -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Choice
poll VoteState
fm of
    Maybe Poll
Nothing     -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll
    Just (Bool
_,[(Choice, Count)]
p)  -> do VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ (Poll -> Maybe Poll) -> Choice -> VoteState -> VoteState
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (Maybe Poll -> Poll -> Maybe Poll
forall a b. a -> b -> a
const (Poll -> Maybe Poll
forall a. a -> Maybe a
Just (Bool
False,[(Choice, Count)]
p))) Choice
poll VoteState
fm
                      String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"Poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" closed."

resetPoll :: VoteState -> VoteWriter -> PollName -> Cmd Vote String
resetPoll :: VoteState
-> VoteWriter -> Choice -> Cmd (ModuleT VoteState LB) String
resetPoll VoteState
fm VoteWriter
writer Choice
poll = case Choice -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Choice
poll VoteState
fm of
    Just (Bool
_, [(Choice, Count)]
vs)   -> do let np :: Poll
np = (Bool
True, ((Choice, Count) -> (Choice, Count))
-> [(Choice, Count)] -> [(Choice, Count)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Choice
c, Count
_) -> (Choice
c, Count
0)) [(Choice, Count)]
vs)
                         VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ (Poll -> Maybe Poll) -> Choice -> VoteState -> VoteState
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (Maybe Poll -> Poll -> Maybe Poll
forall a b. a -> b -> a
const (Poll -> Maybe Poll
forall a. a -> Maybe a
Just Poll
np)) Choice
poll VoteState
fm
                         String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"Poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" reset."
    Maybe Poll
Nothing        -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT VoteState LB) String)
-> String -> Cmd (ModuleT VoteState LB) String
forall a b. (a -> b) -> a -> b
$ String
"No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
pprPoll Choice
poll

------------------------------------------------------------------------

-- we render strings verbatim but surround them with quotes,
-- relying on previous sanitization to disallow control characters
pprBS :: P.ByteString -> String
pprBS :: Choice -> String
pprBS Choice
p = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Choice -> String
P.unpack Choice
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

pprPoll :: PollName -> String
pprPoll :: Choice -> String
pprPoll = Choice -> String
pprBS

pprChoice :: Choice -> String
pprChoice :: Choice -> String
pprChoice = Choice -> String
pprBS

pprList :: (a -> String) -> [a] -> String
pprList :: (a -> String) -> [a] -> String
pprList a -> String
f [a]
as = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"," ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
as)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"