creating a new poll now works
This commit is contained in:
parent
9a8f4ac092
commit
d1d01e8e3b
7 changed files with 90 additions and 25 deletions
|
|
@ -8,10 +8,13 @@
|
|||
"direct": {
|
||||
"elm/browser": "1.0.2",
|
||||
"elm/core": "1.0.5",
|
||||
"elm/html": "1.0.0"
|
||||
"elm/html": "1.0.0",
|
||||
"elm/http": "2.0.0",
|
||||
"elm/json": "1.1.3"
|
||||
},
|
||||
"indirect": {
|
||||
"elm/json": "1.1.3",
|
||||
"elm/bytes": "1.0.8",
|
||||
"elm/file": "1.0.5",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/url": "1.0.0",
|
||||
"elm/virtual-dom": "1.0.3"
|
||||
|
|
|
|||
|
|
@ -1,20 +1,35 @@
|
|||
module Main exposing (..)
|
||||
|
||||
import Array as A
|
||||
import String as S
|
||||
import Maybe as M
|
||||
import Browser
|
||||
import Html exposing (..)
|
||||
import Html.Attributes as HA
|
||||
import Html.Events as HE
|
||||
import Http
|
||||
import Json.Decode as D
|
||||
import Json.Encode as E
|
||||
import List as L
|
||||
|
||||
|
||||
main =
|
||||
Browser.sandbox { init = startPoll, update = update, view = view }
|
||||
Browser.element
|
||||
{ init = init
|
||||
, update = update
|
||||
, view = view
|
||||
, subscriptions = subscriptions
|
||||
}
|
||||
|
||||
|
||||
startPoll : Model
|
||||
startPoll =
|
||||
Creating (CreatePollInfo { title = Nothing, question = "favorite color?", options = A.fromList [ "blue", "green", "leaf" ] })
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Sub.none
|
||||
|
||||
|
||||
init : () -> ( Model, Cmd Msg )
|
||||
init _ =
|
||||
( Creating (CreatePollInfo { title = Nothing, question = "favorite color?", options = A.fromList [ "blue", "green", "leaf" ] }), Cmd.none )
|
||||
|
||||
|
||||
|
||||
|
|
@ -26,6 +41,7 @@ type Model
|
|||
| Voting CreatePollInfo
|
||||
| ViewingResults Poll
|
||||
| Creating CreatePollInfo
|
||||
| SubmitResult Int
|
||||
|
||||
|
||||
type OptionHash
|
||||
|
|
@ -34,6 +50,8 @@ type OptionHash
|
|||
|
||||
type Msg
|
||||
= NewCreatePollInfo CreatePollInfo
|
||||
| Submit
|
||||
| Submitted (Result Http.Error Int)
|
||||
|
||||
|
||||
type CreatePollInfo
|
||||
|
|
@ -43,7 +61,14 @@ type CreatePollInfo
|
|||
, options : A.Array String
|
||||
}
|
||||
|
||||
createPollInfoEncoder (CreatePollInfo createPollInfo) = E.object
|
||||
[
|
||||
("question", E.string createPollInfo.question),
|
||||
("options", E.array E.string createPollInfo.options),
|
||||
("title", M.withDefault E.null <| M.map E.string <| createPollInfo.title)
|
||||
]
|
||||
|
||||
-- ("title", E.string createPollInfo.title)
|
||||
type Poll
|
||||
= Poll
|
||||
{ createInfo : CreatePollInfo
|
||||
|
|
@ -57,12 +82,30 @@ type Ballot
|
|||
}
|
||||
|
||||
|
||||
update : Msg -> Model -> Model
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
NewCreatePollInfo newCreateInfo ->
|
||||
Creating newCreateInfo
|
||||
( Creating newCreateInfo, Cmd.none )
|
||||
|
||||
Submit ->
|
||||
case model of
|
||||
Creating createInfo ->
|
||||
( Loading
|
||||
, Http.post
|
||||
{ url = "http://localhost:8080/api/poll/create"
|
||||
, expect = (Http.expectJson Submitted D.int)
|
||||
, body = Http.jsonBody <| createPollInfoEncoder createInfo
|
||||
}
|
||||
)
|
||||
_ -> (model, Cmd.none)
|
||||
|
||||
Submitted (Ok id) ->
|
||||
(SubmitResult id, Cmd.none )
|
||||
|
||||
|
||||
Submitted (Err err) ->
|
||||
(Loading, Cmd.none )
|
||||
|
||||
viewInput : String -> String -> String -> (String -> msg) -> Html msg
|
||||
viewInput t p v toMsg =
|
||||
|
|
@ -133,21 +176,32 @@ view model =
|
|||
, L.singleton <|
|
||||
div [ HA.style "display" "flex", HA.style "flex-direction" "column" ]
|
||||
[ text "options"
|
||||
, div
|
||||
[ HA.style "display" "grid", HA.style "grid-template-columns" "auto 80px" ]
|
||||
<|
|
||||
L.concat <|
|
||||
A.toList <|
|
||||
A.indexedMap toOption createInfo.options
|
||||
, button
|
||||
[ HA.style "align-self" "start"
|
||||
, HA.class "paper-btn btn-primary-outline"
|
||||
, HE.onClick (NewCreatePollInfo (CreatePollInfo { createInfo | options = A.push "" createInfo.options }))
|
||||
, div [ HA.style "padding-left" "10px" ]
|
||||
[ div
|
||||
[ HA.style "display" "grid", HA.style "grid-template-columns" "auto 80px" ]
|
||||
<|
|
||||
L.concat <|
|
||||
A.toList <|
|
||||
A.indexedMap toOption createInfo.options
|
||||
, button
|
||||
[ HA.style "align-self" "start"
|
||||
, HA.class "paper-btn btn-primary-outline"
|
||||
, HE.onClick (NewCreatePollInfo (CreatePollInfo { createInfo | options = A.push "" createInfo.options }))
|
||||
]
|
||||
[ text "add new option" ]
|
||||
]
|
||||
[ text "add new option" ]
|
||||
]
|
||||
, L.singleton <|
|
||||
button
|
||||
[ HA.style "align-self" "start"
|
||||
, HA.class "paper-btn btn-primary"
|
||||
, HE.onClick Submit
|
||||
]
|
||||
[ text "submit" ]
|
||||
]
|
||||
|
||||
SubmitResult id -> text ("done:" ++ S.fromInt id)
|
||||
|
||||
Loading ->
|
||||
text "loading..."
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
|
|
|
|||
|
|
@ -10,8 +10,8 @@ import qualified Ballot as B
|
|||
type PollResult = [T.Text]
|
||||
|
||||
type RCVAPI =
|
||||
"poll" :> "create" :> ReqBody '[JSON] P.CreatePollInfo :> Post '[JSON] P.PollId
|
||||
:<|> "poll" :> Capture "pollId" P.PollId :> "vote" :> Get '[JSON] P.CreatePollInfo
|
||||
:<|> "poll" :> Capture "pollId" P.PollId :> "vote" :> ReqBody '[JSON] B.Ballot :> Post '[JSON] ()
|
||||
:<|> "poll" :> Capture "pollId" P.PollId :> "result" :> Get '[JSON] PollResult
|
||||
"api" :> "poll" :> "create" :> ReqBody '[JSON] P.CreatePollInfo :> Post '[JSON] P.PollId
|
||||
:<|> "api" :> "poll" :> Capture "pollId" P.PollId :> "vote" :> Get '[JSON] P.CreatePollInfo
|
||||
:<|> "api" :> "poll" :> Capture "pollId" P.PollId :> "vote" :> ReqBody '[JSON] B.Ballot :> Post '[JSON] ()
|
||||
:<|> "api" :> "poll" :> Capture "pollId" P.PollId :> "result" :> Get '[JSON] PollResult
|
||||
:<|> "static" :> Raw
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ module Database where
|
|||
|
||||
import qualified Data.Acid as Ac
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Set as S
|
||||
import qualified Control.Monad.Reader as MR
|
||||
import qualified Control.Monad.State as MS
|
||||
import qualified Data.SafeCopy as SC
|
||||
|
|
@ -35,6 +36,9 @@ createPoll createInfo = MS.state go
|
|||
getPollForBallot :: P.PollId -> Ac.Query DB (Maybe P.CreatePollInfo)
|
||||
getPollForBallot pollId = MR.asks (fmap P.createInfo . M.lookup pollId . polls)
|
||||
|
||||
getPollIds :: Ac.Query DB [P.PollId]
|
||||
getPollIds = MR.asks (M.keys . polls)
|
||||
|
||||
getPoll :: P.PollId -> Ac.Query DB (Maybe P.Poll)
|
||||
getPoll pollId = MR.asks $ M.lookup pollId . polls
|
||||
|
||||
|
|
@ -51,9 +55,9 @@ $(SC.deriveSafeCopy 0 'SC.base ''P.Poll)
|
|||
$(SC.deriveSafeCopy 0 'SC.base ''SM.SMGen)
|
||||
$(SC.deriveSafeCopy 0 'SC.base ''R.StdGen)
|
||||
$(SC.deriveSafeCopy 0 'SC.base ''DB)
|
||||
Ac.makeAcidic ''DB['createPoll, 'getPollForBallot, 'getPoll, 'postBallot]
|
||||
Ac.makeAcidic ''DB['createPoll, 'getPollForBallot, 'getPoll, 'postBallot, 'getPollIds]
|
||||
|
||||
openLocalDB :: IO (Ac.AcidState DB)
|
||||
openLocalDB = do
|
||||
gen <- R.getStdGen
|
||||
Ac.openLocalState $ DB gen M.empty
|
||||
Ac.openLocalStateFrom "state" $ DB gen M.empty
|
||||
|
|
|
|||
|
|
@ -84,4 +84,6 @@ runWithEnv = flip Rd.runReaderT
|
|||
main :: IO ()
|
||||
main = do
|
||||
env <- getEnv
|
||||
everything <- liftIO $ Ac.query (db env) DB.GetPollIds
|
||||
print everything
|
||||
W.run 8080 . serve api . hoistServer api (runWithEnv env) $ server
|
||||
|
|
|
|||
1
server/static
Symbolic link
1
server/static
Symbolic link
|
|
@ -0,0 +1 @@
|
|||
../client/static
|
||||
Loading…
Add table
Add a link
Reference in a new issue