display choices horizontal instead of vertical

noodle.cabal

@@ -23,6 +23,6 @@ executable noodle
   -- other-extensions:    
   build-depends:       base >=4.7 && <4.8, scotty, blaze-html, monads-tf,
                        persistent, persistent-sqlite, time, transformers,
-                       persistent-template, resourcet, text
+                       persistent-template, resourcet, text, containers
   hs-source-dirs:      src
   default-language:    Haskell2010

noodle.css

@@ -59,3 +59,17 @@ h4 {
 .voters {
   padding-left: 20px;
 }
+
+.true {
+  background-color: #BCF5A9;
+  color: #fff;
+  text-align: center;
+}
+
+.false {
+  background-color: #F5BCA9;
+}
+
+.checker {
+  text-align: center;
+}

src/Noodle/Views/Show.hs

@@ -6,6 +6,7 @@ import Text.Blaze.Html5 as H
 import Text.Blaze.Html5.Attributes as A
 import Text.Blaze.Html.Renderer.Text
 import Data.List (intercalate)
+import Data.Map as M hiding ((!))
 
 render (pollId, pollName, pollDesc) options voters errors = do
   H.html $ do
@@ -15,31 +16,43 @@ render (pollId, pollName, pollDesc) options voters errors = do
     H.body $ do
       H.h3 $ toHtml pollName
       mapM_ (\x-> do H.toHtml x; H.br) (lines pollDesc)
-      H.h4 "Options"
+      H.br
       mapM_ renderErrors errors
       H.form ! A.method "post" !
         A.action (H.stringValue ("/polls/" ++ (show pollId) ++ "/vote")) $ do
         H.table $ do
-          mapM_ (renderLn) (zip options voters)
+          H.tr $ do
+            H.td "Voted by"
+            mapM_ renderOption options
+          mapM_ renderVoter $ M.keys voters
+          H.tr $ do
+            H.td $ do
               H.input ! A.class_ "input" ! A.placeholder "Vote as" ! A.name "name"
+            mapM_ renderCheckbox options
         H.input ! A.class_ "btn" ! A.type_ "submit" ! A.value "Vote"
-      H.br
       H.a ! A.class_ "btn" ! A.href "/polls" $ "Back"
       H.a ! A.class_ "btn" !
         A.href (H.stringValue ("/polls/" ++ (show pollId) ++ "/edit")) $ "Edit"
-  where renderLn ((id, name, desc), (_, voters)) = do
-          H.tr $ do
-            H.td $ do
-              H.p $ H.toHtml $ (show (length voters))
-            H.td $ do
-              H.input ! A.name "option_id" ! A.value (H.stringValue (show id)) !
-                A.type_ "checkbox"
+  where renderOption (id, name, desc) = do
           H.td $ do
             H.b $ H.toHtml $ name
             H.br
             H.toHtml desc
-            H.td ! A.class_ "voters" $ do
-              H.p $ H.toHtml $ intercalate ", " voters
+        renderCheckbox (id, _, _) = do
+          H.td ! A.class_ "checker" $ do
+            H.input ! A.name "option_id" !
+              A.value (H.stringValue (show id)) !
+              A.type_ "checkbox"
+        renderVoter voter = do
+          H.tr $ do
+            H.td $ H.toHtml voter
+            mapM_ (\ (id, _, _) ->
+              case M.lookup voter voters of
+                Just ids -> do if (id `elem` ids)
+                                 then H.td ! A.class_ "true" $ "✓"
+                                 else H.td ! A.class_ "false" $ ""
+                Nothing -> H.td ""
+              ) options
         renderErrors error = do
           H.p ! A.class_ "error" $ error
           H.br

src/main.hs

@@ -19,6 +19,7 @@ import Database.Persist.Sqlite
 import Database.Persist.TH
 import Control.Monad.IO.Class (liftIO)
 import Data.Time
+import qualified Data.Map as M
 import Data.Text.Lazy as T (unpack, pack)
 import Data.Monoid (mconcat)
 
@@ -75,7 +76,7 @@ scottySite = do
       poll <- liftIO $ getPollById id
       name <- S.param "name" :: S.ActionM String
       options <- liftIO $ getOptionsByPollId id
-      voters <- liftIO $ getVotersByOptionIds (optionIds options)
+      voters <- liftIO $ getVotesByOptionIds (optionIds options)
       all_params <- S.params
       let choosen_opt_ids = foldl (\ acc (key, value) -> if key == "option_id"
           then (T.unpack value):acc
@@ -83,7 +84,7 @@ scottySite = do
 
       case name of
         "" -> blaze $ Noodle.Views.Show.render (pollValues $ head poll)
-                (optionsValues options) (voterValues voters) ["Vote needs a name"]
+                (optionsValues options) (getVoteNames voters) ["Vote needs a name"]
         otherwise -> do
           voteForOptions name (optionIds options) choosen_opt_ids
           S.redirect $ T.pack $ "/polls/" ++ id
@@ -97,9 +98,9 @@ scottySite = do
       id <- S.param "id"
       poll <- liftIO $ getPollById id
       options <- liftIO $ getOptionsByPollId id
-      voters <- liftIO $ getVotersByOptionIds (optionIds options)
+      voters <- liftIO $ getVotesByOptionIds (optionIds options)
       blaze $ Noodle.Views.Show.render (pollValues $ head poll)
-        (optionsValues options) (voterValues voters) []
+        (optionsValues options) (getVoteNames voters) []
     S.post "/polls/:id/update" $ do
       id <- S.param "id"
       name <- S.param "name"
@@ -127,7 +128,6 @@ scottySite = do
       pId <- S.param "id":: S.ActionM String
       poll <- liftIO $ getPollById pId
       options <- liftIO $ getOptionsByPollId pId
-      voters <- liftIO $ getVotersByOptionIds (optionIds options)
       case name of
         "" -> do blaze $ Noodle.Views.Edit.render (pollValues $ head poll)
                    (optionsValues options) [ "Option needs a name" ]
@@ -181,14 +181,26 @@ createOption pId name desc = do
   runSqlite "noodle.db" $ do
     insert $ Option (toSqlKey (read pId)) name desc
 
-getVotersByOptionIds ids = do
-  mapM (\ oId -> do
+getVotesByOptionIds ids = do
+  votes <- mapM (\ oId -> do
     voters <- getVotersByOptionId oId
-    return (oId, voters)) ids
+    return (voters)) ids
+  let flat_votes = foldl (\acc x -> foldl (\a y -> y:a) acc x) [] votes
+  return flat_votes
+
+getVoteNames votes = foldl voteNameMap M.empty votes
+
+voteNameMap acc vote =
+  case M.lookup vName acc of
+    Just ids -> M.insert vName (vOptId:ids) acc
+    Nothing -> M.insert vName (vOptId:[]) acc
+  where vName = voterName vote
+        vOptId = unSqlBackendKey $ unOptionKey $ voterOptId vote
 
 voterValues = map (\(oId, voters) -> (oId, (map voterName voters)))
 
 voterName vote = (voteVoter (entityVal vote))
+voterOptId vote = (voteOptionId (entityVal vote))
 
 getVotersByOptionId oId =
   runSqlite "noodle.db" $ do