cleanup
This commit is contained in:
parent
08fac08844
commit
4f56848dfe
1 changed files with 2 additions and 13 deletions
15
src/Main.hs
15
src/Main.hs
|
|
@ -28,8 +28,6 @@ import qualified Network.Wai.Handler.WarpTLS as WTLS
|
|||
import qualified Poll as P
|
||||
import qualified System.Environment as S
|
||||
|
||||
staticFolderLoc = "../client/static"
|
||||
|
||||
getPollForBallot :: P.PollId -> AppM P.CreatePollInfo
|
||||
getPollForBallot pollId = do
|
||||
db <- Rd.asks db
|
||||
|
|
@ -47,12 +45,12 @@ getFromPollId pollId query = do
|
|||
getResult :: P.PollId -> AppM P.Result
|
||||
getResult pollId = do
|
||||
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
|
||||
pure $ P.Result . reverse . IR.solve . NE.map B.votes $ votesList
|
||||
where
|
||||
-- discarding empty ballots
|
||||
maybeVotes :: P.Poll -> Maybe (LN.NonEmpty (B.Ballot))
|
||||
maybeVotes :: P.Poll -> Maybe (LN.NonEmpty B.Ballot)
|
||||
maybeVotes = LN.nonEmpty . P.votes
|
||||
|
||||
mapFromHash :: [T.Text] -> M.Map B.OptionHash T.Text
|
||||
|
|
@ -68,19 +66,15 @@ makePoll pollReq = do
|
|||
with a_ [href_ fillOutLink] (toHtml fillOutLink)
|
||||
|
||||
|
||||
|
||||
vote :: P.PollId -> B.Ballot -> AppM ()
|
||||
vote pollId ballot = do
|
||||
db <- Rd.asks db
|
||||
liftIO $ Ac.update db (DB.PostBallot pollId ballot)
|
||||
pure ()
|
||||
|
||||
|
||||
server :: ServerT A.RCVAPI AppM
|
||||
server = createPage :<|> makePoll :<|> pure optionInput :<|> (pure . pure $ ()) :<|> serveDirectoryWith ((defaultWebAppSettings "public"))
|
||||
|
||||
-- makePoll :<|> getPollForBallot :<|> vote :<|> getResult :<|> serveDirectoryWith ((defaultWebAppSettings "static") {ss404Handler = Just serveIndex})
|
||||
|
||||
pageHead :: L.Html ()
|
||||
pageHead = head_ $ do
|
||||
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"
|
||||
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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue