recipes.coopcloud.tech/src/Pages/App_String.elm
3wc 1a7ade0f76
All checks were successful
continuous-integration/drone/push Build is passing
Drop CORS proxy
RE: #18
2023-01-08 19:04:39 -08:00

345 lines
8.7 KiB
Elm
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module Pages.App_String exposing (Model, Msg, Params, page)
import Html exposing (Html, a, button, div, h2, h5, i, img, li, p, span, text, ul)
import Html.Attributes exposing (alt, class, href, src, style)
import Html.Events exposing (onClick)
import Http
import Json.Decode as Decode
import Json.Decode.Extra as Decode exposing (andMap)
import Markdown
import Regex
import Spa.Document exposing (Document)
import Spa.Generated.Route as Route
import Spa.Page as Page exposing (Page)
import Spa.Url as Url exposing (Url)
-- INIT
page : Page Params Model Msg
page =
Page.element
{ init = init
, update = update
, view = view
, subscriptions = subscriptions
}
type alias Params =
{ app : String
}
type alias App =
{ name : String
, category : String
, repository : Maybe String
, versions : Maybe (List String)
, icon : Maybe String
, status : String
, slug : String
, default_branch : String
, website : Maybe String
, description : Maybe String
}
type alias Model =
{ url : Url Params
, status : Status
, readme : String
}
type Status
= Failure
| Loading
| Success App
init : Url Params -> ( Model, Cmd Msg )
init url =
( { url = url, status = Loading, readme = "" }, loadApp )
default_image : String
-- FIXME: change to absolute URL, if this works?
default_image =
"/logo.png"
-- UPDATE
type Msg
= MorePlease
| GotApps (Result Http.Error (List App))
| GotText (Result Http.Error String)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
MorePlease ->
( { model | status = Loading }, loadApp )
GotApps result ->
case result of
Ok apps ->
let
-- TODO better way of getting a single app?
apps_filtered =
List.filter (\app -> app.slug == model.url.params.app) apps
in
case List.head apps_filtered of
Nothing ->
( { model | status = Failure }, Cmd.none )
Just item ->
( { model | status = Success item }, loadREADME item )
Err _ ->
( { model | status = Failure }, Cmd.none )
GotText result ->
case result of
Ok content ->
-- update model.content with the loaded README
let
-- remove HTML comments
pattern =
"<!--.*-->"
maybeRegex =
Regex.fromString pattern
regex =
Maybe.withDefault Regex.never maybeRegex
in
( { model | readme = Regex.replace regex (\_ -> "") content }, Cmd.none )
Err _ ->
( { model | status = Failure }, Cmd.none )
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.none
-- VIEW
view : Model -> Document Msg
view model =
{ title = title model
, body = [ body model ]
}
title : Model -> String
title model =
case model.status of
Loading ->
"loading Co-op Cloud Recipes"
Failure ->
"error - Co-op Cloud Recipes"
Success app ->
app.name ++ " Co-op Cloud Recipes"
body : Model -> Html Msg
body model =
div [ class "pt-3" ]
[ case model.status of
Failure ->
div []
[ div [ class "alert alert-danger" ]
[ p [] [ text "Unable to load app data" ]
, button [ class "btn btn-danger", onClick MorePlease ] [ text "Try Again!" ]
]
]
Loading ->
div [ class "d-flex align-items-center", style "height" "89vh" ]
[ div [ class "spinner-border m-auto text-light" ]
[ span [ class "sr-only" ] [ text "Loading..." ]
]
]
Success app ->
div []
[ div [ class "row" ]
[ viewApp app model.readme ]
]
]
viewStatusBadge : App -> Html Msg
viewStatusBadge app =
let
status_class =
case app.status of
"1" ->
"badge-success"
"2" ->
"badge-info"
"3" ->
"badge-warning"
"4" ->
"badge-danger"
_ ->
"badge-dark"
in
span [ class ("card-link badge " ++ status_class) ]
[ text ("Score: " ++ app.status) ]
viewApp : App -> String -> Html Msg
viewApp app readme =
let
icon_url =
case app.icon of
Just "" ->
default_image
Just i ->
i
Nothing ->
default_image
repository_link =
case app.repository of
Just link ->
a [ class "card-link", href link ]
[ i [ class "fab fa-git-alt" ] []
, text "code"
]
Nothing ->
text ""
website_link =
case app.website of
Just link ->
case link of
"" ->
text ""
_ ->
a [ class "card-link", href link ]
[ i [ class "fas fa-home" ] []
, text "homepage"
]
Nothing ->
text ""
in
div [ class "col-md-6 col-sm-10 mb-3 offset-md-3 offset-sm-1" ]
[ div [ class "card" ]
[ div [ class "card-header" ]
[ a
[ class "btn btn-sm border border-secondary card-link"
, href (Route.toString Route.Top)
]
[ text " back" ]
, span [ class "card-link badge badge-secondary" ] [ text app.category ]
, viewStatusBadge app
, repository_link
, website_link
]
, img [ class "card-img-top", src icon_url, alt ("icon for " ++ app.name) ] []
, div [ class "card-body" ]
-- render Markdown with no special options
[ div [] (Markdown.toHtml Nothing readme)
]
, div [ class "card-footer" ]
[]
]
]
-- HTTP
loadApp : Cmd Msg
loadApp =
Http.get
{ url = "https://recipes.coopcloud.tech/recipes.json"
, expect = Http.expectJson GotApps appListDecoder
}
loadREADME : App -> Cmd Msg
loadREADME app =
let
repository_link =
case app.repository of
Just link ->
a [ class "card-link", href link ]
[ i [ class "fab fa-git-alt" ] []
, text "code"
]
Nothing ->
text ""
in
Http.get
-- FIXME use live Gitea link
{ url = "https://git.coopcloud.tech/coop-cloud/" ++ app.slug ++ "/raw/branch/" ++ app.default_branch ++ "/README.md"
, expect = Http.expectString GotText
}
featuresDecoder : Decode.Decoder String
featuresDecoder =
-- get features.status if it's there
Decode.oneOf
[ Decode.at [ "status" ] Decode.string
, Decode.succeed ""
]
appDecoder : Decode.Decoder App
appDecoder =
Decode.succeed App
|> andMap (Decode.field "name" Decode.string)
|> andMap (Decode.field "category" Decode.string)
|> andMap (Decode.maybe (Decode.field "repository" Decode.string))
|> andMap (Decode.succeed Nothing)
|> andMap (Decode.maybe (Decode.field "icon" Decode.string))
|> andMap (Decode.at [ "features" ] featuresDecoder)
|> andMap (Decode.succeed "")
|> andMap (Decode.field "default_branch" Decode.string)
|> andMap (Decode.maybe (Decode.field "website" Decode.string))
|> andMap (Decode.maybe (Decode.field "description" Decode.string))
appListDecoder : Decode.Decoder (List App)
appListDecoder =
Decode.keyValuePairs appDecoder
|> Decode.map buildApp
buildApp : List ( String, App ) -> List App
buildApp apps =
List.map (\( slug, app ) -> { app | slug = slug }) apps