{-# LANGUAGE TypeFamilies #-}
-- | Module: Vote
-- | 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 :: String -> Poll -> (Maybe Poll)
appendPoll :: String -> Poll -> Maybe Poll
appendPoll choice :: String
choice (o :: Bool
o,ls :: [(String, Count)]
ls) = Poll -> Maybe Poll
forall a. a -> Maybe a
Just (Bool
o,(String
choice,0)(String, Count) -> [(String, Count)] -> [(String, Count)]
forall a. a -> [a] -> [a]
:[(String, Count)]
ls)

voteOnPoll :: Poll -> String -> (Poll,String)
voteOnPoll :: Poll -> String -> (Poll, String)
voteOnPoll (o :: Bool
o,poll :: [(String, Count)]
poll) choice :: String
choice =
    if ((String, Count) -> Bool) -> [(String, Count)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(x :: String
x,_) -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
choice) [(String, Count)]
poll
        then ((Bool
o,((String, Count) -> (String, Count))
-> [(String, Count)] -> [(String, Count)]
forall a b. (a -> b) -> [a] -> [b]
map (\(c :: String
c,n :: Count
n) ->
                    if String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
choice then (String
c,Count
nCount -> Count -> Count
forall a. Num a => a -> a -> a
+1)
                                   else (String
c,Count
n)) [(String, Count)]
poll)
                                        ,"voted on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
choice)
        else ((Bool
o,[(String, Count)]
poll),String -> String
forall a. Show a => a -> String
show String
choice String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is not currently a candidate in this poll")

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

type Count             = Int
type Candidate         = String
type PollName          = P.ByteString
type Poll              = (Bool, [(Candidate, 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 ByteString)
-> (ByteString -> Maybe VoteState) -> Serial VoteState
forall s.
(s -> Maybe ByteString) -> (ByteString -> Maybe s) -> Serial s
Serial (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (VoteState -> ByteString) -> VoteState -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VoteState -> ByteString
forall t. Packable t => t -> ByteString
showPacked) (VoteState -> Maybe VoteState
forall a. a -> Maybe a
Just (VoteState -> Maybe VoteState)
-> (ByteString -> VoteState) -> ByteString -> Maybe VoteState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> VoteState
forall t. Packable t => ByteString -> 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 "poll-list")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "poll-list                   Shows all current polls"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = \_ -> 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
$ \factFM :: LBState (Cmd (ModuleT VoteState LB))
factFM writer :: LBState (Cmd (ModuleT VoteState LB))
-> Cmd (ModuleT VoteState LB) ()
writer -> VoteState
-> VoteWriter
-> String
-> [String]
-> Cmd (ModuleT VoteState LB) String
processCommand VoteState
LBState (Cmd (ModuleT VoteState LB))
factFM VoteWriter
LBState (Cmd (ModuleT VoteState LB))
-> Cmd (ModuleT VoteState LB) ()
writer "poll-list" []
                String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
result
            }
        , (String -> Command Identity
command "poll-show")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "poll-show <poll>            Shows all choices for some poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ "poll-show"
            }
        , (String -> Command Identity
command "poll-add")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "poll-add <name>             Adds a new poll, with no candidates"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ "poll-add"
            }
        , (String -> Command Identity
command "choice-add")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "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_ "choice-add"
            }
        , (String -> Command Identity
command "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 "vote <poll> <choice>        Vote for <choice> in <poll>"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ "vote"
            }
        , (String -> Command Identity
command "poll-result")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "poll-result <poll>          Show result for given poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ "poll-result"
            }
        , (String -> Command Identity
command "poll-close")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "poll-close <poll>           Closes a poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ "poll-close"
            }
        , (String -> Command Identity
command "poll-remove")
            { help :: Cmd (ModuleT VoteState LB) ()
help = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "poll-remove <poll>          Removes a poll"
            , process :: String -> Cmd (ModuleT VoteState LB) ()
process = String -> String -> Cmd (ModuleT VoteState LB) ()
process_ "poll-remove"
            }
        ]

    , 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_ cmd :: String
cmd [] = String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say ("Missing argument. Check @help " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ " for info.")
process_ cmd :: String
cmd dat :: 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
$ \fm :: LBState (Cmd (ModuleT VoteState LB))
fm writer :: LBState (Cmd (ModuleT VoteState LB))
-> Cmd (ModuleT VoteState LB) ()
writer -> VoteState
-> VoteWriter
-> String
-> [String]
-> 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 -> [String]
words String
dat)
    String -> Cmd (ModuleT VoteState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
result

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

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

    -- show all current polls
    "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
    "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 [String] -> Count
forall (t :: * -> *) a. Foldable t => t a -> Count
length [String]
dat of
                        1 -> VoteState -> String -> String
showPoll VoteState
fm ([String] -> String
forall a. [a] -> a
head [String]
dat)
                        _ -> "usage: @poll-show <poll>"

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

    "choice-add"   -> case [String] -> Count
forall (t :: * -> *) a. Foldable t => t a -> Count
length [String]
dat of
                        2 -> VoteState
-> VoteWriter
-> String
-> String
-> Cmd (ModuleT VoteState LB) String
addChoice VoteState
fm VoteWriter
writer ([String] -> String
forall a. [a] -> a
head [String]
dat) ([String] -> String
forall a. [a] -> a
last [String]
dat)
                        _ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return "usage: @choice-add <poll> <choice>"

    "vote"          -> case [String] -> Count
forall (t :: * -> *) a. Foldable t => t a -> Count
length [String]
dat of
                        2 -> VoteState
-> VoteWriter
-> String
-> String
-> Cmd (ModuleT VoteState LB) String
vote VoteState
fm VoteWriter
writer ([String] -> String
forall a. [a] -> a
head [String]
dat) ([String] -> String
forall a. [a] -> a
last [String]
dat)
                        _ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return "usage: @vote <poll> <choice>"

    "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 [String] -> Count
forall (t :: * -> *) a. Foldable t => t a -> Count
length [String]
dat of
                        1 -> VoteState -> String -> String
showResult VoteState
fm ([String] -> String
forall a. [a] -> a
head [String]
dat)
                        _ -> "usage: @poll-result <poll>"

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

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

    _ -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return "Unknown command."

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

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

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

addPoll :: VoteState -> VoteWriter -> String -> Cmd Vote String
addPoll :: VoteState
-> VoteWriter -> String -> Cmd (ModuleT VoteState LB) String
addPoll fm :: VoteState
fm writer :: VoteWriter
writer poll :: String
poll =
    case ByteString -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
poll) VoteState
fm of
        Nothing -> do VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ ByteString -> Poll -> VoteState -> VoteState
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> ByteString
P.pack String
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
$ "Added new poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll
        Just _  -> 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
$ "Poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++
                            " already exists, choose another name for your poll"

addChoice :: VoteState -> VoteWriter -> String -> String -> Cmd Vote String
addChoice :: VoteState
-> VoteWriter
-> String
-> String
-> Cmd (ModuleT VoteState LB) String
addChoice fm :: VoteState
fm writer :: VoteWriter
writer poll :: String
poll choice :: String
choice = case ByteString -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
poll) VoteState
fm of
    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
$ "No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll
    Just _  -> do VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ (Poll -> Maybe Poll) -> ByteString -> VoteState -> VoteState
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (String -> Poll -> Maybe Poll
appendPoll String
choice) (String -> ByteString
P.pack String
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
$ "New candidate " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
choice String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           ", added to poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ "."

vote :: VoteState -> VoteWriter -> String -> String -> Cmd Vote String
vote :: VoteState
-> VoteWriter
-> String
-> String
-> Cmd (ModuleT VoteState LB) String
vote fm :: VoteState
fm writer :: VoteWriter
writer poll :: String
poll choice :: String
choice = case ByteString -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
poll) VoteState
fm of
    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
$ "No such poll:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll
    Just (False,_)   -> 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
$ "The "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ " poll is closed, sorry !"
    Just p :: Poll
p@(True,_)  -> do let (np :: Poll
np,msg :: String
msg) = Poll -> String -> (Poll, String)
voteOnPoll Poll
p String
choice
                           VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ (Poll -> Maybe Poll) -> ByteString -> 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)) (String -> ByteString
P.pack String
poll) VoteState
fm
                           String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
msg

showResult :: VoteState -> String -> String
showResult :: VoteState -> String -> String
showResult fm :: VoteState
fm poll :: String
poll = case ByteString -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
poll) VoteState
fm of
    Nothing     -> "No such poll: "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll
    Just (o :: Bool
o,p :: [(String, Count)]
p)  -> "Poll results for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Bool -> String
status Bool
o) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "): "
                   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]
forall a b. (a -> b) -> a -> b
$ ((String, Count) -> String) -> [(String, Count)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Count) -> String
forall a. Show a => (String, a) -> String
ppr [(String, Count)]
p)
        where
            status :: Bool -> String
status s :: Bool
s | Bool
s         = "Open"
                     | Bool
otherwise = "Closed"
            ppr :: (String, a) -> String
ppr (x :: String
x,y :: a
y) = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y

removePoll :: VoteState -> VoteWriter -> String -> Cmd Vote String
removePoll :: VoteState
-> VoteWriter -> String -> Cmd (ModuleT VoteState LB) String
removePoll fm :: VoteState
fm writer :: VoteWriter
writer poll :: String
poll = case ByteString -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
poll) VoteState
fm of
    Just (True,_)  -> String -> Cmd (ModuleT VoteState LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return "Poll should be closed before you can remove it."
    Just (False,_) -> do VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ ByteString -> VoteState -> VoteState
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (String -> ByteString
P.pack String
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
$ "poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ " removed."
    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
$ "No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll

closePoll :: VoteState -> VoteWriter -> String -> Cmd Vote String
closePoll :: VoteState
-> VoteWriter -> String -> Cmd (ModuleT VoteState LB) String
closePoll fm :: VoteState
fm writer :: VoteWriter
writer poll :: String
poll = case ByteString -> VoteState -> Maybe Poll
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
poll) VoteState
fm of
    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
$ "No such poll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll
    Just (_,p :: [(String, Count)]
p)  -> do VoteWriter
writer VoteWriter -> VoteWriter
forall a b. (a -> b) -> a -> b
$ (Poll -> Maybe Poll) -> ByteString -> 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,[(String, Count)]
p))) (String -> ByteString
P.pack String
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
$ "Poll " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
poll String -> String -> String
forall a. [a] -> [a] -> [a]
++ " closed."