git.iko.soy/typeable/octopod
on master help sign in
wip elm front
commit66ef1a56548526e685614fc51063edb004ee713c authorAnisimov Nikita <anisimoff.nikita@gmail.com> dateTue 21 Nov 2023, 18:57 (3 years ago) parent0a95ea8
9 files changed+538−1
compare with master
unifiedsplit
.gitignore+5−1 octopod-frontend-elm/.DS_Store octopod-frontend-elm/elm.json+31 octopod-frontend-elm/src/Config.elm+20 octopod-frontend-elm/src/Deployments.elm+161 octopod-frontend-elm/src/Main.elm+126 octopod-frontend-elm/src/Page/Deployments.elm+60 octopod-frontend-elm/src/Page/Initialization.elm+74 octopod-frontend-elm/src/Route.elm+61
.gitignore+5−1
@@ -10,4 +10,8 @@ octopod-css/node_modules
1010dev/certs/*
1111tmp/*
1212octopod-css/production
13−.idea/
13+.idea/
14+octopod-frontend-elm/elm-stuff
15+octopod-frontend-elm/octopod-css
16+octopod-frontend-elm/index.html
17+.DS_Store
octopod-frontend-elm/.DS_Storenew file

Binary file not shown.

octopod-frontend-elm/elm.jsonnew file+31
@@ -0,0 +1,31 @@
1+{
2+ "type": "application",
3+ "source-directories": [
4+ "src"
5+ ],
6+ "elm-version": "0.19.1",
7+ "dependencies": {
8+ "direct": {
9+ "NoRedInk/elm-json-decode-pipeline": "1.0.1",
10+ "elm/browser": "1.0.2",
11+ "elm/core": "1.0.5",
12+ "elm/html": "1.0.0",
13+ "elm/http": "2.0.0",
14+ "elm/json": "1.1.3",
15+ "elm/time": "1.0.0",
16+ "elm/url": "1.0.0",
17+ "elm-community/json-extra": "4.3.0"
18+ },
19+ "indirect": {
20+ "elm/bytes": "1.0.8",
21+ "elm/file": "1.0.5",
22+ "elm/parser": "1.1.0",
23+ "elm/virtual-dom": "1.0.3",
24+ "rtfeldman/elm-iso8601-date-strings": "1.1.4"
25+ }
26+ },
27+ "test-dependencies": {
28+ "direct": {},
29+ "indirect": {}
30+ }
31+}
octopod-frontend-elm/src/Config.elmnew file+20
@@ -0,0 +1,20 @@
1+module Config exposing (..)
2+
3+import Json.Decode as Decode exposing (Decoder, string)
4+import Json.Decode.Pipeline exposing (required)
5+
6+
7+type alias Config =
8+ { appUrl : String
9+ , wsUrl : String
10+ , appAuth : String
11+ , k8sDashboardUrlTemplate : String
12+ }
13+
14+configDecoder : Decoder Config
15+configDecoder =
16+ Decode.succeed Config
17+ |> required "app_url" string
18+ |> required "ws_url" string
19+ |> required "app_auth" string
20+ |> required "kubernetes_dashboard_url_template" string
octopod-frontend-elm/src/Deployments.elmnew file+161
@@ -0,0 +1,161 @@
1+module Deployments exposing (..)
2+
3+import Json.Decode as Decoder exposing (Decoder, string, andThen)
4+import Json.Decode.Extra exposing (datetime)
5+import Json.Decode.Pipeline exposing (required, optional, resolve)
6+import Time
7+import Route exposing (Route(..))
8+
9+
10+type OverrideValue
11+ = ValueAdded String
12+ | ValueDeleted
13+
14+type alias Override =
15+ { name : String
16+ , value : OverrideValue }
17+
18+type alias Info =
19+ { name : String
20+ , appOverrides : List Override
21+ , deploymentOverrides : List Override
22+ }
23+
24+type alias Metadata =
25+ { name : String
26+ , link : String
27+ }
28+
29+type alias Deployment =
30+ { deployment : Info
31+ , status : Status
32+ , metadata : List Metadata
33+ , createdAt : Time.Posix
34+ , updatedAt : Time.Posix }
35+
36+type DeploymentStatus
37+ = Running
38+ | Failure FailureType
39+ | CreatePending
40+ | UpdatePending
41+ | ArchivePending
42+ | Archived
43+ | CleanupFailed
44+
45+type FailureType
46+ = GenericFailure
47+ | TagMismatch
48+ | PartialAvailability
49+
50+type Status
51+ = DeploymentPending DeploymentStatus
52+ | DeploymentNotPending DeploymentStatus
53+
54+
55+type alias Deployments = List Deployment
56+
57+failureTypeDecoder : Decoder FailureType
58+failureTypeDecoder =
59+ let
60+ tagDecoder tag = case tag of
61+ "GenericFailure" -> Decoder.succeed GenericFailure
62+ "PartialAvailability" -> Decoder.succeed PartialAvailability
63+ "TagMismatch" -> Decoder.succeed TagMismatch
64+ _ -> Decoder.fail ("Unknown FailureType: " ++ tag)
65+ in
66+ string |> andThen tagDecoder
67+
68+deploymentStatusDecoder : Decoder DeploymentStatus
69+deploymentStatusDecoder =
70+ let
71+ toDecoder : String -> Maybe FailureType -> Decoder DeploymentStatus
72+ toDecoder tag contents =
73+ case (tag, contents) of
74+ ("Running", _) -> Decoder.succeed Running
75+ ("CreatePending", _) -> Decoder.succeed CreatePending
76+ ("UpdatePending", _) -> Decoder.succeed UpdatePending
77+ ("ArchivePending", _) -> Decoder.succeed ArchivePending
78+ ("Archived", _) -> Decoder.succeed Archived
79+ ("CleanupFailed", _) -> Decoder.succeed CleanupFailed
80+ ("Failure", Just failureType) -> Decoder.succeed (Failure failureType)
81+ (_,_) -> Decoder.fail ("Unknown DeploymentStatus: " ++ tag)
82+ in
83+ Decoder.succeed toDecoder
84+ |> required "tag" string
85+ |> optional "contents" (Decoder.maybe failureTypeDecoder) Nothing
86+ |> resolve
87+
88+statusDecoder : Decoder Status
89+statusDecoder =
90+ let
91+ toDecoder : String -> DeploymentStatus -> Decoder Status
92+ toDecoder tag contents =
93+ case tag of
94+ "DeploymentNotPending" -> Decoder.succeed (DeploymentNotPending contents)
95+ "DeploymentPending" -> Decoder.succeed (DeploymentPending contents)
96+ _ -> Decoder.fail ("Unknown Status: " ++ tag)
97+ in
98+ Decoder.succeed toDecoder
99+ |> required "tag" string
100+ |> required "recorded_status" deploymentStatusDecoder
101+ |> resolve
102+
103+metadataDecoder : Decoder Metadata
104+metadataDecoder =
105+ Decoder.succeed Metadata
106+ |> required "name" string
107+ |> required "link" string
108+
109+overrideValueDecoder : Decoder OverrideValue
110+overrideValueDecoder =
111+ let
112+ toDecoder : String -> Maybe String -> Decoder OverrideValue
113+ toDecoder tag contents =
114+ case (tag, contents) of
115+ ("ValueDeleted", _) -> Decoder.succeed ValueDeleted
116+ ("ValueAdded", Just value) -> Decoder.succeed (ValueAdded value)
117+ (_,_) -> Decoder.fail ("Unknown DeploymentStatus: " ++ tag)
118+ in
119+ Decoder.succeed toDecoder
120+ |> required "tag" string
121+ |> optional "contents" (Decoder.maybe string) Nothing
122+ |> resolve
123+
124+type OverrideHelper
125+ = OverrideName String
126+ | OverrideValue OverrideValue
127+
128+
129+
130+overrideDecoder : Decoder Override
131+overrideDecoder =
132+ let
133+ overrideHelperDecoder = Decoder.list (Decoder.oneOf
134+ [ string |> Decoder.map OverrideName
135+ , overrideValueDecoder |> Decoder.map OverrideValue
136+ ])
137+ listDecoder vals = case vals of
138+ [OverrideName name, OverrideValue val] -> Decoder.succeed (Override name val)
139+ [OverrideValue val, OverrideName name] -> Decoder.succeed (Override name val)
140+ _ -> Decoder.fail ("Unknown override")
141+ in
142+ overrideHelperDecoder |> andThen listDecoder
143+
144+infoDecoder : Decoder Info
145+infoDecoder =
146+ Decoder.succeed Info
147+ |> required "name" string
148+ |> required "app_overrides" (Decoder.list overrideDecoder)
149+ |> required "deployment_overrides" (Decoder.list overrideDecoder)
150+
151+deploymentDecoder : Decoder Deployment
152+deploymentDecoder =
153+ Decoder.succeed Deployment
154+ |> required "deployment" infoDecoder
155+ |> required "status" statusDecoder
156+ |> required "metadata" (Decoder.list metadataDecoder)
157+ |> required "created_at" datetime
158+ |> required "updated_at" datetime
159+
160+deploymentsDecoder : Decoder Deployments
161+deploymentsDecoder = Decoder.list deploymentDecoder
octopod-frontend-elm/src/Main.elmnew file+126
@@ -0,0 +1,126 @@
1+module Main exposing (main)
2+
3+import Browser
4+import Browser.Navigation as Nav
5+import Html exposing (..)
6+import Html.Attributes exposing (..)
7+import Json.Decode exposing (Decoder, map4, field, int, string)
8+import Url
9+import Config exposing (Config)
10+import Page.Initialization as Initialization
11+import Page.Deployments as Deployments
12+import Route exposing (Route)
13+
14+
15+
16+-- MAIN
17+
18+
19+main : Program () Model Msg
20+main =
21+ Browser.application
22+ { init = init
23+ , view = view
24+ , update = update
25+ , subscriptions = subscriptions
26+ , onUrlChange = UrlChanged
27+ , onUrlRequest = LinkClicked
28+ }
29+
30+-- MODEL
31+
32+type Model
33+ = Initialization Initialization.Model
34+ | Deployments Deployments.Model
35+
36+getNavKey : Model -> Nav.Key
37+getNavKey model =
38+ case model of
39+ Initialization subModel -> Initialization.getNavKey subModel
40+ Deployments subModel -> Deployments.getNavKey subModel
41+
42+
43+init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
44+init _ url key =
45+ Initialization.init url key
46+ |> updateWith Initialization InitializationMsg
47+
48+
49+
50+-- UPDATE
51+
52+
53+type Msg
54+ = LinkClicked Browser.UrlRequest
55+ | UrlChanged Url.Url
56+ | InitializationMsg Initialization.Msg
57+ | DeploymentsMsg Deployments.Msg
58+
59+
60+update : Msg -> Model -> ( Model, Cmd Msg )
61+update msg model =
62+ case ( msg, model ) of
63+ ( LinkClicked urlRequest, _ ) ->
64+ case urlRequest of
65+ Browser.Internal url ->
66+ ( model
67+ , Nav.pushUrl (getNavKey model) (Url.toString url)
68+ )
69+
70+ Browser.External href ->
71+ ( model
72+ , Nav.load href
73+ )
74+
75+ ( UrlChanged url, _ ) -> changeRouteTo (Route.fromUrl url) model
76+
77+ ( InitializationMsg subMsg, Initialization initialization ) ->
78+ Initialization.update subMsg initialization
79+ |> updateWith Initialization InitializationMsg
80+
81+ ( DeploymentsMsg subMsg, Deployments deployments ) ->
82+ Deployments.update subMsg deployments
83+ |> updateWith Deployments DeploymentsMsg
84+
85+ ( _, _ ) -> (model, Cmd.none)
86+
87+updateWith : (subModel -> Model) -> (subMsg -> Msg) -> ( subModel, Cmd subMsg ) -> ( Model, Cmd Msg )
88+updateWith toModel toMsg ( subModel, subCmd ) =
89+ ( toModel subModel
90+ , Cmd.map toMsg subCmd
91+ )
92+
93+changeRouteTo : Maybe Route -> Model -> ( Model, Cmd Msg )
94+changeRouteTo maybeRoute model =
95+ case maybeRoute of
96+ Nothing ->
97+ Deployments.init (getNavKey model)
98+ |> updateWith Deployments DeploymentsMsg
99+
100+ Just Route.Deployments ->
101+ Deployments.init (getNavKey model)
102+ |> updateWith Deployments DeploymentsMsg
103+
104+
105+-- SUBSCRIPTIONS
106+
107+
108+subscriptions : Model -> Sub Msg
109+subscriptions _ =
110+ Sub.none
111+
112+
113+
114+-- VIEW
115+
116+
117+view : Model -> Browser.Document Msg
118+view model =
119+ let
120+ viewPage toMsg title body =
121+ { title = title
122+ , body = [Html.map toMsg body] }
123+ in
124+ case model of
125+ Initialization subModel -> viewPage InitializationMsg "" (Initialization.view subModel)
126+ Deployments subModel -> viewPage DeploymentsMsg "" (Deployments.view subModel)
octopod-frontend-elm/src/Page/Deployments.elmnew file+60
@@ -0,0 +1,60 @@
1+module Page.Deployments exposing (..)
2+
3+import Browser.Navigation as Nav
4+import Http
5+import Html exposing (..)
6+import Deployments exposing (Deployment)
7+import Deployments exposing (deploymentsDecoder)
8+import Deployments exposing (Deployments)
9+import String exposing (fromInt)
10+
11+type Model
12+ = Model Nav.Key Deployments
13+ | DeploymentsLoading Nav.Key
14+ | FatalError Nav.Key
15+
16+
17+init : Nav.Key -> ( Model, Cmd Msg )
18+init key =
19+ ( DeploymentsLoading key
20+ , getConfig )
21+
22+getNavKey : Model -> Nav.Key
23+getNavKey model =
24+ case model of
25+ Model key _ -> key
26+ DeploymentsLoading key -> key
27+ FatalError key -> key
28+
29+
30+type Msg
31+ = DeploymentsResponse (Result Http.Error (List Deployment))
32+
33+getConfig : Cmd Msg
34+getConfig =
35+ Http.get
36+ { url = "http://localhost:3100/deployments"
37+ , expect = Http.expectJson DeploymentsResponse deploymentsDecoder
38+ }
39+
40+update : Msg -> Model -> ( Model, Cmd Msg )
41+update msg model =
42+ case (msg, model) of
43+ (DeploymentsResponse result, DeploymentsLoading key) ->
44+ case result of
45+ Ok deployments ->
46+ (Model key deployments, Cmd.none)
47+ Err _ ->
48+ (FatalError key, Cmd.none)
49+ (_, _) -> (FatalError (getNavKey model), Cmd.none)
50+
51+view : Model -> Html Msg
52+view model =
53+ case model of
54+ Model _ deployments ->
55+ div []
56+ [ h2 [] [ text "Got it!" ]
57+ , text (fromInt (List.length deployments))
58+ ]
59+ DeploymentsLoading _ -> div [] [text "loading deployments..."]
60+ FatalError _ -> div [] [text "fatal error..."]
octopod-frontend-elm/src/Page/Initialization.elmnew file+74
@@ -0,0 +1,74 @@
1+module Page.Initialization exposing (..)
2+
3+import Browser.Navigation as Nav
4+import Config exposing (Config)
5+import Url
6+import Http
7+import Html exposing (..)
8+import Route
9+import Html.Attributes exposing (class)
10+
11+type Model
12+ = Model Nav.Key Url.Url Config
13+ | ConfigLoading Nav.Key Url.Url
14+ | FatalError Nav.Key
15+
16+
17+init : Url.Url -> Nav.Key -> ( Model, Cmd Msg )
18+init url key =
19+ ( ConfigLoading key url
20+ , getConfig )
21+
22+getNavKey : Model -> Nav.Key
23+getNavKey model =
24+ case model of
25+ Model key _ _ -> key
26+ ConfigLoading key _ -> key
27+ FatalError key -> key
28+
29+
30+type Msg
31+ = ConfigResponse (Result Http.Error Config)
32+
33+getConfig : Cmd Msg
34+getConfig =
35+ Http.get
36+ { url = "http://localhost:3100/config.json"
37+ , expect = Http.expectJson ConfigResponse Config.configDecoder
38+ }
39+
40+update : Msg -> Model -> ( Model, Cmd Msg )
41+update msg model =
42+ case (msg, model) of
43+ (ConfigResponse result, ConfigLoading key url) ->
44+ case result of
45+ Ok config ->
46+ case Route.fromUrl url of
47+ Nothing -> (Model key url config, Route.replaceUrl (getNavKey model) Route.Deployments )
48+ Just route -> (Model key url config, Route.replaceUrl (getNavKey model) route )
49+ Err _ ->
50+ (FatalError key, Cmd.none)
51+ (_, _) -> (FatalError (getNavKey model), Cmd.none)
52+
53+view : Model -> Html Msg
54+view model =
55+ case model of
56+ Model _ _ config ->
57+ div []
58+ [ h2 [] [ text "Got cofig" ]
59+ , text config.appAuth
60+ ]
61+ ConfigLoading _ _ -> div
62+ [ class "no-page"
63+ ]
64+ [ div
65+ [ class "no-page__inner"
66+ ]
67+ [ div
68+ [ class "loading loading--enlarged loading--alternate"
69+ ]
70+ [ text "Loading..." ]
71+ ]
72+ ]
73+
74+ FatalError _ -> div [] [text "fatal error..."]
octopod-frontend-elm/src/Route.elmnew file+61
@@ -0,0 +1,61 @@
1+module Route exposing (Route(..), fromUrl, href, replaceUrl)
2+
3+import Browser.Navigation as Nav
4+import Html exposing (Attribute)
5+import Html.Attributes as Attr
6+import Url exposing (Url)
7+import Url.Parser as Parser exposing ((</>), Parser, oneOf, s)
8+
9+
10+
11+-- ROUTING
12+
13+
14+type Route
15+ = Deployments
16+
17+
18+parser : Parser (Route -> a) a
19+parser =
20+ oneOf
21+ [ Parser.map Deployments (s "deployments")
22+ ]
23+
24+
25+
26+-- PUBLIC HELPERS
27+
28+
29+href : Route -> Attribute msg
30+href targetRoute =
31+ Attr.href (routeToString targetRoute)
32+
33+
34+replaceUrl : Nav.Key -> Route -> Cmd msg
35+replaceUrl key route =
36+ Nav.replaceUrl key (routeToString route)
37+
38+
39+fromUrl : Url -> Maybe Route
40+fromUrl url =
41+ -- The RealWorld spec treats the fragment like a path.
42+ -- This makes it *literally* the path, so we can proceed
43+ -- with parsing as if it had been a normal path all along.
44+ { url | path = Maybe.withDefault "" url.fragment, fragment = Nothing }
45+ |> Parser.parse parser
46+
47+
48+
49+-- INTERNAL
50+
51+
52+routeToString : Route -> String
53+routeToString page =
54+ "#/" ++ String.join "/" (routeToPieces page)
55+
56+
57+routeToPieces : Route -> List String
58+routeToPieces page =
59+ case page of
60+ Deployments ->
61+ ["deployments"]