From 44b47b2564cd85bdf657a7d8e06f0230d91d557d Mon Sep 17 00:00:00 2001 From: Konrad Merz Date: Mon, 30 Mar 2015 09:09:31 +0200 Subject: [PATCH] display choices horizontal instead of vertical --- noodle.cabal | 2 +- noodle.css | 14 +++++++++++++ src/Noodle/Views/Show.hs | 45 ++++++++++++++++++++++++++-------------- src/main.hs | 28 ++++++++++++++++++------- 4 files changed, 64 insertions(+), 25 deletions(-) diff --git a/noodle.cabal b/noodle.cabal index d2da74a..c954fe4 100644 --- a/noodle.cabal +++ b/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 diff --git a/noodle.css b/noodle.css index 65bb5c1..9a432bf 100644 --- a/noodle.css +++ b/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; +} diff --git a/src/Noodle/Views/Show.hs b/src/Noodle/Views/Show.hs index b8c3937..d78245c 100644 --- a/src/Noodle/Views/Show.hs +++ b/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.input ! A.class_ "input" ! A.placeholder "Vote as" ! A.name "name" + 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 + where renderOption (id, name, desc) = do + H.td $ do + H.b $ H.toHtml $ name + H.br + H.toHtml desc + 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 $ 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" - 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 + 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 diff --git a/src/main.hs b/src/main.hs index cb6084e..4e1d1ec 100644 --- a/src/main.hs +++ b/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