Added the ability to view posts.

This commit is contained in:
Xnoe 2022-05-19 16:10:10 +01:00
parent d71d392377
commit a974a59121
Signed by: xnoe
GPG Key ID: 45AC398F44F0DAFE
3 changed files with 111 additions and 42 deletions

View File

@ -43,7 +43,7 @@ getPostListing c page = do
let sub = ("subtext", toJSString $ fromSql subtext) let sub = ("subtext", toJSString $ fromSql subtext)
let cat = ("category", toJSString category) let cat = ("category", toJSString category)
let id = ("id", toJSString $ show $ (fromSql pid::Int)) let id = ("id", toJSString $ show $ (fromSql pid::Int))
return $ showJSON $ toJSObject [title, sub, cat] return $ showJSON $ toJSObject [id, title, sub, cat]
) result ) result
return $ Just $ showJSON $ JSArray posts return $ Just $ showJSON $ JSArray posts
@ -74,7 +74,8 @@ getPostsInCategory c cat page = do
let title = ("title", toJSString $ fromSql t) let title = ("title", toJSString $ fromSql t)
let sub = ("subtext", toJSString $ fromSql subtext) let sub = ("subtext", toJSString $ fromSql subtext)
let id = ("id", toJSString $ show $ (fromSql pid::Int)) let id = ("id", toJSString $ show $ (fromSql pid::Int))
return $ showJSON $ toJSObject [title, sub] let cat = ("category", toJSString category)
return $ showJSON $ toJSObject [id, cat, title, sub]
) result ) result
return $ Just $ showJSON $ toJSObject [("category", showJSON $ toJSString category), ("posts", showJSON $ JSArray posts)] return $ Just $ showJSON $ toJSObject [("category", showJSON $ toJSString category), ("posts", showJSON $ JSArray posts)]

View File

@ -1,7 +1,7 @@
module Main exposing (..) module Main exposing (..)
import Http import Http
import Json.Decode exposing (Decoder, field, string, map3) import Json.Decode exposing (Decoder, field, string, map2, map3, map4)
import Browser import Browser
import Browser.Navigation exposing (..) import Browser.Navigation exposing (..)
@ -9,6 +9,8 @@ import Url
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Url.Parser as P exposing ((</>))
main : Program () Model Msg main : Program () Model Msg
main = main =
Browser.application { Browser.application {
@ -20,43 +22,99 @@ main =
onUrlChange = UrlChanged onUrlChange = UrlChanged
} }
type alias GridItem = { type alias Post = {
id: String,
category: String, category: String,
title: String, title: String,
subtext: String subtext: String
} }
type alias Category = {
id: String,
name: String
}
type alias Model = { type alias Model = {
header: Maybe (Html Msg), header: String,
sidebar: Maybe (Html Msg), content: String,
pinnedPosts: List GridItem, footer: String,
posts: List GridItem, pinnedPosts: List Post,
url: Url.Url, posts: List Post,
route: Maybe Route,
key: Browser.Navigation.Key, key: Browser.Navigation.Key,
errMessage: Maybe (String) errMessage: Maybe (String)
} }
type Route
= Home
| CategoriesView
| CategoryView String
| PostView String
| Login
| Logout
| CreatePost
routeParser : P.Parser (Route -> a) a
routeParser =
P.oneOf
[ P.map Home P.top
, 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")
]
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.Url -> Browser.Navigation.Key -> (Model, Cmd Msg)
init _ url key = init _ url key =
let r = P.parse routeParser url in
({ ({
header = Nothing, sidebar = Nothing, pinnedPosts = [], posts = [], header = "", content = "", footer = "", pinnedPosts = [],
url = url, key = key, errMessage = Nothing posts = [], route = r, key = key, errMessage = Just "Loading Posts..."
}, },
Http.get {url = "v1/posts", expect = Http.expectJson GotPosts processPosts} messageOfRoute r
) )
type Msg type Msg
= LinkClinked Browser.UrlRequest = LinkClinked Browser.UrlRequest
| UrlChanged Url.Url | UrlChanged Url.Url
| GotPosts (Result Http.Error (List GridItem)) | 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))
processPosts : Decoder (List GridItem) processPostListing : Decoder (List Post)
processPosts = processPostListing =
Json.Decode.list ( Json.Decode.list (
map3 GridItem (field "category" string) (field "title" string) (field "subtext" string) map4 Post (field "id" string) (field "category" string) (field "title" string) (field "subtext" string)
) )
processCategoryListing : Decoder (List Category)
processCategoryListing =
Json.Decode.list (map2 Category (field "id" string) (field "name" string))
processPost : Decoder (String, String, String)
processPost =
map3 (\a -> \b -> \c -> (a,b,c)) (field "title" string) (field "content" string) (field "category" string)
processCategory : Decoder (String, List Post)
processCategory =
map2 (\a -> \b -> (a,b)) (field "category" string) (field "posts" processPostListing)
update : Msg -> Model -> (Model, Cmd Msg) update : Msg -> Model -> (Model, Cmd Msg)
update msg model = update msg model =
case msg of case msg of
@ -66,19 +124,41 @@ update msg model =
Browser.External url -> (model, Browser.Navigation.load url) Browser.External url -> (model, Browser.Navigation.load url)
UrlChanged req -> UrlChanged req ->
( (
{ model | url = req } let r = P.parse routeParser req in
, Cmd.none ({model | route = r}, messageOfRoute r)
) )
GotPosts (Ok l) -> ({model | posts = l}, Cmd.none) GotPosts (Ok l) -> ({model | errMessage = Nothing, posts = l}, Cmd.none)
GotPosts (Err _) -> ({model | errMessage = Just "Failed to load posts!"}, 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)
_ -> ({model | errMessage = Just "Something has gone horribly wrong."}, Cmd.none)
type alias Document msg = { type alias Document msg = {
title: String, title: String,
body: List (Html msg) body: List (Html msg)
} }
renderGridItem : GridItem -> Html Msg view : Model -> Document Msg
renderGridItem griditem = view model =
{title = "Xnopyt.com", body = [htmlView model]}
htmlView : Model -> Html Msg
htmlView model =
renderModel model
renderModel : Model -> Html Msg
renderModel model =
case (model.errMessage) of
Just e -> h1 [] [text (e)]
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"]]]
_ -> h1 [] [ text ("Not found."), a [ href "/"] [text("Return home")] ]
_ -> h1 [] [ text ("Not found."), a [ href "/"] [text("Return home")] ]
renderPost : Post -> Html Msg
renderPost post =
div [ div [
style "width" "25%", style "width" "25%",
style "height" "auto", style "height" "auto",
@ -104,7 +184,7 @@ renderGridItem griditem =
style "font-weight" "bold", style "font-weight" "bold",
style "border-radius" "10px 10px 0 0" style "border-radius" "10px 10px 0 0"
] [ ] [
text (griditem.title) a [href ("/post/" ++ post.id)] [text (post.title)]
], ],
div [ div [
style "color" "white", style "color" "white",
@ -112,7 +192,7 @@ renderGridItem griditem =
style "background-color" "#505050", style "background-color" "#505050",
style "padding" "10px" style "padding" "10px"
] [ ] [
text (griditem.subtext) text (post.subtext)
], ],
footer [ footer [
style "background-color" "#404040", style "background-color" "#404040",
@ -126,27 +206,14 @@ renderGridItem griditem =
style "padding" "10px", style "padding" "10px",
style "border-radius" "0 0 10px 10px" style "border-radius" "0 0 10px 10px"
] [ ] [
text (griditem.category) text (post.category)
] ]
] ]
] ]
renderModel : Model -> Html Msg cardListing : Model -> Html Msg
renderModel model = cardListing model =
div [ div [
style "display" "flex", style "display" "flex",
style "flex-flow" "row wrap" style "flex-flow" "row wrap"
] ] (List.map renderPost model.posts)
(case (model.errMessage) of
Nothing -> (List.map renderGridItem model.posts)
Just e -> [h1 [] [text (e)]]
)
view : Model -> Document Msg
view model =
{title = "Xnopyt.com", body = [htmlView model]}
htmlView : Model -> Html Msg
htmlView model =
renderModel model

View File

@ -11,7 +11,8 @@ http {
} }
location / { location / {
proxy_pass http://frontend:80; rewrite ^/.* / break;
proxy_pass http://frontend:80/index.html;
} }
} }
} }