Jack/rcv-site
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

cleanup

Browse source
This commit is contained in:
Jack Wines 2023-06-11 13:58:49 -07:00
parent 08fac08844
commit 4f56848dfe
1 changed files with 2 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/Main.hs
View file

@ -28,8 +28,6 @@ import qualified Network.Wai.Handler.WarpTLS as WTLS
import qualified Poll as P import qualified Poll as P
import qualified System.Environment as S import qualified System.Environment as S
staticFolderLoc = "../client/static"
getPollForBallot :: P.PollId -> AppM P.CreatePollInfo getPollForBallot :: P.PollId -> AppM P.CreatePollInfo
getPollForBallot pollId = do getPollForBallot pollId = do
db <- Rd.asks db db <- Rd.asks db
@ -47,12 +45,12 @@ getFromPollId pollId query = do
getResult :: P.PollId -> AppM P.Result getResult :: P.PollId -> AppM P.Result
getResult pollId = do getResult pollId = do
db <- Rd.asks db db <- Rd.asks db
poll :: (P.Poll) <- getFromPollId pollId (liftIO . Ac.query db . DB.GetPoll) poll :: P.Poll <- getFromPollId pollId (liftIO . Ac.query db . DB.GetPoll)
votesList <- throwOrLift Er.noVotes . maybeVotes $ poll votesList <- throwOrLift Er.noVotes . maybeVotes $ poll
pure $ P.Result . reverse . IR.solve . NE.map B.votes $ votesList pure $ P.Result . reverse . IR.solve . NE.map B.votes $ votesList
where where
-- discarding empty ballots -- discarding empty ballots
maybeVotes :: P.Poll -> Maybe (LN.NonEmpty (B.Ballot)) maybeVotes :: P.Poll -> Maybe (LN.NonEmpty B.Ballot)
maybeVotes = LN.nonEmpty . P.votes maybeVotes = LN.nonEmpty . P.votes
mapFromHash :: [T.Text] -> M.Map B.OptionHash T.Text mapFromHash :: [T.Text] -> M.Map B.OptionHash T.Text
@ -68,19 +66,15 @@ makePoll pollReq = do
with a_ [href_ fillOutLink] (toHtml fillOutLink) with a_ [href_ fillOutLink] (toHtml fillOutLink)
vote :: P.PollId -> B.Ballot -> AppM () vote :: P.PollId -> B.Ballot -> AppM ()
vote pollId ballot = do vote pollId ballot = do
db <- Rd.asks db db <- Rd.asks db
liftIO $ Ac.update db (DB.PostBallot pollId ballot) liftIO $ Ac.update db (DB.PostBallot pollId ballot)
pure () pure ()
server :: ServerT A.RCVAPI AppM server :: ServerT A.RCVAPI AppM
server = createPage :<|> makePoll :<|> pure optionInput :<|> (pure . pure $ ()) :<|> serveDirectoryWith ((defaultWebAppSettings "public")) server = createPage :<|> makePoll :<|> pure optionInput :<|> (pure . pure $ ()) :<|> serveDirectoryWith ((defaultWebAppSettings "public"))
-- makePoll :<|> getPollForBallot :<|> vote :<|> getResult :<|> serveDirectoryWith ((defaultWebAppSettings "static") {ss404Handler = Just serveIndex})
pageHead :: L.Html () pageHead :: L.Html ()
pageHead = head_ $ do pageHead = head_ $ do
link_ [href_ "/static/style.css", rel_ "stylesheet"] link_ [href_ "/static/style.css", rel_ "stylesheet"]
@ -109,11 +103,6 @@ createPage = pure $ do
with button_ [hxGet_ "create/newInput", hxTarget_ "this", hxSwap_ "beforebegin"] "add option" with button_ [hxGet_ "create/newInput", hxTarget_ "this", hxSwap_ "beforebegin"] "add option"
input_ [type_ "submit", classes_ ["paper-btn", "btn-primary"], value_ "submit"] input_ [type_ "submit", classes_ ["paper-btn", "btn-primary"], value_ "submit"]
-- notFoundPage = pure $ ("this is the 404 page")
serveIndex :: Application
serveIndex _ respond = respond $ W.responseFile status200 [(hContentType, "text/html")] ("static" <> "/index.html") Nothing
api :: Proxy A.RCVAPI api :: Proxy A.RCVAPI
api = Proxy api = Proxy