Initial application stub

modules/webapp/src/main/elm/App/Data.elm

@@ -0,0 +1,45 @@
+module App.Data exposing (..)
+
+import Browser exposing (UrlRequest)
+import Browser.Navigation exposing (Key)
+import Url exposing (Url)
+import Http
+import Data.Flags exposing (Flags)
+import Api.Model.VersionInfo exposing (VersionInfo)
+import Api.Model.AuthResult exposing (AuthResult)
+import Page exposing (Page(..))
+import Page.Home.Data
+import Page.Login.Data
+
+type alias Model =
+    { flags: Flags
+    , key: Key
+    , page: Page
+    , version: VersionInfo
+    , homeModel: Page.Home.Data.Model
+    , loginModel: Page.Login.Data.Model
+    }
+
+init: Key -> Url -> Flags -> Model
+init key url flags =
+    let
+        page = Page.fromUrl url |> Maybe.withDefault HomePage
+    in
+        { flags = flags
+        , key = key
+        , page = page
+        , version = Api.Model.VersionInfo.empty
+        , homeModel = Page.Home.Data.emptyModel
+        , loginModel = Page.Login.Data.empty
+        }
+
+type Msg
+    = NavRequest UrlRequest
+    | NavChange Url
+    | VersionResp (Result Http.Error VersionInfo)
+    | HomeMsg Page.Home.Data.Msg
+    | LoginMsg Page.Login.Data.Msg
+    | Logout
+    | LogoutResp (Result Http.Error ())
+    | SessionCheckResp (Result Http.Error AuthResult)
+    | SetPage Page

modules/webapp/src/main/elm/App/Update.elm

@@ -0,0 +1,106 @@
+module App.Update exposing (update, initPage)
+
+import Api
+import Ports
+import Browser exposing (UrlRequest(..))
+import Browser.Navigation as Nav
+import Url
+import Data.Flags
+import App.Data exposing (..)
+import Page exposing (Page(..))
+import Page.Home.Data
+import Page.Home.Update
+import Page.Login.Data
+import Page.Login.Update
+
+update: Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+    case msg of
+        HomeMsg lm ->
+            updateHome lm model
+
+        LoginMsg lm ->
+            updateLogin lm model
+
+        SetPage p ->
+            ( {model | page = p }
+            , Cmd.none
+            )
+
+        VersionResp (Ok info) ->
+            ({model|version = info}, Cmd.none)
+
+        VersionResp (Err err) ->
+            (model, Cmd.none)
+
+        Logout ->
+            (model, Api.logout model.flags LogoutResp)
+        LogoutResp _ ->
+            ({model|loginModel = Page.Login.Data.empty}, Ports.removeAccount (Page.pageToString HomePage))
+        SessionCheckResp res ->
+            case res of
+                Ok lr ->
+                    let
+                        newFlags = Data.Flags.withAccount model.flags lr
+                        refresh = Api.refreshSession newFlags SessionCheckResp
+                    in
+                        if (lr.success) then ({model|flags = newFlags}, refresh)
+                        else  (model, Ports.removeAccount (Page.pageToString LoginPage))
+                Err _ -> (model, Ports.removeAccount (Page.pageToString LoginPage))
+
+        NavRequest req ->
+            case req of
+                Internal url ->
+                    let
+                        isCurrent =
+                            Page.fromUrl url |>
+                            Maybe.map (\p -> p == model.page) |>
+                            Maybe.withDefault True
+                    in
+                        ( model
+                        , if isCurrent then Cmd.none else Nav.pushUrl model.key (Url.toString url)
+                        )
+
+                External url ->
+                    ( model
+                    , Nav.load url
+                    )
+
+        NavChange url ->
+            let
+                page = Page.fromUrl url |> Maybe.withDefault HomePage
+                (m, c) = initPage model page
+            in
+            ( { m | page = page }, c )
+
+
+updateLogin: Page.Login.Data.Msg -> Model -> (Model, Cmd Msg)
+updateLogin lmsg model =
+    let
+        (lm, lc, ar) = Page.Login.Update.update model.flags lmsg model.loginModel
+        newFlags = Maybe.map (Data.Flags.withAccount model.flags) ar
+                   |> Maybe.withDefault model.flags
+    in
+        ({model | loginModel = lm, flags = newFlags}
+        ,Cmd.map LoginMsg lc
+        )
+
+updateHome: Page.Home.Data.Msg -> Model -> (Model, Cmd Msg)
+updateHome lmsg model =
+    let
+        (lm, lc) = Page.Home.Update.update model.flags lmsg model.homeModel
+    in
+        ( {model | homeModel = lm }
+        , Cmd.map HomeMsg lc
+        )
+
+
+initPage: Model -> Page -> (Model, Cmd Msg)
+initPage model page =
+    case page of
+        HomePage ->
+            (model, Cmd.none)
+{--            updateHome Page.Home.Data.GetBasicStats model --}
+
+        LoginPage ->
+            (model, Cmd.none)

modules/webapp/src/main/elm/App/View.elm

@@ -0,0 +1,101 @@
+module App.View exposing (view)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onClick)
+
+import App.Data exposing (..)
+import Page exposing (Page(..))
+import Page.Home.View
+import Page.Login.View
+
+view: Model -> Html Msg
+view model =
+    case model.page of
+        LoginPage ->
+            loginLayout model
+        _ ->
+            defaultLayout model
+
+loginLayout: Model -> Html Msg
+loginLayout model =
+    div [class "login-layout"]
+        [ (viewLogin model)
+        , (footer model)
+        ]
+
+defaultLayout: Model -> Html Msg
+defaultLayout model =
+    div [class "default-layout"]
+        [ div [class "ui fixed top sticky attached large menu black-bg"]
+              [div [class "ui fluid container"]
+                   [ a [class "header item narrow-item"
+                       ,Page.href HomePage
+                       ]
+                         [i [classList [("lemon outline icon", True)
+                                       ]]
+                              []
+                         ,text model.flags.config.appName]
+                   , (loginInfo model)
+                   ]
+              ]
+        , div [ class "ui fluid container main-content" ]
+            [ (case model.page of
+                   HomePage ->
+                       viewHome model
+                   LoginPage ->
+                       viewLogin model
+              )
+            ]
+        , (footer model)
+        ]
+
+viewLogin: Model -> Html Msg
+viewLogin model =
+    Html.map LoginMsg (Page.Login.View.view model.loginModel)
+
+viewHome: Model -> Html Msg
+viewHome model =
+    Html.map HomeMsg (Page.Home.View.view model.homeModel)
+
+
+loginInfo: Model -> Html Msg
+loginInfo model =
+    div [class "right menu"]
+        (case model.flags.account of
+            Just acc ->
+                [a [class "item"
+                   ]
+                     [text "Profile"
+                     ]
+                ,a [class "item"
+                   ,Page.href model.page
+                   ,onClick Logout
+                   ]
+                     [text "Logout "
+                     ,text (acc.collective ++ "/" ++ acc.user)
+                     ]
+                ]
+            Nothing ->
+                [a [class "item"
+                   ,Page.href LoginPage
+                   ]
+                     [text "Login"
+                     ]
+                ]
+        )
+
+footer: Model -> Html Msg
+footer model =
+    div [ class "ui footer" ]
+        [ a [href "https://github.com/eikek/docspell"]
+              [ i [class "ui github icon"][]
+              ]
+        , span []
+            [ text "Docspell "
+            , text model.version.version
+            , text " (#"
+            , String.left 8 model.version.gitCommit |> text
+            , text ")"
+            ]
+        ]