Changed Styling. Added category id to responses
This commit is contained in:
parent
a974a59121
commit
d52c401206
GPG Key ID:
45AC398F44F0DAFE
@ -43,7 +43,8 @@ getPostListing c page = do
|
||||
let sub = ("subtext", toJSString $ fromSql subtext)
|
||||
let cat = ("category", toJSString category)
|
||||
let id = ("id", toJSString $ show $ (fromSql pid::Int))
|
||||
return $ showJSON $ toJSObject [id, title, sub, cat]
|
||||
let catid = ("catid", toJSString $ fromSql cid)
|
||||
return $ showJSON $ toJSObject [id, title, sub, cat, catid]
|
||||
) result
|
||||
return $ Just $ showJSON $ JSArray posts
|
||||
|
||||
@ -75,7 +76,8 @@ getPostsInCategory c cat page = do
|
||||
let sub = ("subtext", toJSString $ fromSql subtext)
|
||||
let id = ("id", toJSString $ show $ (fromSql pid::Int))
|
||||
let cat = ("category", toJSString category)
|
||||
return $ showJSON $ toJSObject [id, cat, title, sub]
|
||||
let catid = ("catid", toJSString $ fromSql cid)
|
||||
return $ showJSON $ toJSObject [id, cat, title, sub, catid]
|
||||
) result
|
||||
|
||||
return $ Just $ showJSON $ toJSObject [("category", showJSON $ toJSString category), ("posts", showJSON $ JSArray posts)]
|
||||
@ -92,7 +94,8 @@ getPostContent c pid = do
|
||||
let title = ("title", toJSString $ fromSql t)
|
||||
let content = ("content", toJSString $ fromSql con)
|
||||
let cat = ("category", toJSString category)
|
||||
return $ Just $ showJSON $ toJSObject [title, content, cat];
|
||||
let catid = ("catid", toJSString $ fromSql cid)
|
||||
return $ Just $ showJSON $ toJSObject [title, content, cat, catid];
|
||||
_ -> fail "Post does not exist!"
|
||||
|
||||
main :: IO ()
|
||||
|
||||
@ -1,15 +1,18 @@
|
||||
module Main exposing (..)
|
||||
|
||||
import Http
|
||||
import Json.Decode exposing (Decoder, field, string, map2, map3, map4)
|
||||
import Json.Decode exposing (Decoder, field, string, map2, map3, map4, map5)
|
||||
|
||||
import Browser
|
||||
import Browser.Navigation exposing (..)
|
||||
import Url
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onInput, onClick)
|
||||
|
||||
import Url.Parser as P exposing ((</>))
|
||||
import Http exposing (multipartBody)
|
||||
import Http exposing (stringPart)
|
||||
|
||||
main : Program () Model Msg
|
||||
main =
|
||||
@ -22,27 +25,16 @@ main =
|
||||
onUrlChange = UrlChanged
|
||||
}
|
||||
|
||||
type alias Post = {
|
||||
id: String,
|
||||
category: String,
|
||||
title: String,
|
||||
subtext: String
|
||||
}
|
||||
|
||||
type alias Category = {
|
||||
id: String,
|
||||
name: String
|
||||
}
|
||||
|
||||
type alias Model = {
|
||||
header: String,
|
||||
content: String,
|
||||
footer: String,
|
||||
pinnedPosts: List Post,
|
||||
posts: List Post,
|
||||
route: Maybe Route,
|
||||
key: Browser.Navigation.Key,
|
||||
errMessage: Maybe (String)
|
||||
type alias Post = {
|
||||
id: String,
|
||||
category: Category,
|
||||
title: String,
|
||||
subtext: String
|
||||
}
|
||||
|
||||
type Route
|
||||
@ -50,9 +42,9 @@ type Route
|
||||
| CategoriesView
|
||||
| CategoryView String
|
||||
| PostView String
|
||||
| Login
|
||||
| Logout
|
||||
| CreatePost
|
||||
| LoginView
|
||||
| LogoutView
|
||||
| CreatePostView
|
||||
|
||||
routeParser : P.Parser (Route -> a) a
|
||||
routeParser =
|
||||
@ -61,46 +53,15 @@ routeParser =
|
||||
, P.map CategoriesView (P.s "categories")
|
||||
, P.map CategoryView (P.s "category" </> P.string)
|
||||
, P.map PostView (P.s "post" </> P.string)
|
||||
, P.map Login (P.s "login")
|
||||
, P.map Logout (P.s "logout")
|
||||
, P.map CreatePost (P.s "create")
|
||||
, P.map LoginView (P.s "login")
|
||||
, P.map LogoutView (P.s "logout")
|
||||
, P.map CreatePostView (P.s "create")
|
||||
]
|
||||
|
||||
messageOfRoute : Maybe Route -> Cmd Msg
|
||||
messageOfRoute r =
|
||||
case r of
|
||||
Just route ->
|
||||
case route of
|
||||
Home -> Http.get {url = "/v1/posts", expect = Http.expectJson GotPosts processPostListing}
|
||||
CategoriesView -> Http.get {url = "/v1/categories", expect = Http.expectJson GotCategories processCategoryListing}
|
||||
PostView p -> Http.get {url = "/v1/post/" ++ p, expect = Http.expectJson GotPost processPost}
|
||||
CategoryView c -> Http.get {url = "/v1/category/" ++ c, expect = Http.expectJson GotCategory processCategory}
|
||||
_ -> Cmd.none
|
||||
Nothing -> Cmd.none
|
||||
|
||||
init : () -> Url.Url -> Browser.Navigation.Key -> (Model, Cmd Msg)
|
||||
init _ url key =
|
||||
let r = P.parse routeParser url in
|
||||
({
|
||||
header = "", content = "", footer = "", pinnedPosts = [],
|
||||
posts = [], route = r, key = key, errMessage = Just "Loading Posts..."
|
||||
},
|
||||
messageOfRoute r
|
||||
)
|
||||
|
||||
type Msg
|
||||
= LinkClinked Browser.UrlRequest
|
||||
| UrlChanged Url.Url
|
||||
| GotPosts (Result Http.Error (List Post))
|
||||
| GotCategories (Result Http.Error (List Category))
|
||||
| GotPost (Result Http.Error (String, String, String))
|
||||
| GotCategory (Result Http.Error (String, List Post))
|
||||
|
||||
|
||||
processPostListing : Decoder (List Post)
|
||||
processPostListing =
|
||||
Json.Decode.list (
|
||||
map4 Post (field "id" string) (field "category" string) (field "title" string) (field "subtext" string)
|
||||
map5(\a->\b->\c->\d->\e-> Post a (Category b c) d e) (field "id" string) (field "catid" string) (field "category" string) (field "title" string) (field "subtext" string)
|
||||
)
|
||||
|
||||
processCategoryListing : Decoder (List Category)
|
||||
@ -115,6 +76,61 @@ processCategory : Decoder (String, List Post)
|
||||
processCategory =
|
||||
map2 (\a -> \b -> (a,b)) (field "category" string) (field "posts" processPostListing)
|
||||
|
||||
processLogin : Decoder (String)
|
||||
processLogin =
|
||||
(field "username" string)
|
||||
messageOfRoute : Maybe Route -> Cmd Msg
|
||||
messageOfRoute r =
|
||||
case r of
|
||||
Just route ->
|
||||
case route of
|
||||
Home -> Http.get {url = "/v1/posts", expect = Http.expectJson GotPosts processPostListing}
|
||||
CategoriesView -> Http.get {url = "/v1/categories", expect = Http.expectJson GotCategories processCategoryListing}
|
||||
PostView p -> Http.get {url = "/v1/post/" ++ p, expect = Http.expectJson GotPost processPost}
|
||||
CategoryView c -> Http.get {url = "/v1/category/" ++ c, expect = Http.expectJson GotCategory processCategory}
|
||||
_ -> Cmd.none
|
||||
Nothing -> Cmd.none
|
||||
|
||||
type alias User = {
|
||||
username: String
|
||||
}
|
||||
type alias Model = {
|
||||
header: String,
|
||||
content: String,
|
||||
footer: String,
|
||||
pinnedPosts: List Post,
|
||||
posts: List Post,
|
||||
route: Maybe Route,
|
||||
key: Browser.Navigation.Key,
|
||||
errMessage: Maybe (String),
|
||||
username: String,
|
||||
password: String,
|
||||
user: Maybe User
|
||||
}
|
||||
|
||||
type Msg
|
||||
= LinkClinked Browser.UrlRequest
|
||||
| UrlChanged Url.Url
|
||||
| GotPosts (Result Http.Error (List Post))
|
||||
| GotCategories (Result Http.Error (List Category))
|
||||
| GotPost (Result Http.Error (String, String, String))
|
||||
| GotCategory (Result Http.Error (String, List Post))
|
||||
| LoginResult (Result Http.Error String)
|
||||
| Username String
|
||||
| Password String
|
||||
| Login
|
||||
|
||||
init : () -> Url.Url -> Browser.Navigation.Key -> (Model, Cmd Msg)
|
||||
init _ url key =
|
||||
let r = P.parse routeParser url in
|
||||
({
|
||||
header = "", content = "", footer = "", pinnedPosts = [],
|
||||
posts = [], route = r, key = key, errMessage = Nothing,
|
||||
username = "", password = "", user = Nothing
|
||||
},
|
||||
messageOfRoute r
|
||||
)
|
||||
|
||||
update : Msg -> Model -> (Model, Cmd Msg)
|
||||
update msg model =
|
||||
case msg of
|
||||
@ -130,8 +146,16 @@ update msg model =
|
||||
GotPosts (Ok l) -> ({model | errMessage = Nothing, posts = l}, Cmd.none)
|
||||
GotPosts (Err _) -> ({model | errMessage = Just "Failed to load posts"}, Cmd.none)
|
||||
GotPost (Ok (title, content, category)) -> ({model | errMessage = Nothing, header = title, content = content, footer = category}, Cmd.none)
|
||||
GotCategory (Ok (title, posts)) -> ({model | errMessage = Nothing, header = title, posts = posts}, Cmd.none)
|
||||
Username u -> ({model | username = u}, Cmd.none)
|
||||
Password p -> ({model | password = p}, Cmd.none)
|
||||
Login -> (model, handleLogin model)
|
||||
_ -> ({model | errMessage = Just "Something has gone horribly wrong."}, Cmd.none)
|
||||
|
||||
handleLogin : Model -> Cmd Msg
|
||||
handleLogin model =
|
||||
Http.post {url = "/v1/login", body = multipartBody [stringPart "username" model.username, stringPart "password" model.password], expect = Http.expectJson LoginResult processLogin}
|
||||
|
||||
type alias Document msg = {
|
||||
title: String,
|
||||
body: List (Html msg)
|
||||
@ -139,12 +163,29 @@ type alias Document msg = {
|
||||
|
||||
view : Model -> Document Msg
|
||||
view model =
|
||||
{title = "Xnopyt.com", body = [htmlView model]}
|
||||
{title = "XNOEBLOG", body = [htmlView model]}
|
||||
|
||||
htmlView : Model -> Html Msg
|
||||
htmlView model =
|
||||
div [
|
||||
style "flex-direction" "column",
|
||||
style "margin" "0",
|
||||
style "padding" "0"
|
||||
] [
|
||||
div [
|
||||
style "border-bottom" "2px solid black",
|
||||
style "height" "1.5em",
|
||||
style "padding" "5px"
|
||||
] ([
|
||||
a [href "/"] [text "Home"],
|
||||
text " - "
|
||||
] ++
|
||||
case model.user of
|
||||
Nothing -> [a [href "/login"] [text "Login"]]
|
||||
Just u -> [a [href "/logout"] [text "Logout"], text " - ", a [href "/create"] [text "Create Post"]]
|
||||
),
|
||||
renderModel model
|
||||
|
||||
]
|
||||
renderModel : Model -> Html Msg
|
||||
renderModel model =
|
||||
case (model.errMessage) of
|
||||
@ -152,15 +193,23 @@ renderModel model =
|
||||
Nothing ->
|
||||
case model.route of
|
||||
Just route -> case route of
|
||||
Home -> cardListing model
|
||||
PostView _ -> div [] [h1 [] [text (model.header)], p [] [text(model.content)], h3 [] [text(model.footer), a [href "/"] [text "Go Home"]]]
|
||||
Home -> div [] [h1 [] [text "Welcome to my blog."],cardListing model]
|
||||
PostView _ -> div [] [h1 [] [text (model.header)], p [] [text(model.content)], h3 [] [text(model.footer ++ " ")]]
|
||||
CategoryView _ -> div [] [h1 [] [text (model.header)], cardListing model]
|
||||
LoginView -> loginForm model
|
||||
_ -> h1 [] [ text ("Not found."), a [ href "/"] [text("Return home")] ]
|
||||
_ -> h1 [] [ text ("Not found."), a [ href "/"] [text("Return home")] ]
|
||||
cardListing : Model -> Html Msg
|
||||
cardListing model =
|
||||
div [
|
||||
style "display" "grid",
|
||||
style "grid-template-columns" "repeat(auto-fill, minmax(16rem, 1fr))"
|
||||
] (List.map renderPost model.posts)
|
||||
|
||||
renderPost : Post -> Html Msg
|
||||
renderPost post =
|
||||
div [
|
||||
style "width" "25%",
|
||||
style "max-width" "32rem",
|
||||
style "height" "auto",
|
||||
style "box-sizing" "border-box",
|
||||
style "padding" "15px"
|
||||
@ -169,12 +218,12 @@ renderPost post =
|
||||
style "flex-direction" "column",
|
||||
style "border-radius" "5px",
|
||||
style "display" "flex",
|
||||
style "height" "100%"
|
||||
style "height" "100%",
|
||||
style "border" "2px solid black",
|
||||
style "padding" "5px"
|
||||
] [
|
||||
header [
|
||||
style "background-color" "#404040",
|
||||
style "color" "white",
|
||||
style "height" "75px",
|
||||
style "min-height" "75px",
|
||||
style "display" "flex",
|
||||
style "flex-direction" "column",
|
||||
style "align-items" "center",
|
||||
@ -184,36 +233,38 @@ renderPost post =
|
||||
style "font-weight" "bold",
|
||||
style "border-radius" "10px 10px 0 0"
|
||||
] [
|
||||
a [href ("/post/" ++ post.id)] [text (post.title)]
|
||||
a [style "text-align" "center", href ("/post/" ++ post.id)] [text (post.title)]
|
||||
],
|
||||
div [
|
||||
style "color" "white",
|
||||
style "flex-grow" "1",
|
||||
style "background-color" "#505050",
|
||||
style "padding" "10px"
|
||||
] [
|
||||
text (post.subtext)
|
||||
],
|
||||
footer [
|
||||
style "background-color" "#404040",
|
||||
style "color" "white",
|
||||
style "height" "50px",
|
||||
style "min-height" "50px",
|
||||
style "display" "flex",
|
||||
style "flex-direction" "row",
|
||||
style "justify-content" "space-around",
|
||||
style "align-items" "center",
|
||||
style "box-shadow" "none",
|
||||
style "box-sizing" "border-box",
|
||||
style "padding" "10px",
|
||||
style "border-radius" "0 0 10px 10px"
|
||||
] [
|
||||
text (post.category)
|
||||
text ("Category: "), a [href ("/category/" ++ post.category.id)] [text (post.category.name)]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
cardListing : Model -> Html Msg
|
||||
cardListing model =
|
||||
div [
|
||||
style "display" "flex",
|
||||
style "flex-flow" "row wrap"
|
||||
] (List.map renderPost model.posts)
|
||||
loginForm : Model -> Html Msg
|
||||
loginForm model =
|
||||
div [] [
|
||||
viewInput "text" "username" "Username" model.username Username,
|
||||
viewInput "password" "password" "Password" model.password Password,
|
||||
button [onClick Login] [text "Login"]
|
||||
]
|
||||
|
||||
viewInput : String -> String -> String -> String -> (String -> msg) -> Html msg
|
||||
viewInput t n p v toMsg =
|
||||
input [ name n, type_ t, placeholder p, value v, onInput toMsg ] []
|
||||
Loading…
x
Reference in New Issue
Block a user