Initial version.

Features:

- Upload PDF files let them analyze

- Manage meta data and items

- See processing in webapp
This commit is contained in:
Eike Kettner
2019-07-23 00:53:30 +02:00
parent 6154e6a387
commit 831cd8b655
341 changed files with 23634 additions and 484 deletions

View File

@ -10,6 +10,13 @@ import Api.Model.AuthResult exposing (AuthResult)
import Page exposing (Page(..))
import Page.Home.Data
import Page.Login.Data
import Page.ManageData.Data
import Page.CollectiveSettings.Data
import Page.UserSettings.Data
import Page.Queue.Data
import Page.Register.Data
import Page.Upload.Data
import Page.NewInvite.Data
type alias Model =
{ flags: Flags
@ -18,19 +25,38 @@ type alias Model =
, version: VersionInfo
, homeModel: Page.Home.Data.Model
, loginModel: Page.Login.Data.Model
, manageDataModel: Page.ManageData.Data.Model
, collSettingsModel: Page.CollectiveSettings.Data.Model
, userSettingsModel: Page.UserSettings.Data.Model
, queueModel: Page.Queue.Data.Model
, registerModel: Page.Register.Data.Model
, uploadModel: Page.Upload.Data.Model
, newInviteModel: Page.NewInvite.Data.Model
, navMenuOpen: Bool
, subs: Sub Msg
}
init: Key -> Url -> Flags -> Model
init key url flags =
let
page = Page.fromUrl url |> Maybe.withDefault HomePage
page = Page.fromUrl url
|> Maybe.withDefault (defaultPage flags)
in
{ flags = flags
, key = key
, page = page
, version = Api.Model.VersionInfo.empty
, homeModel = Page.Home.Data.emptyModel
, loginModel = Page.Login.Data.empty
, loginModel = Page.Login.Data.emptyModel
, manageDataModel = Page.ManageData.Data.emptyModel
, collSettingsModel = Page.CollectiveSettings.Data.emptyModel
, userSettingsModel = Page.UserSettings.Data.emptyModel
, queueModel = Page.Queue.Data.emptyModel
, registerModel = Page.Register.Data.emptyModel
, uploadModel = Page.Upload.Data.emptyModel
, newInviteModel = Page.NewInvite.Data.emptyModel
, navMenuOpen = False
, subs = Sub.none
}
type Msg
@ -39,7 +65,30 @@ type Msg
| VersionResp (Result Http.Error VersionInfo)
| HomeMsg Page.Home.Data.Msg
| LoginMsg Page.Login.Data.Msg
| ManageDataMsg Page.ManageData.Data.Msg
| CollSettingsMsg Page.CollectiveSettings.Data.Msg
| UserSettingsMsg Page.UserSettings.Data.Msg
| QueueMsg Page.Queue.Data.Msg
| RegisterMsg Page.Register.Data.Msg
| UploadMsg Page.Upload.Data.Msg
| NewInviteMsg Page.NewInvite.Data.Msg
| Logout
| LogoutResp (Result Http.Error ())
| SessionCheckResp (Result Http.Error AuthResult)
| SetPage Page
| ToggleNavMenu
isSignedIn: Flags -> Bool
isSignedIn flags =
flags.account
|> Maybe.map .success
|> Maybe.withDefault False
checkPage: Flags -> Page -> Page
checkPage flags page =
if Page.isSecured page && isSignedIn flags then page
else if Page.isOpen page then page
else Page.loginPage page
defaultPage: Flags -> Page
defaultPage flags =
if isSignedIn flags then HomePage else (LoginPage Nothing)

View File

@ -12,46 +12,94 @@ import Page.Home.Data
import Page.Home.Update
import Page.Login.Data
import Page.Login.Update
import Page.ManageData.Data
import Page.ManageData.Update
import Page.CollectiveSettings.Data
import Page.CollectiveSettings.Update
import Page.UserSettings.Data
import Page.UserSettings.Update
import Page.Queue.Data
import Page.Queue.Update
import Page.Register.Data
import Page.Register.Update
import Page.Upload.Data
import Page.Upload.Update
import Page.NewInvite.Data
import Page.NewInvite.Update
import Util.Update
update: Msg -> Model -> (Model, Cmd Msg)
update msg model =
let
(m, c, s) = updateWithSub msg model
in
({m|subs = s}, c)
updateWithSub: Msg -> Model -> (Model, Cmd Msg, Sub Msg)
updateWithSub msg model =
case msg of
HomeMsg lm ->
updateHome lm model
updateHome lm model |> noSub
LoginMsg lm ->
updateLogin lm model
updateLogin lm model |> noSub
SetPage p ->
( {model | page = p }
, Cmd.none
)
ManageDataMsg lm ->
updateManageData lm model |> noSub
CollSettingsMsg m ->
updateCollSettings m model |> noSub
UserSettingsMsg m ->
updateUserSettings m model |> noSub
QueueMsg m ->
updateQueue m model |> noSub
RegisterMsg m ->
updateRegister m model |> noSub
UploadMsg m ->
updateUpload m model
NewInviteMsg m ->
updateNewInvite m model |> noSub
VersionResp (Ok info) ->
({model|version = info}, Cmd.none)
({model|version = info}, Cmd.none) |> noSub
VersionResp (Err err) ->
(model, Cmd.none)
(model, Cmd.none, Sub.none)
Logout ->
(model, Api.logout model.flags LogoutResp)
(model
, Cmd.batch
[ Api.logout model.flags LogoutResp
, Ports.removeAccount ()
]
, Sub.none)
LogoutResp _ ->
({model|loginModel = Page.Login.Data.empty}, Ports.removeAccount (Page.pageToString HomePage))
({model|loginModel = Page.Login.Data.emptyModel}, Page.goto (LoginPage Nothing), Sub.none)
SessionCheckResp res ->
case res of
Ok lr ->
let
newFlags = Data.Flags.withAccount model.flags lr
refresh = Api.refreshSession newFlags SessionCheckResp
newFlags = if lr.success then Data.Flags.withAccount model.flags lr
else Data.Flags.withoutAccount model.flags
command = if lr.success then Api.refreshSession newFlags SessionCheckResp
else Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)]
in
if (lr.success) then ({model|flags = newFlags}, refresh)
else (model, Ports.removeAccount (Page.pageToString LoginPage))
Err _ -> (model, Ports.removeAccount (Page.pageToString LoginPage))
({model | flags = newFlags}, command, Sub.none)
Err _ ->
(model, Cmd.batch [Ports.removeAccount (), Page.goto (Page.loginPage model.page)], Sub.none)
NavRequest req ->
case req of
Internal url ->
let
newPage = Page.fromUrl url
isCurrent =
Page.fromUrl url |>
Maybe.map (\p -> p == model.page) |>
@ -59,25 +107,89 @@ update msg model =
in
( model
, if isCurrent then Cmd.none else Nav.pushUrl model.key (Url.toString url)
, Sub.none
)
External url ->
( model
, Nav.load url
, Sub.none
)
NavChange url ->
let
page = Page.fromUrl url |> Maybe.withDefault HomePage
page = Page.fromUrl url
|> Maybe.withDefault (defaultPage model.flags)
check = checkPage model.flags page
(m, c) = initPage model page
in
( { m | page = page }, c )
if check == page then ( { m | page = page }, c, Sub.none )
else (model, Page.goto check, Sub.none)
ToggleNavMenu ->
({model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none)
updateNewInvite: Page.NewInvite.Data.Msg -> Model -> (Model, Cmd Msg)
updateNewInvite lmsg model =
let
(lm, lc) = Page.NewInvite.Update.update model.flags lmsg model.newInviteModel
in
( {model | newInviteModel = lm }
, Cmd.map NewInviteMsg lc
)
updateUpload: Page.Upload.Data.Msg -> Model -> (Model, Cmd Msg, Sub Msg)
updateUpload lmsg model =
let
(lm, lc, ls) = Page.Upload.Update.update (Page.uploadId model.page) model.flags lmsg model.uploadModel
in
( { model | uploadModel = lm }
, Cmd.map UploadMsg lc
, Sub.map UploadMsg ls
)
updateRegister: Page.Register.Data.Msg -> Model -> (Model, Cmd Msg)
updateRegister lmsg model =
let
(lm, lc) = Page.Register.Update.update model.flags lmsg model.registerModel
in
( { model | registerModel = lm }
, Cmd.map RegisterMsg lc
)
updateQueue: Page.Queue.Data.Msg -> Model -> (Model, Cmd Msg)
updateQueue lmsg model =
let
(lm, lc) = Page.Queue.Update.update model.flags lmsg model.queueModel
in
( { model | queueModel = lm }
, Cmd.map QueueMsg lc
)
updateUserSettings: Page.UserSettings.Data.Msg -> Model -> (Model, Cmd Msg)
updateUserSettings lmsg model =
let
(lm, lc) = Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel
in
( { model | userSettingsModel = lm }
, Cmd.map UserSettingsMsg lc
)
updateCollSettings: Page.CollectiveSettings.Data.Msg -> Model -> (Model, Cmd Msg)
updateCollSettings lmsg model =
let
(lm, lc) = Page.CollectiveSettings.Update.update model.flags lmsg model.collSettingsModel
in
( { model | collSettingsModel = lm }
, Cmd.map CollSettingsMsg lc
)
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
(lm, lc, ar) = Page.Login.Update.update (Page.loginPageReferrer model.page) model.flags lmsg model.loginModel
newFlags = Maybe.map (Data.Flags.withAccount model.flags) ar
|> Maybe.withDefault model.flags
in
@ -94,13 +206,52 @@ updateHome lmsg model =
, Cmd.map HomeMsg lc
)
updateManageData: Page.ManageData.Data.Msg -> Model -> (Model, Cmd Msg)
updateManageData lmsg model =
let
(lm, lc) = Page.ManageData.Update.update model.flags lmsg model.manageDataModel
in
({ model | manageDataModel = lm }
,Cmd.map ManageDataMsg lc
)
initPage: Model -> Page -> (Model, Cmd Msg)
initPage model page =
case page of
HomePage ->
(model, Cmd.none)
{-- updateHome Page.Home.Data.GetBasicStats model --}
Util.Update.andThen1
[updateHome Page.Home.Data.Init
,updateQueue Page.Queue.Data.StopRefresh
] model
LoginPage ->
(model, Cmd.none)
LoginPage _ ->
updateQueue Page.Queue.Data.StopRefresh model
ManageDataPage ->
updateQueue Page.Queue.Data.StopRefresh model
CollectiveSettingPage ->
Util.Update.andThen1
[updateQueue Page.Queue.Data.StopRefresh
,updateCollSettings Page.CollectiveSettings.Data.Init
] model
UserSettingPage ->
updateQueue Page.Queue.Data.StopRefresh model
QueuePage ->
updateQueue Page.Queue.Data.Init model
RegisterPage ->
updateQueue Page.Queue.Data.StopRefresh model
UploadPage _ ->
updateQueue Page.Queue.Data.StopRefresh model
NewInvitePage ->
updateQueue Page.Queue.Data.StopRefresh model
noSub: (Model, Cmd Msg) -> (Model, Cmd Msg, Sub Msg)
noSub (m, c) =
(m, c, Sub.none)

View File

@ -4,19 +4,39 @@ import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page
import App.Data exposing (..)
import Data.Flags exposing (Flags)
import Page exposing (Page(..))
import Page.Home.View
import Page.Login.View
import Page.ManageData.View
import Page.CollectiveSettings.View
import Page.UserSettings.View
import Page.Queue.View
import Page.Register.View
import Page.Upload.View
import Page.NewInvite.View
view: Model -> Html Msg
view model =
case model.page of
LoginPage ->
LoginPage _ ->
loginLayout model
RegisterPage ->
registerLayout model
NewInvitePage ->
newInviteLayout model
_ ->
defaultLayout model
registerLayout: Model -> Html Msg
registerLayout model =
div [class "register-layout"]
[ (viewRegister model)
, (footer model)
]
loginLayout: Model -> Html Msg
loginLayout model =
div [class "login-layout"]
@ -24,32 +44,81 @@ loginLayout model =
, (footer model)
]
newInviteLayout: Model -> Html Msg
newInviteLayout model =
div [class "newinvite-layout"]
[ (viewNewInvite 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 fixed top sticky attached large menu top-menu"]
[div [class "ui fluid container"]
[ a [class "header item narrow-item"
,Page.href HomePage
]
[i [classList [("lemon outline icon", True)
[i [classList [("umbrella icon", True)
]]
[]
,text model.flags.config.appName]
, (loginInfo model)
]
]
, div [ class "ui fluid container main-content" ]
, div [ class "main-content" ]
[ (case model.page of
HomePage ->
viewHome model
LoginPage ->
LoginPage _ ->
viewLogin model
ManageDataPage ->
viewManageData model
CollectiveSettingPage ->
viewCollectiveSettings model
UserSettingPage ->
viewUserSettings model
QueuePage ->
viewQueue model
RegisterPage ->
viewRegister model
UploadPage mid ->
viewUpload mid model
NewInvitePage ->
viewNewInvite model
)
]
, (footer model)
]
viewNewInvite: Model -> Html Msg
viewNewInvite model =
Html.map NewInviteMsg (Page.NewInvite.View.view model.flags model.newInviteModel)
viewUpload: (Maybe String) ->Model -> Html Msg
viewUpload mid model =
Html.map UploadMsg (Page.Upload.View.view mid model.uploadModel)
viewRegister: Model -> Html Msg
viewRegister model =
Html.map RegisterMsg (Page.Register.View.view model.flags model.registerModel)
viewQueue: Model -> Html Msg
viewQueue model =
Html.map QueueMsg (Page.Queue.View.view model.queueModel)
viewUserSettings: Model -> Html Msg
viewUserSettings model =
Html.map UserSettingsMsg (Page.UserSettings.View.view model.userSettingsModel)
viewCollectiveSettings: Model -> Html Msg
viewCollectiveSettings model =
Html.map CollSettingsMsg (Page.CollectiveSettings.View.view model.flags model.collSettingsModel)
viewManageData: Model -> Html Msg
viewManageData model =
Html.map ManageDataMsg (Page.ManageData.View.view model.manageDataModel)
viewLogin: Model -> Html Msg
viewLogin model =
Html.map LoginMsg (Page.Login.View.view model.loginModel)
@ -59,29 +128,87 @@ viewHome model =
Html.map HomeMsg (Page.Home.View.view model.homeModel)
menuEntry: Model -> Page -> List (Html Msg) -> Html Msg
menuEntry model page children =
a [classList [("icon item", True)
,("active", model.page == page)
]
, Page.href page]
children
loginInfo: Model -> Html Msg
loginInfo model =
div [class "right menu"]
(case model.flags.account of
Just acc ->
[a [class "item"
]
[text "Profile"
[div [class "ui dropdown icon link item"
, onClick ToggleNavMenu
]
,a [class "item"
,Page.href model.page
,onClick Logout
]
[text "Logout "
,text (acc.collective ++ "/" ++ acc.user)
[i [class "ui bars icon"][]
,div [classList [("left menu", True)
,("transition visible", model.navMenuOpen)
]
]
[menuEntry model HomePage
[i [class "umbrella icon"][]
,text "Items"
]
,div [class "divider"][]
,menuEntry model CollectiveSettingPage
[i [class "users circle icon"][]
,text "Collective Settings"
]
,menuEntry model UserSettingPage
[i [class "user circle icon"][]
,text "User Settings"
]
,div [class "divider"][]
,menuEntry model ManageDataPage
[i [class "cubes icon"][]
,text "Manage Data"
]
,div [class "divider"][]
,menuEntry model (UploadPage Nothing)
[i [class "upload icon"][]
,text "Upload files"
]
,menuEntry model QueuePage
[i [class "tachometer alternate icon"][]
,text "Procesing Queue"
]
,div [classList [("divider", True)
,("invisible", model.flags.config.signupMode /= "invite")
]]
[]
,a [classList [("icon item", True)
,("invisible", model.flags.config.signupMode /= "invite")
]
, Page.href NewInvitePage
]
[i [class "key icon"][]
,text "New Invites"
]
,div [class "divider"][]
,a [class "icon item"
,href ""
,onClick Logout]
[i [class "sign-out icon"][]
,text "Logout"
]
]
]
]
Nothing ->
[a [class "item"
,Page.href LoginPage
,Page.href (Page.loginPage model.page)
]
[text "Login"
]
,a [class "item"
,Page.href RegisterPage
]
[text "Register"
]
]
)