TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-06-22 02:18:26 +00:00
Code Issues Packages Projects Releases Wiki Activity

Using elm-format for all files

Browse Source
This commit is contained in:
Eike Kettner
2019-12-29 21:55:12 +01:00
parent 546f1a6ee3
commit 2001cca88b
84 changed files with 7668 additions and 5079 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
modules/webapp/src/main/elm/Page/CollectiveSettings/Data.elm
View File

@ -1,24 +1,30 @@
module Page.CollectiveSettings.Data exposing (..)
module Page.CollectiveSettings.Data exposing
( Model
, Msg(..)
, Tab(..)
, emptyModel
)
import Http
import Comp.SourceManage
import Comp.UserManage
import Comp.Settings
import Data.Language
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.CollectiveSettings exposing (CollectiveSettings)
import Api.Model.ItemInsights exposing (ItemInsights)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Http
type alias Model =
{ currentTab: Maybe Tab
, sourceModel: Comp.SourceManage.Model
, userModel: Comp.UserManage.Model
, settingsModel: Comp.Settings.Model
, insights: ItemInsights
, submitResult: Maybe BasicResult
{ currentTab : Maybe Tab
, sourceModel : Comp.SourceManage.Model
, userModel : Comp.UserManage.Model
, settingsModel : Comp.Settings.Model
, insights : ItemInsights
, submitResult : Maybe BasicResult
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ currentTab = Just InsightsTab
, sourceModel = Comp.SourceManage.emptyModel
@ -28,12 +34,14 @@ emptyModel =
, submitResult = Nothing
}
type Tab
= SourceTab
| UserTab
| InsightsTab
| SettingsTab
type Msg
= SetTab Tab
| SourceMsg Comp.SourceManage.Msg

80
modules/webapp/src/main/elm/Page/CollectiveSettings/Update.elm
View File

@ -2,80 +2,90 @@ module Page.CollectiveSettings.Update exposing (update)
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Page.CollectiveSettings.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Comp.Settings
import Data.Flags exposing (Flags)
import Page.CollectiveSettings.Data exposing (..)
import Util.Http
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTab t ->
let
m = { model | currentTab = Just t }
m =
{ model | currentTab = Just t }
in
case t of
SourceTab ->
update flags (SourceMsg Comp.SourceManage.LoadSources) m
case t of
SourceTab ->
update flags (SourceMsg Comp.SourceManage.LoadSources) m
UserTab ->
update flags (UserMsg Comp.UserManage.LoadUsers) m
UserTab ->
update flags (UserMsg Comp.UserManage.LoadUsers) m
InsightsTab ->
update flags Init m
InsightsTab ->
update flags Init m
SettingsTab ->
update flags Init m
SettingsTab ->
update flags Init m
SourceMsg m ->
let
(m2, c2) = Comp.SourceManage.update flags m model.sourceModel
( m2, c2 ) =
Comp.SourceManage.update flags m model.sourceModel
in
({model | sourceModel = m2}, Cmd.map SourceMsg c2)
( { model | sourceModel = m2 }, Cmd.map SourceMsg c2 )
UserMsg m ->
let
(m2, c2) = Comp.UserManage.update flags m model.userModel
( m2, c2 ) =
Comp.UserManage.update flags m model.userModel
in
({model | userModel = m2}, Cmd.map UserMsg c2)
( { model | userModel = m2 }, Cmd.map UserMsg c2 )
SettingsMsg m ->
let
(m2, c2, msett) = Comp.Settings.update flags m model.settingsModel
cmd = case msett of
Nothing -> Cmd.none
Just sett ->
Api.setCollectiveSettings flags sett SubmitResp
( m2, c2, msett ) =
Comp.Settings.update flags m model.settingsModel
cmd =
case msett of
Nothing ->
Cmd.none
Just sett ->
Api.setCollectiveSettings flags sett SubmitResp
in
({model | settingsModel = m2, submitResult = Nothing}, Cmd.batch [cmd, Cmd.map SettingsMsg c2])
( { model | settingsModel = m2, submitResult = Nothing }, Cmd.batch [ cmd, Cmd.map SettingsMsg c2 ] )
Init ->
({model|submitResult = Nothing}
,Cmd.batch
( { model | submitResult = Nothing }
, Cmd.batch
[ Api.getInsights flags GetInsightsResp
, Api.getCollectiveSettings flags CollectiveSettingsResp
]
)
GetInsightsResp (Ok data) ->
({model|insights = data}, Cmd.none)
( { model | insights = data }, Cmd.none )
GetInsightsResp (Err err) ->
(model, Cmd.none)
GetInsightsResp (Err _) ->
( model, Cmd.none )
CollectiveSettingsResp (Ok data) ->
({model | settingsModel = Comp.Settings.init data }, Cmd.none)
( { model | settingsModel = Comp.Settings.init data }, Cmd.none )
CollectiveSettingsResp (Err err) ->
(model, Cmd.none)
CollectiveSettingsResp (Err _) ->
( model, Cmd.none )
SubmitResp (Ok res) ->
({model | submitResult = Just res}, Cmd.none)
( { model | submitResult = Just res }, Cmd.none )
SubmitResp (Err err) ->
let
res = BasicResult False (Util.Http.errorToString err)
res =
BasicResult False (Util.Http.errorToString err)
in
({model | submitResult = Just res}, Cmd.none)
( { model | submitResult = Just res }, Cmd.none )

338
modules/webapp/src/main/elm/Page/CollectiveSettings/View.elm
View File

@ -1,197 +1,217 @@
module Page.CollectiveSettings.View exposing (view)
import Api.Model.NameCount exposing (NameCount)
import Comp.Settings
import Comp.SourceManage
import Comp.UserManage
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Api.Model.NameCount exposing (NameCount)
import Util.Html exposing (classActive)
import Data.Flags exposing (Flags)
import Page.CollectiveSettings.Data exposing (..)
import Comp.SourceManage
import Comp.UserManage
import Comp.Settings
import Util.Size
import Util.Html exposing (classActive)
import Util.Maybe
import Util.Size
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
div [class "collectivesetting-page ui padded grid"]
[div [class "four wide column"]
[h4 [class "ui top attached ablue-comp header"]
[text "Collective"
]
,div [class "ui attached fluid segment"]
[div [class "ui fluid vertical secondary menu"]
[div [classActive (model.currentTab == Just InsightsTab) "link icon item"
,onClick (SetTab InsightsTab)
]
[i [class "chart bar outline icon"][]
,text "Insights"
]
,div [classActive (model.currentTab == Just SourceTab) "link icon item"
,onClick (SetTab SourceTab)
]
[i [class "upload icon"][]
,text "Sources"
]
, div [classActive (model.currentTab == Just SettingsTab) "link icon item"
,onClick (SetTab SettingsTab)
div [ class "collectivesetting-page ui padded grid" ]
[ div [ class "four wide column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
[ text "Collective"
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[ div
[ classActive (model.currentTab == Just InsightsTab) "link icon item"
, onClick (SetTab InsightsTab)
]
[i [class "language icon"][]
,text "Document Language"
]
,div [classActive (model.currentTab == Just UserTab) "link icon item"
,onClick (SetTab UserTab)
]
[i [class "user icon"][]
,text "Users"
]
]
]
]
,div [class "twelve wide column"]
[div [class ""]
(case model.currentTab of
Just SourceTab -> viewSources flags model
Just UserTab -> viewUsers model
Just InsightsTab -> viewInsights model
Just SettingsTab -> viewSettings model
Nothing -> []
)
[ i [ class "chart bar outline icon" ] []
, text "Insights"
]
, div
[ classActive (model.currentTab == Just SourceTab) "link icon item"
, onClick (SetTab SourceTab)
]
[ i [ class "upload icon" ] []
, text "Sources"
]
, div
[ classActive (model.currentTab == Just SettingsTab) "link icon item"
, onClick (SetTab SettingsTab)
]
[ i [ class "language icon" ] []
, text "Document Language"
]
, div
[ classActive (model.currentTab == Just UserTab) "link icon item"
, onClick (SetTab UserTab)
]
[ i [ class "user icon" ] []
, text "Users"
]
]
]
]
, div [ class "twelve wide column" ]
[ div [ class "" ]
(case model.currentTab of
Just SourceTab ->
viewSources flags model
Just UserTab ->
viewUsers model
Just InsightsTab ->
viewInsights model
Just SettingsTab ->
viewSettings model
Nothing ->
[]
)
]
]
viewInsights: Model -> List (Html Msg)
viewInsights : Model -> List (Html Msg)
viewInsights model =
[h1 [class "ui header"]
[i [class "chart bar outline icon"][]
,div [class "content"]
[text "Insights"
]
[ h1 [ class "ui header" ]
[ i [ class "chart bar outline icon" ] []
, div [ class "content" ]
[ text "Insights"
]
]
, div [ class "ui basic blue segment" ]
[ h4 [ class "ui header" ]
[ text "Items"
]
, div [ class "ui statistics" ]
[ div [ class "ui statistic" ]
[ div [ class "value" ]
[ String.fromInt (model.insights.incomingCount + model.insights.outgoingCount) |> text
]
, div [ class "label" ]
[ text "Items"
]
]
, div [ class "ui statistic" ]
[ div [ class "value" ]
[ String.fromInt model.insights.incomingCount |> text
]
, div [ class "label" ]
[ text "Incoming"
]
]
, div [ class "ui statistic" ]
[ div [ class "value" ]
[ String.fromInt model.insights.outgoingCount |> text
]
, div [ class "label" ]
[ text "Outgoing"
]
]
]
]
, div [ class "ui basic blue segment" ]
[ h4 [ class "ui header" ]
[ text "Size"
]
, div [ class "ui statistics" ]
[ div [ class "ui statistic" ]
[ div [ class "value" ]
[ toFloat model.insights.itemSize |> Util.Size.bytesReadable Util.Size.B |> text
]
, div [ class "label" ]
[ text "Size"
]
]
]
]
, div [ class "ui basic blue segment" ]
[ h4 [ class "ui header" ]
[ text "Tags"
]
, div [ class "ui statistics" ]
(List.map makeTagStats model.insights.tagCloud.items)
]
,div [class "ui basic blue segment"]
[h4 [class "ui header"]
[text "Items"
]
,div [class "ui statistics"]
[div [class "ui statistic"]
[div [class "value"]
[String.fromInt (model.insights.incomingCount + model.insights.outgoingCount) |> text
]
,div [class "label"]
[text "Items"
]
]
,div [class "ui statistic"]
[div [class "value"]
[String.fromInt model.insights.incomingCount |> text
]
,div [class "label"]
[text "Incoming"
]
]
,div [class "ui statistic"]
[div [class "value"]
[String.fromInt model.insights.outgoingCount |> text
]
,div [class "label"]
[text "Outgoing"
]
]
]
]
,div [class "ui basic blue segment"]
[h4 [class "ui header"]
[text "Size"
]
,div [class "ui statistics"]
[div [class "ui statistic"]
[div [class "value"]
[toFloat model.insights.itemSize |> Util.Size.bytesReadable Util.Size.B |> text
]
,div [class "label"]
[text "Size"
]
]
]
]
,div [class "ui basic blue segment"]
[h4 [class "ui header"]
[text "Tags"
]
,div [class "ui statistics"]
(List.map makeTagStats model.insights.tagCloud.items)
]
]
makeTagStats: NameCount -> Html Msg
makeTagStats : NameCount -> Html Msg
makeTagStats nc =
div [class "ui statistic"]
[div [class "value"]
[String.fromInt nc.count |> text
]
,div [class "label"]
[text nc.name
div [ class "ui statistic" ]
[ div [ class "value" ]
[ String.fromInt nc.count |> text
]
, div [ class "label" ]
[ text nc.name
]
]
viewSources: Flags -> Model -> List (Html Msg)
viewSources : Flags -> Model -> List (Html Msg)
viewSources flags model =
[h2 [class "ui header"]
[i [class "ui upload icon"][]
,div [class "content"]
[text "Sources"
[ h2 [ class "ui header" ]
[ i [ class "ui upload icon" ] []
, div [ class "content" ]
[ text "Sources"
]
]
,Html.map SourceMsg (Comp.SourceManage.view flags model.sourceModel)
, Html.map SourceMsg (Comp.SourceManage.view flags model.sourceModel)
]
viewUsers: Model -> List (Html Msg)
viewUsers : Model -> List (Html Msg)
viewUsers model =
[h2 [class "ui header"]
[i [class "ui user icon"][]
,div [class "content"]
[text "Users"
[ h2 [ class "ui header" ]
[ i [ class "ui user icon" ] []
, div [ class "content" ]
[ text "Users"
]
]
,Html.map UserMsg (Comp.UserManage.view model.userModel)
, Html.map UserMsg (Comp.UserManage.view model.userModel)
]
viewSettings: Model -> List (Html Msg)
viewSettings : Model -> List (Html Msg)
viewSettings model =
[div [class "ui grid"]
[div [class "row"]
[div [class "sixteen wide colum"]
[h2 [class "ui header"]
[i [class "ui language icon"][]
,div [class "content"]
[text "Document Language"
]
[ div [ class "ui grid" ]
[ div [ class "row" ]
[ div [ class "sixteen wide colum" ]
[ h2 [ class "ui header" ]
[ i [ class "ui language icon" ] []
, div [ class "content" ]
[ text "Document Language"
]
]
]
,div [class "row"]
[div [class "six wide column"]
[div [class "ui basic segment"]
[text "The language of your documents. This helps text recognition (OCR) and text analysis."
]
]
]
, div [ class "row" ]
[ div [ class "six wide column" ]
[ div [ class "ui basic segment" ]
[ text "The language of your documents. This helps text recognition (OCR) and text analysis."
]
]
]
, div [ class "row" ]
[ div [ class "six wide column" ]
[ Html.map SettingsMsg (Comp.Settings.view model.settingsModel)
, div
[ classList
[ ( "ui message", True )
, ( "hidden", Util.Maybe.isEmpty model.submitResult )
, ( "success", Maybe.map .success model.submitResult |> Maybe.withDefault False )
, ( "error", Maybe.map .success model.submitResult |> Maybe.map not |> Maybe.withDefault False )
]
]
]
,div [class "row"]
[div [class "six wide column"]
[Html.map SettingsMsg (Comp.Settings.view model.settingsModel)
,div [classList [("ui message", True)
,("hidden", Util.Maybe.isEmpty model.submitResult)
,("success", Maybe.map .success model.submitResult |> Maybe.withDefault False)
,("error", Maybe.map .success model.submitResult |> Maybe.map not |> Maybe.withDefault False)
]]
[Maybe.map .message model.submitResult
|> Maybe.withDefault ""
|> text
]
]
]
]
[ Maybe.map .message model.submitResult
|> Maybe.withDefault ""
|> text
]
]
]
]
]

39
modules/webapp/src/main/elm/Page/Home/Data.elm
View File

@ -1,22 +1,29 @@
module Page.Home.Data exposing (..)
module Page.Home.Data exposing
( Model
, Msg(..)
, ViewMode(..)
, emptyModel
)
import Http
import Comp.SearchMenu
import Comp.ItemList
import Comp.ItemDetail
import Api.Model.ItemLightList exposing (ItemLightList)
import Api.Model.ItemDetail exposing (ItemDetail)
import Api.Model.ItemLightList exposing (ItemLightList)
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Http
type alias Model =
{ searchMenuModel: Comp.SearchMenu.Model
, itemListModel: Comp.ItemList.Model
, searchInProgress: Bool
, itemDetailModel: Comp.ItemDetail.Model
, viewMode: ViewMode
{ searchMenuModel : Comp.SearchMenu.Model
, itemListModel : Comp.ItemList.Model
, searchInProgress : Bool
, itemDetailModel : Comp.ItemDetail.Model
, viewMode : ViewMode
}
emptyModel: Model
emptyModel =
emptyModel : Model
emptyModel =
{ searchMenuModel = Comp.SearchMenu.emptyModel
, itemListModel = Comp.ItemList.emptyModel
, itemDetailModel = Comp.ItemDetail.emptyModel
@ -24,6 +31,7 @@ emptyModel =
, viewMode = Listing
}
type Msg
= Init
| SearchMenuMsg Comp.SearchMenu.Msg
@ -33,4 +41,7 @@ type Msg
| ItemDetailMsg Comp.ItemDetail.Msg
| ItemDetailResp (Result Http.Error ItemDetail)
type ViewMode = Listing | Detail
type ViewMode
= Listing
| Detail

139
modules/webapp/src/main/elm/Page/Home/Update.elm
View File

@ -1,14 +1,15 @@
module Page.Home.Update exposing (update)
import Api
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Data.Flags exposing (Flags)
import Page.Home.Data exposing (..)
import Comp.SearchMenu
import Comp.ItemList
import Comp.ItemDetail
import Util.Update
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
Init ->
@ -21,80 +22,108 @@ update flags msg model =
SearchMenuMsg m ->
let
nextState = Comp.SearchMenu.update flags m model.searchMenuModel
newModel = {model | searchMenuModel = Tuple.first nextState.modelCmd}
(m2, c2) = if nextState.stateChange then doSearch flags newModel else (newModel, Cmd.none)
nextState =
Comp.SearchMenu.update flags m model.searchMenuModel
newModel =
{ model | searchMenuModel = Tuple.first nextState.modelCmd }
( m2, c2 ) =
if nextState.stateChange then
doSearch flags newModel
else
( newModel, Cmd.none )
in
(m2, Cmd.batch [c2, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd)])
( m2, Cmd.batch [ c2, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd) ] )
ItemListMsg m ->
let
(m2, c2, mitem) = Comp.ItemList.update flags m model.itemListModel
cmd = case mitem of
Just item ->
Api.itemDetail flags item.id ItemDetailResp
Nothing ->
Cmd.none
( m2, c2, mitem ) =
Comp.ItemList.update flags m model.itemListModel
cmd =
case mitem of
Just item ->
Api.itemDetail flags item.id ItemDetailResp
Nothing ->
Cmd.none
in
({model | itemListModel = m2}, Cmd.batch [ Cmd.map ItemListMsg c2, cmd ])
( { model | itemListModel = m2 }, Cmd.batch [ Cmd.map ItemListMsg c2, cmd ] )
ItemSearchResp (Ok list) ->
let
m = {model|searchInProgress = False, viewMode = Listing}
m =
{ model | searchInProgress = False, viewMode = Listing }
in
update flags (ItemListMsg (Comp.ItemList.SetResults list)) m
update flags (ItemListMsg (Comp.ItemList.SetResults list)) m
ItemSearchResp (Err err) ->
({model|searchInProgress = False}, Cmd.none)
ItemSearchResp (Err _) ->
( { model | searchInProgress = False }, Cmd.none )
DoSearch ->
doSearch flags model
ItemDetailMsg m ->
let
(m2, c2, nav) = Comp.ItemDetail.update flags m model.itemDetailModel
newModel = {model | itemDetailModel = m2}
newCmd = Cmd.map ItemDetailMsg c2
( m2, c2, nav ) =
Comp.ItemDetail.update flags m model.itemDetailModel
newModel =
{ model | itemDetailModel = m2 }
newCmd =
Cmd.map ItemDetailMsg c2
in
case nav of
Comp.ItemDetail.NavBack ->
doSearch flags newModel
Comp.ItemDetail.NavPrev ->
case Comp.ItemList.prevItem model.itemListModel m2.item.id of
Just n ->
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp])
Nothing ->
(newModel, newCmd)
Comp.ItemDetail.NavNext ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n ->
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp])
Nothing ->
(newModel, newCmd)
Comp.ItemDetail.NavNextOrBack ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n ->
(newModel, Cmd.batch [newCmd, Api.itemDetail flags n.id ItemDetailResp])
Nothing ->
doSearch flags newModel
Comp.ItemDetail.NavNone ->
(newModel, newCmd)
case nav of
Comp.ItemDetail.NavBack ->
doSearch flags newModel
Comp.ItemDetail.NavPrev ->
case Comp.ItemList.prevItem model.itemListModel m2.item.id of
Just n ->
( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
Nothing ->
( newModel, newCmd )
Comp.ItemDetail.NavNext ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n ->
( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
Nothing ->
( newModel, newCmd )
Comp.ItemDetail.NavNextOrBack ->
case Comp.ItemList.nextItem model.itemListModel m2.item.id of
Just n ->
( newModel, Cmd.batch [ newCmd, Api.itemDetail flags n.id ItemDetailResp ] )
Nothing ->
doSearch flags newModel
Comp.ItemDetail.NavNone ->
( newModel, newCmd )
ItemDetailResp (Ok item) ->
let
m = {model | viewMode = Detail}
m =
{ model | viewMode = Detail }
in
update flags (ItemDetailMsg (Comp.ItemDetail.SetItem item)) m
update flags (ItemDetailMsg (Comp.ItemDetail.SetItem item)) m
ItemDetailResp (Err err) ->
let
_ = Debug.log "Error" err
in
(model, Cmd.none)
ItemDetailResp (Err _) ->
( model, Cmd.none )
doSearch: Flags -> Model -> (Model, Cmd Msg)
doSearch : Flags -> Model -> ( Model, Cmd Msg )
doSearch flags model =
let
mask = Comp.SearchMenu.getItemSearch model.searchMenuModel
mask =
Comp.SearchMenu.getItemSearch model.searchMenuModel
in
({model|searchInProgress = True, viewMode = Listing}, Api.itemSearch flags mask ItemSearchResp)
( { model | searchInProgress = True, viewMode = Listing }
, Api.itemSearch flags mask ItemSearchResp
)

124
modules/webapp/src/main/elm/Page/Home/View.elm
View File

@ -1,74 +1,78 @@
module Page.Home.View exposing (view)
import Comp.ItemDetail
import Comp.ItemList
import Comp.SearchMenu
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page exposing (Page(..))
import Page.Home.Data exposing (..)
import Comp.SearchMenu
import Comp.ItemList
import Comp.ItemDetail
import Data.Flags
import Util.Html exposing (onClickk)
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div [class "home-page ui padded grid"]
[div [class "four wide column"]
[div [class "ui top attached ablue-comp menu"]
[h4 [class "header item"]
[text "Search"
]
,div [class "right floated menu"]
[a [class "item"
,onClick DoSearch
,href ""
]
[i [class "ui search icon"][]
]
]
]
,div [class "ui attached fluid segment"]
[(Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel))
]
]
,div [class "twelve wide column"]
[case model.viewMode of
Listing ->
if model.searchInProgress then resultPlaceholder
else (Html.map ItemListMsg (Comp.ItemList.view model.itemListModel))
Detail ->
Html.map ItemDetailMsg (Comp.ItemDetail.view model.itemDetailModel)
div [ class "home-page ui padded grid" ]
[ div [ class "four wide column" ]
[ div [ class "ui top attached ablue-comp menu" ]
[ h4 [ class "header item" ]
[ text "Search"
]
, div [ class "right floated menu" ]
[ a
[ class "item"
, onClick DoSearch
, href ""
]
[ i [ class "ui search icon" ] []
]
]
]
, div [ class "ui attached fluid segment" ]
[ Html.map SearchMenuMsg (Comp.SearchMenu.view model.searchMenuModel)
]
]
, div [ class "twelve wide column" ]
[ case model.viewMode of
Listing ->
if model.searchInProgress then
resultPlaceholder
else
Html.map ItemListMsg (Comp.ItemList.view model.itemListModel)
Detail ->
Html.map ItemDetailMsg (Comp.ItemDetail.view model.itemDetailModel)
]
]
resultPlaceholder: Html Msg
resultPlaceholder : Html Msg
resultPlaceholder =
div [class "ui basic segment"]
[div [class "ui active inverted dimmer"]
[div [class "ui medium text loader"]
[text "Searching …"
]
]
,div [class "ui middle aligned very relaxed divided basic list segment"]
[div [class "item"]
[div [class "ui fluid placeholder"]
[div [class "full line"][]
,div [class "full line"][]
]
]
,div [class "item"]
[div [class "ui fluid placeholder"]
[div [class "full line"][]
,div [class "full line"][]
]
]
,div [class "item"]
[div [class "ui fluid placeholder"]
[div [class "full line"][]
,div [class "full line"][]
]
]
]
div [ class "ui basic segment" ]
[ div [ class "ui active inverted dimmer" ]
[ div [ class "ui medium text loader" ]
[ text "Searching …"
]
]
, div [ class "ui middle aligned very relaxed divided basic list segment" ]
[ div [ class "item" ]
[ div [ class "ui fluid placeholder" ]
[ div [ class "full line" ] []
, div [ class "full line" ] []
]
]
, div [ class "item" ]
[ div [ class "ui fluid placeholder" ]
[ div [ class "full line" ] []
, div [ class "full line" ] []
]
]
, div [ class "item" ]
[ div [ class "ui fluid placeholder" ]
[ div [ class "full line" ] []
, div [ class "full line" ] []
]
]
]
]

19
modules/webapp/src/main/elm/Page/Login/Data.elm
View File

@ -1,22 +1,29 @@
module Page.Login.Data exposing (..)
module Page.Login.Data exposing
( Model
, Msg(..)
, emptyModel
)
import Api.Model.AuthResult exposing (AuthResult)
import Http
import Page exposing (Page(..))
import Api.Model.AuthResult exposing (AuthResult)
type alias Model =
{ username: String
, password: String
, result: Maybe AuthResult
{ username : String
, password : String
, result : Maybe AuthResult
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ username = ""
, password = ""
, result = Nothing
}
type Msg
= SetUsername String
| SetPassword String

49
modules/webapp/src/main/elm/Page/Login/Update.elm
View File

@ -1,42 +1,53 @@
module Page.Login.Update exposing (update)
import Api
import Ports
import Api.Model.AuthResult exposing (AuthResult)
import Api.Model.UserPass exposing (UserPass)
import Data.Flags exposing (Flags)
import Page exposing (Page(..))
import Page.Login.Data exposing (..)
import Api.Model.UserPass exposing (UserPass)
import Api.Model.AuthResult exposing (AuthResult)
import Ports
import Util.Http
update: Maybe Page -> Flags -> Msg -> Model -> (Model, Cmd Msg, Maybe AuthResult)
update : Maybe Page -> Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe AuthResult )
update referrer flags msg model =
case msg of
SetUsername str ->
({model | username = str}, Cmd.none, Nothing)
( { model | username = str }, Cmd.none, Nothing )
SetPassword str ->
({model | password = str}, Cmd.none, Nothing)
( { model | password = str }, Cmd.none, Nothing )
Authenticate ->
(model, Api.login flags (UserPass model.username model.password) AuthResp, Nothing)
( model, Api.login flags (UserPass model.username model.password) AuthResp, Nothing )
AuthResp (Ok lr) ->
let
gotoRef = Maybe.withDefault HomePage referrer |> Page.goto
gotoRef =
Maybe.withDefault HomePage referrer |> Page.goto
in
if lr.success
then ({model|result = Just lr, password = ""}, Cmd.batch [setAccount lr, gotoRef], Just lr)
else ({model|result = Just lr, password = ""}, Ports.removeAccount (), Just lr)
if lr.success then
( { model | result = Just lr, password = "" }, Cmd.batch [ setAccount lr, gotoRef ], Just lr )
else
( { model | result = Just lr, password = "" }, Ports.removeAccount (), Just lr )
AuthResp (Err err) ->
let
empty = Api.Model.AuthResult.empty
lr = {empty|message = Util.Http.errorToString err}
in
({model|password = "", result = Just lr}, Ports.removeAccount (), Just empty)
empty =
Api.Model.AuthResult.empty
setAccount: AuthResult -> Cmd msg
lr =
{ empty | message = Util.Http.errorToString err }
in
( { model | password = "", result = Just lr }, Ports.removeAccount (), Just empty )
setAccount : AuthResult -> Cmd msg
setAccount result =
if result.success
then Ports.setAccount result
else Ports.removeAccount ()
if result.success then
Ports.setAccount result
else
Ports.removeAccount ()

142
modules/webapp/src/main/elm/Page/Login/View.elm
View File

@ -1,87 +1,97 @@
module Page.Login.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
import Html.Events exposing (onInput, onSubmit)
import Page exposing (Page(..))
import Page.Login.Data exposing (..)
import Data.Flags exposing (Flags)
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
div [class "login-page"]
[div [class "ui centered grid"]
[div [class "row"]
[div [class "six wide column ui segment login-view"]
[h1 [class "ui center aligned icon header"]
[img [class "ui image"
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
][]
,div [class "content"]
[text "Sign in to Docspell"
]
div [ class "login-page" ]
[ div [ class "ui centered grid" ]
[ div [ class "row" ]
[ div [ class "six wide column ui segment login-view" ]
[ h1 [ class "ui center aligned icon header" ]
[ img
[ class "ui image"
, src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
]
,Html.form [ class "ui large error raised form segment"
, onSubmit Authenticate
, autocomplete False
]
[div [class "field"]
[label [][text "Username"]
,div [class "ui left icon input"]
[input [type_ "text"
,autocomplete False
,onInput SetUsername
,value model.username
,placeholder "Collective / Login"
,autofocus True
][]
,i [class "user icon"][]
]
]
,div [class "field"]
[label [][text "Password"]
,div [class "ui left icon input"]
[input [type_ "password"
,autocomplete False
,onInput SetPassword
,value model.password
,placeholder "Password"
][]
,i [class "lock icon"][]
[]
, div [ class "content" ]
[ text "Sign in to Docspell"
]
]
, Html.form
[ class "ui large error raised form segment"
, onSubmit Authenticate
, autocomplete False
]
[ div [ class "field" ]
[ label [] [ text "Username" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "text"
, autocomplete False
, onInput SetUsername
, value model.username
, placeholder "Collective / Login"
, autofocus True
]
]
,button [class "ui primary fluid button"
,type_ "submit"
]
[text "Login"
[]
, i [ class "user icon" ] []
]
]
,(resultMessage model)
,div[class "ui very basic right aligned segment"]
[text "No account? "
,a [class "ui icon link", Page.href RegisterPage]
[i [class "edit icon"][]
,text "Sign up!"
]
]
]
]
]
]
, div [ class "field" ]
[ label [] [ text "Password" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "password"
, autocomplete False
, onInput SetPassword
, value model.password
, placeholder "Password"
]
[]
, i [ class "lock icon" ] []
]
]
, button
[ class "ui primary fluid button"
, type_ "submit"
]
[ text "Login"
]
]
, resultMessage model
, div [ class "ui very basic right aligned segment" ]
[ text "No account? "
, a [ class "ui icon link", Page.href RegisterPage ]
[ i [ class "edit icon" ] []
, text "Sign up!"
]
]
]
]
]
]
resultMessage: Model -> Html Msg
resultMessage : Model -> Html Msg
resultMessage model =
case model.result of
Just r ->
if r.success
then
div [class "ui success message"]
[text "Login successful."
if r.success then
div [ class "ui success message" ]
[ text "Login successful."
]
else
div [class "ui error message"]
[text r.message
div [ class "ui error message" ]
[ text r.message
]
Nothing ->
span [][]
span [] []

25
modules/webapp/src/main/elm/Page/ManageData/Data.elm
View File

@ -1,19 +1,26 @@
module Page.ManageData.Data exposing (..)
module Page.ManageData.Data exposing
( Model
, Msg(..)
, Tab(..)
, emptyModel
)
import Comp.TagManage
import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
type alias Model =
{ currentTab: Maybe Tab
, tagManageModel: Comp.TagManage.Model
, equipManageModel: Comp.EquipmentManage.Model
, orgManageModel: Comp.OrgManage.Model
, personManageModel: Comp.PersonManage.Model
{ currentTab : Maybe Tab
, tagManageModel : Comp.TagManage.Model
, equipManageModel : Comp.EquipmentManage.Model
, orgManageModel : Comp.OrgManage.Model
, personManageModel : Comp.PersonManage.Model
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ currentTab = Nothing
, tagManageModel = Comp.TagManage.emptyModel
@ -22,12 +29,14 @@ emptyModel =
, personManageModel = Comp.PersonManage.emptyModel
}
type Tab
= TagTab
| EquipTab
| OrgTab
| PersonTab
type Msg
= SetTab Tab
| TagManageMsg Comp.TagManage.Msg

50
modules/webapp/src/main/elm/Page/ManageData/Update.elm
View File

@ -1,52 +1,58 @@
module Page.ManageData.Update exposing (update)
import Page.ManageData.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.TagManage
import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
import Data.Flags exposing (Flags)
import Page.ManageData.Data exposing (..)
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTab t ->
let
m = { model | currentTab = Just t }
m =
{ model | currentTab = Just t }
in
case t of
TagTab ->
update flags (TagManageMsg Comp.TagManage.LoadTags) m
case t of
TagTab ->
update flags (TagManageMsg Comp.TagManage.LoadTags) m
EquipTab ->
update flags (EquipManageMsg Comp.EquipmentManage.LoadEquipments) m
EquipTab ->
update flags (EquipManageMsg Comp.EquipmentManage.LoadEquipments) m
OrgTab ->
update flags (OrgManageMsg Comp.OrgManage.LoadOrgs) m
OrgTab ->
update flags (OrgManageMsg Comp.OrgManage.LoadOrgs) m
PersonTab ->
update flags (PersonManageMsg Comp.PersonManage.LoadPersons) m
PersonTab ->
update flags (PersonManageMsg Comp.PersonManage.LoadPersons) m
TagManageMsg m ->
let
(m2, c2) = Comp.TagManage.update flags m model.tagManageModel
( m2, c2 ) =
Comp.TagManage.update flags m model.tagManageModel
in
({model | tagManageModel = m2}, Cmd.map TagManageMsg c2)
( { model | tagManageModel = m2 }, Cmd.map TagManageMsg c2 )
EquipManageMsg m ->
let
(m2, c2) = Comp.EquipmentManage.update flags m model.equipManageModel
( m2, c2 ) =
Comp.EquipmentManage.update flags m model.equipManageModel
in
({model | equipManageModel = m2}, Cmd.map EquipManageMsg c2)
( { model | equipManageModel = m2 }, Cmd.map EquipManageMsg c2 )
OrgManageMsg m ->
let
(m2, c2) = Comp.OrgManage.update flags m model.orgManageModel
( m2, c2 ) =
Comp.OrgManage.update flags m model.orgManageModel
in
({model | orgManageModel = m2}, Cmd.map OrgManageMsg c2)
( { model | orgManageModel = m2 }, Cmd.map OrgManageMsg c2 )
PersonManageMsg m ->
let
(m2, c2) = Comp.PersonManage.update flags m model.personManageModel
( m2, c2 ) =
Comp.PersonManage.update flags m model.personManageModel
in
({model | personManageModel = m2}, Cmd.map PersonManageMsg c2)
( { model | personManageModel = m2 }, Cmd.map PersonManageMsg c2 )

167
modules/webapp/src/main/elm/Page/ManageData/View.elm
View File

@ -1,104 +1,121 @@
module Page.ManageData.View exposing (view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Util.Html exposing (classActive)
import Page.ManageData.Data exposing (..)
import Comp.TagManage
import Comp.EquipmentManage
import Comp.OrgManage
import Comp.PersonManage
import Comp.TagManage
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.ManageData.Data exposing (..)
import Util.Html exposing (classActive)
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div [class "managedata-page ui padded grid"]
[div [class "four wide column"]
[h4 [class "ui top attached ablue-comp header"]
[text "Manage Data"
]
,div [class "ui attached fluid segment"]
[div [class "ui fluid vertical secondary menu"]
[div [classActive (model.currentTab == Just TagTab) "link icon item"
,onClick (SetTab TagTab)
]
[i [class "tag icon"][]
,text "Tag"
]
,div [classActive (model.currentTab == Just EquipTab) "link icon item"
,onClick (SetTab EquipTab)
]
[i [class "box icon"][]
,text "Equipment"
]
,div [classActive (model.currentTab == Just OrgTab) "link icon item"
,onClick (SetTab OrgTab)
]
[i [class "factory icon"][]
,text "Organization"
]
,div [classActive (model.currentTab == Just PersonTab) "link icon item"
,onClick (SetTab PersonTab)
]
[i [class "user icon"][]
,text "Person"
]
]
]
]
,div [class "twelve wide column"]
[div [class ""]
(case model.currentTab of
Just TagTab -> viewTags model
Just EquipTab -> viewEquip model
Just OrgTab -> viewOrg model
Just PersonTab -> viewPerson model
Nothing -> []
)
div [ class "managedata-page ui padded grid" ]
[ div [ class "four wide column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
[ text "Manage Data"
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[ div
[ classActive (model.currentTab == Just TagTab) "link icon item"
, onClick (SetTab TagTab)
]
[ i [ class "tag icon" ] []
, text "Tag"
]
, div
[ classActive (model.currentTab == Just EquipTab) "link icon item"
, onClick (SetTab EquipTab)
]
[ i [ class "box icon" ] []
, text "Equipment"
]
, div
[ classActive (model.currentTab == Just OrgTab) "link icon item"
, onClick (SetTab OrgTab)
]
[ i [ class "factory icon" ] []
, text "Organization"
]
, div
[ classActive (model.currentTab == Just PersonTab) "link icon item"
, onClick (SetTab PersonTab)
]
[ i [ class "user icon" ] []
, text "Person"
]
]
]
]
, div [ class "twelve wide column" ]
[ div [ class "" ]
(case model.currentTab of
Just TagTab ->
viewTags model
Just EquipTab ->
viewEquip model
Just OrgTab ->
viewOrg model
Just PersonTab ->
viewPerson model
Nothing ->
[]
)
]
]
viewTags: Model -> List (Html Msg)
viewTags : Model -> List (Html Msg)
viewTags model =
[h2 [class "ui header"]
[i [class "ui tag icon"][]
,div [class "content"]
[text "Tags"
[ h2 [ class "ui header" ]
[ i [ class "ui tag icon" ] []
, div [ class "content" ]
[ text "Tags"
]
]
,Html.map TagManageMsg (Comp.TagManage.view model.tagManageModel)
, Html.map TagManageMsg (Comp.TagManage.view model.tagManageModel)
]
viewEquip: Model -> List (Html Msg)
viewEquip : Model -> List (Html Msg)
viewEquip model =
[h2 [class "ui header"]
[i [class "ui box icon"][]
,div [class "content"]
[text "Equipment"
[ h2 [ class "ui header" ]
[ i [ class "ui box icon" ] []
, div [ class "content" ]
[ text "Equipment"
]
]
,Html.map EquipManageMsg (Comp.EquipmentManage.view model.equipManageModel)
, Html.map EquipManageMsg (Comp.EquipmentManage.view model.equipManageModel)
]
viewOrg: Model -> List (Html Msg)
viewOrg : Model -> List (Html Msg)
viewOrg model =
[h2 [class "ui header"]
[i [class "ui factory icon"][]
,div [class "content"]
[text "Organizations"
[ h2 [ class "ui header" ]
[ i [ class "ui factory icon" ] []
, div [ class "content" ]
[ text "Organizations"
]
]
,Html.map OrgManageMsg (Comp.OrgManage.view model.orgManageModel)
, Html.map OrgManageMsg (Comp.OrgManage.view model.orgManageModel)
]
viewPerson: Model -> List (Html Msg)
viewPerson : Model -> List (Html Msg)
viewPerson model =
[h2 [class "ui header"]
[i [class "ui user icon"][]
,div [class "content"]
[text "Person"
[ h2 [ class "ui header" ]
[ i [ class "ui user icon" ] []
, div [ class "content" ]
[ text "Person"
]
]
,Html.map PersonManageMsg (Comp.PersonManage.view model.personManageModel)
, Html.map PersonManageMsg (Comp.PersonManage.view model.personManageModel)
]

40
modules/webapp/src/main/elm/Page/NewInvite/Data.elm
View File

@ -1,37 +1,55 @@
module Page.NewInvite.Data exposing (..)
module Page.NewInvite.Data exposing
( Model
, Msg(..)
, State(..)
, emptyModel
, isFailed
, isSuccess
)
import Http
import Api.Model.InviteResult exposing (InviteResult)
import Http
type alias Model =
{ password: String
, result: State
{ password : String
, result : State
}
type State
= Empty
| Failed String
| Success InviteResult
isFailed: State -> Bool
isFailed : State -> Bool
isFailed state =
case state of
Failed _ -> True
_ -> False
Failed _ ->
True
isSuccess: State -> Bool
_ ->
False
isSuccess : State -> Bool
isSuccess state =
case state of
Success _ -> True
_ -> False
Success _ ->
True
emptyModel: Model
_ ->
False
emptyModel : Model
emptyModel =
{ password = ""
, result = Empty
}
type Msg
= SetPassword String
| GenerateInvite

21
modules/webapp/src/main/elm/Page/NewInvite/Update.elm
View File

@ -1,27 +1,30 @@
module Page.NewInvite.Update exposing (update)
import Api
import Api.Model.GenInvite exposing (GenInvite)
import Data.Flags exposing (Flags)
import Page.NewInvite.Data exposing (..)
import Api.Model.GenInvite exposing (GenInvite)
import Api.Model.InviteResult
import Util.Http
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetPassword str ->
({model|password = str}, Cmd.none)
( { model | password = str }, Cmd.none )
Reset ->
(emptyModel, Cmd.none)
( emptyModel, Cmd.none )
GenerateInvite ->
(model, Api.newInvite flags (GenInvite model.password) InviteResp)
( model, Api.newInvite flags (GenInvite model.password) InviteResp )
InviteResp (Ok res) ->
if res.success then ({model | result = (Success res)}, Cmd.none)
else ({model | result = (Failed res.message)}, Cmd.none)
if res.success then
( { model | result = Success res }, Cmd.none )
else
( { model | result = Failed res.message }, Cmd.none )
InviteResp (Err err) ->
({model|result = Failed (Util.Http.errorToString err)}, Cmd.none)
( { model | result = Failed (Util.Http.errorToString err) }, Cmd.none )

187
modules/webapp/src/main/elm/Page/NewInvite/View.elm
View File

@ -1,106 +1,121 @@
module Page.NewInvite.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
import Data.Flags exposing (Flags)
import Page.NewInvite.Data exposing (..)
import Api.Model.InviteResult
import Util.Maybe
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
div [class "newinvite-page"]
[div [class "ui centered grid"]
[div [class "row"]
[div [class "eight wide column ui segment newinvite-view"]
[h1 [class "ui cener aligned icon header"]
[img [class "ui image"
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
][]
,div [class "content"]
[text "Create new invitations"
div [ class "newinvite-page" ]
[ div [ class "ui centered grid" ]
[ div [ class "row" ]
[ div [ class "eight wide column ui segment newinvite-view" ]
[ h1 [ class "ui cener aligned icon header" ]
[ img
[ class "ui image"
, src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
]
[]
, div [ class "content" ]
[ text "Create new invitations"
]
]
, inviteMessage flags
, Html.form
[ classList
[ ( "ui large form raised segment", True )
, ( "error", isFailed model.result )
, ( "success", isSuccess model.result )
]
, onSubmit GenerateInvite
]
[ div [ class "required field" ]
[ label [] [ text "New Invitation Password" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "password"
, onInput SetPassword
, value model.password
, autofocus True
]
[]
, i [ class "key icon" ] []
]
]
,inviteMessage flags
,Html.form [classList [("ui large form raised segment", True)
,("error", isFailed model.result)
,("success", isSuccess model.result)
]
, onSubmit GenerateInvite]
[div [class "required field"]
[label [][text "New Invitation Password"]
,div [class "ui left icon input"]
[input [type_ "password"
,onInput SetPassword
,value model.password
,autofocus True
][]
,i [class "key icon"][]
]
]
,button [class "ui primary button"
,type_ "submit"
]
[text "Submit"
]
,a [class "ui right floated button", href "", onClick Reset]
[text "Reset"
]
,resultMessage model
]
]
]
]
]
, button
[ class "ui primary button"
, type_ "submit"
]
[ text "Submit"
]
, a [ class "ui right floated button", href "", onClick Reset ]
[ text "Reset"
]
, resultMessage model
]
]
]
]
]
resultMessage: Model -> Html Msg
resultMessage : Model -> Html Msg
resultMessage model =
div [classList [("ui message", True)
,("error", isFailed model.result)
,("success", isSuccess model.result)
,("hidden", model.result == Empty)
]]
[case model.result of
Failed m ->
div [class "content"]
[div [class "header"][text "Error"]
,p [][text m]
]
Success r ->
div [class "content"]
[div [class "header"][text "Success"]
,p [][text r.message]
,p [][text "Invitation Key:"]
,pre[][Maybe.withDefault "" r.key |> text
]
]
Empty ->
span[][]
div
[ classList
[ ( "ui message", True )
, ( "error", isFailed model.result )
, ( "success", isSuccess model.result )
, ( "hidden", model.result == Empty )
]
]
[ case model.result of
Failed m ->
div [ class "content" ]
[ div [ class "header" ] [ text "Error" ]
, p [] [ text m ]
]
Success r ->
div [ class "content" ]
[ div [ class "header" ] [ text "Success" ]
, p [] [ text r.message ]
, p [] [ text "Invitation Key:" ]
, pre []
[ Maybe.withDefault "" r.key |> text
]
]
Empty ->
span [] []
]
inviteMessage: Flags -> Html Msg
inviteMessage flags =
div [classList [("ui message", True)
,("hidden", flags.config.signupMode /= "invite")
]]
[p [][text
"""Docspell requires an invite when signing up. You can
inviteMessage : Flags -> Html Msg
inviteMessage flags =
div
[ classList
[ ( "ui message", True )
, ( "hidden", flags.config.signupMode /= "invite" )
]
]
[ p []
[ text
"""Docspell requires an invite when signing up. You can
create these invites here and send them to friends so
they can signup with docspell."""
]
,p [][text
"""Each invite can only be used once. You'll need to
]
, p []
[ text
"""Each invite can only be used once. You'll need to
create one key for each person you want to invite."""
]
,p [][text
"""Creating an invite requires providing the password
]
, p []
[ text
"""Creating an invite requires providing the password
from the configuration."""
]
]
]

87
modules/webapp/src/main/elm/Page/Queue/Data.elm
View File

@ -1,27 +1,35 @@
module Page.Queue.Data exposing (..)
module Page.Queue.Data exposing
( Model
, Msg(..)
, emptyModel
, getDuration
, getRunningTime
)
import Http
import Api.Model.JobQueueState exposing (JobQueueState)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobQueueState exposing (JobQueueState)
import Comp.YesNoDimmer
import Http
import Time
import Util.Duration
import Util.Maybe
import Comp.YesNoDimmer
type alias Model =
{ state: JobQueueState
, error: String
, pollingInterval: Float
, init: Bool
, stopRefresh: Bool
, currentMillis: Int
, showLog: Maybe JobDetail
, deleteConfirm: Comp.YesNoDimmer.Model
, cancelJobRequest: Maybe String
{ state : JobQueueState
, error : String
, pollingInterval : Float
, init : Bool
, stopRefresh : Bool
, currentMillis : Int
, showLog : Maybe JobDetail
, deleteConfirm : Comp.YesNoDimmer.Model
, cancelJobRequest : Maybe String
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ state = Api.Model.JobQueueState.empty
, error = ""
@ -34,6 +42,7 @@ emptyModel =
, cancelJobRequest = Nothing
}
type Msg
= Init
| StateResp (Result Http.Error JobQueueState)
@ -45,35 +54,45 @@ type Msg
| DimmerMsg JobDetail Comp.YesNoDimmer.Msg
| CancelResp (Result Http.Error BasicResult)
getRunningTime: Model -> JobDetail -> Maybe String
getRunningTime : Model -> JobDetail -> Maybe String
getRunningTime model job =
let
mkTime: Int -> Int -> Maybe String
mkTime : Int -> Int -> Maybe String
mkTime start end =
if start < end then Just <| Util.Duration.toHuman (end - start)
else Nothing
in
case (job.started, job.finished) of
(Just sn, Just fn) ->
Util.Maybe.or
[ mkTime sn fn
, mkTime sn model.currentMillis
]
if start < end then
Just <| Util.Duration.toHuman (end - start)
(Just sn, Nothing) ->
mkTime sn model.currentMillis
(Nothing, _) ->
else
Nothing
in
case ( job.started, job.finished ) of
( Just sn, Just fn ) ->
Util.Maybe.or
[ mkTime sn fn
, mkTime sn model.currentMillis
]
getSubmittedTime: Model -> JobDetail -> Maybe String
( Just sn, Nothing ) ->
mkTime sn model.currentMillis
( Nothing, _ ) ->
Nothing
getSubmittedTime : Model -> JobDetail -> Maybe String
getSubmittedTime model job =
if model.currentMillis > job.submitted then
Just <| Util.Duration.toHuman (model.currentMillis - job.submitted)
else
Nothing
getDuration: Model -> JobDetail -> Maybe String
getDuration : Model -> JobDetail -> Maybe String
getDuration model job =
if job.state == "stuck" then getSubmittedTime model job
else Util.Maybe.or [ (getRunningTime model job), (getSubmittedTime model job) ]
if job.state == "stuck" then
getSubmittedTime model job
else
Util.Maybe.or [ getRunningTime model job, getSubmittedTime model job ]

90
modules/webapp/src/main/elm/Page/Queue/Update.elm
View File

@ -1,76 +1,92 @@
module Page.Queue.Update exposing (update)
import Api
import Ports
import Page.Queue.Data exposing (..)
import Data.Flags exposing (Flags)
import Util.Http
import Time
import Task
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Page.Queue.Data exposing (..)
import Ports
import Task
import Time
import Util.Http
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
Init ->
let
start = if model.init
then Cmd.none
else Cmd.batch
[Api.getJobQueueState flags StateResp
,getNewTime
start =
if model.init then
Cmd.none
else
Cmd.batch
[ Api.getJobQueueState flags StateResp
, getNewTime
]
in
({model|init = True, stopRefresh = False}, start)
( { model | init = True, stopRefresh = False }, start )
StateResp (Ok s) ->
let
progressCmd =
List.map (\job -> Ports.setProgress (job.id, job.progress)) s.progress
_ = Debug.log "stopRefresh" model.stopRefresh
List.map (\job -> Ports.setProgress ( job.id, job.progress )) s.progress
refresh =
if model.pollingInterval <= 0 || model.stopRefresh then Cmd.none
else Cmd.batch
[Api.getJobQueueStateIn flags model.pollingInterval StateResp
,getNewTime
]
if model.pollingInterval <= 0 || model.stopRefresh then
Cmd.none
else
Cmd.batch
[ Api.getJobQueueStateIn flags model.pollingInterval StateResp
, getNewTime
]
in
({model | state = s, stopRefresh = False}, Cmd.batch (refresh :: progressCmd))
( { model | state = s, stopRefresh = False }, Cmd.batch (refresh :: progressCmd) )
StateResp (Err err) ->
({model | error = Util.Http.errorToString err }, Cmd.none)
( { model | error = Util.Http.errorToString err }, Cmd.none )
StopRefresh ->
({model | stopRefresh = True, init = False }, Cmd.none)
( { model | stopRefresh = True, init = False }, Cmd.none )
NewTime t ->
({model | currentMillis = Time.posixToMillis t}, Cmd.none)
( { model | currentMillis = Time.posixToMillis t }, Cmd.none )
ShowLog job ->
({model | showLog = Just job}, Cmd.none)
( { model | showLog = Just job }, Cmd.none )
QuitShowLog ->
({model | showLog = Nothing}, Cmd.none)
( { model | showLog = Nothing }, Cmd.none )
RequestCancelJob job ->
let
newModel = {model|cancelJobRequest = Just job.id}
newModel =
{ model | cancelJobRequest = Just job.id }
in
update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel
update flags (DimmerMsg job Comp.YesNoDimmer.Activate) newModel
DimmerMsg job m ->
let
(cm, confirmed) = Comp.YesNoDimmer.update m model.deleteConfirm
cmd = if confirmed then Api.cancelJob flags job.id CancelResp else Cmd.none
in
({model | deleteConfirm = cm}, cmd)
( cm, confirmed ) =
Comp.YesNoDimmer.update m model.deleteConfirm
CancelResp (Ok r) ->
(model, Cmd.none)
CancelResp (Err err) ->
(model, Cmd.none)
cmd =
if confirmed then
Api.cancelJob flags job.id CancelResp
else
Cmd.none
in
( { model | deleteConfirm = cm }, cmd )
CancelResp (Ok _) ->
( model, Cmd.none )
CancelResp (Err _) ->
( model, Cmd.none )
getNewTime : Cmd Msg
getNewTime =
Task.perform NewTime Time.now
Task.perform NewTime Time.now

411
modules/webapp/src/main/elm/Page/Queue/View.elm
View File

@ -1,217 +1,256 @@
module Page.Queue.View exposing (view)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobLogEvent exposing (JobLogEvent)
import Comp.YesNoDimmer
import Data.Priority
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.Queue.Data exposing (..)
import Api.Model.JobQueueState exposing (JobQueueState)
import Api.Model.JobDetail exposing (JobDetail)
import Api.Model.JobLogEvent exposing (JobLogEvent)
import Data.Priority
import Comp.YesNoDimmer
import Util.Time exposing (formatDateTime, formatIsoDateTime)
import Util.Duration
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div [class "queue-page ui grid container"] <|
div [ class "queue-page ui grid container" ] <|
List.concat
[ case model.showLog of
Just job ->
[renderJobLog job]
Nothing ->
List.map (renderProgressCard model) model.state.progress
|> List.map (\el -> div [class "row"][div [class "column"][el]])
, [div [class "two column row"]
[renderWaiting model
,renderCompleted model
[ case model.showLog of
Just job ->
[ renderJobLog job ]
Nothing ->
List.map (renderProgressCard model) model.state.progress
|> List.map (\el -> div [ class "row" ] [ div [ class "column" ] [ el ] ])
, [ div [ class "two column row" ]
[ renderWaiting model
, renderCompleted model
]
]
]
]
]
renderJobLog: JobDetail -> Html Msg
renderJobLog : JobDetail -> Html Msg
renderJobLog job =
div [class "ui fluid card"]
[div [class "content"]
[i [class "delete link icon", onClick QuitShowLog][]
,text job.name
]
,div [class "content"]
[div [class "job-log"]
(List.map renderLogLine job.logs)
]
]
renderWaiting: Model -> Html Msg
renderWaiting model =
div [class "column"]
[div [class "ui center aligned basic segment"]
[i [class "ui large angle double up icon"][]
]
,div [class "ui centered cards"]
(List.map (renderInfoCard model) model.state.queued)
]
renderCompleted: Model -> Html Msg
renderCompleted model =
div [class "column"]
[div [class "ui center aligned basic segment"]
[i [class "ui large angle double down icon"][]
]
,div [class "ui centered cards"]
(List.map (renderInfoCard model) model.state.completed)
]
renderProgressCard: Model -> JobDetail -> Html Msg
renderProgressCard model job =
div [class "ui fluid card"]
[div [id job.id, class "ui top attached indicating progress"]
[div [class "bar"]
[]
]
,Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm)
,div [class "content"]
[ div [class "right floated meta"]
[div [class "ui label"]
[text job.state
,div [class "detail"]
[Maybe.withDefault "" job.worker |> text
]
]
,div [class "ui basic label"]
[i [class "clock icon"][]
,div [class "detail"]
[getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
]
, i [class "asterisk loading icon"][]
, text job.name
]
,div [class "content"]
[div [class "job-log"]
(List.map renderLogLine job.logs)
]
,div [class "meta"]
[div [class "right floated"]
[button [class "ui button", onClick (RequestCancelJob job)]
[text "Cancel"
]
]
div [ class "ui fluid card" ]
[ div [ class "content" ]
[ i [ class "delete link icon", onClick QuitShowLog ] []
, text job.name
]
, div [ class "content" ]
[ div [ class "job-log" ]
(List.map renderLogLine job.logs)
]
]
renderLogLine: JobLogEvent -> Html Msg
renderLogLine log =
span [class (String.toLower log.level)]
[formatIsoDateTime log.time |> text
,text ": "
,text log.message
, br[][]
renderWaiting : Model -> Html Msg
renderWaiting model =
div [ class "column" ]
[ div [ class "ui center aligned basic segment" ]
[ i [ class "ui large angle double up icon" ] []
]
, div [ class "ui centered cards" ]
(List.map (renderInfoCard model) model.state.queued)
]
isFinal: JobDetail -> Bool
isFinal job =
case job.state of
"failed" -> True
"success" -> True
"cancelled" -> True
_ -> False
dimmerSettings: Comp.YesNoDimmer.Settings
dimmerSettings =
let
defaults = Comp.YesNoDimmer.defaultSettings
in
{ defaults | headerClass = "ui inverted header", headerIcon = "", message = "Cancel/Delete this job?"}
renderInfoCard: Model -> JobDetail -> Html Msg
renderInfoCard model job =
div [classList [("ui fluid card", True)
,(jobStateColor job, True)
]
renderCompleted : Model -> Html Msg
renderCompleted model =
div [ class "column" ]
[ div [ class "ui center aligned basic segment" ]
[ i [ class "ui large angle double down icon" ] []
]
, div [ class "ui centered cards" ]
(List.map (renderInfoCard model) model.state.completed)
]
[Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm)
,div [class "content"]
[div [class "right floated"]
[if isFinal job || job.state == "stuck" then
span [onClick (ShowLog job)]
[i [class "file link icon", title "Show log"][]
renderProgressCard : Model -> JobDetail -> Html Msg
renderProgressCard model job =
div [ class "ui fluid card" ]
[ div [ id job.id, class "ui top attached indicating progress" ]
[ div [ class "bar" ]
[]
]
, Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm)
, div [ class "content" ]
[ div [ class "right floated meta" ]
[ div [ class "ui label" ]
[ text job.state
, div [ class "detail" ]
[ Maybe.withDefault "" job.worker |> text
]
else
span[][]
,i [class "delete link icon", title "Remove", onClick (RequestCancelJob job)][]
]
,if isFinal job then
span [class "invisible"][]
else
div [class "right floated"]
[div [class "meta"]
[getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
,i [classList [("check icon", job.state == "success")
,("redo icon", job.state == "stuck")
,("bolt icon", job.state == "failed")
,("meh outline icon", job.state == "canceled")
,("cog icon", not (isFinal job) && job.state /= "stuck")
]
][]
,text job.name
]
,div [class "content"]
[div [class "right floated"]
[if isFinal job then
div [class ("ui basic label " ++ jobStateColor job)]
[i [class "clock icon"][]
,div [class "detail"]
[getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
else
span [class "invisible"][]
,div [class ("ui basic label " ++ jobStateColor job)]
[text "Prio"
,div [class "detail"]
[code [][Data.Priority.fromString job.priority
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault job.priority
|> text
]
]
]
,div [class ("ui basic label " ++ jobStateColor job)]
[text "Retries"
,div [class "detail"]
[job.retries |> String.fromInt |> text
]
]
]
,jobStateLabel job
,div [class "ui basic label"]
[Util.Time.formatDateTime job.submitted |> text
]
, div [ class "ui basic label" ]
[ i [ class "clock icon" ] []
, div [ class "detail" ]
[ getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
]
, i [ class "asterisk loading icon" ] []
, text job.name
]
, div [ class "content" ]
[ div [ class "job-log" ]
(List.map renderLogLine job.logs)
]
, div [ class "meta" ]
[ div [ class "right floated" ]
[ button [ class "ui button", onClick (RequestCancelJob job) ]
[ text "Cancel"
]
]
]
]
jobStateColor: JobDetail -> String
renderLogLine : JobLogEvent -> Html Msg
renderLogLine log =
span [ class (String.toLower log.level) ]
[ formatIsoDateTime log.time |> text
, text ": "
, text log.message
, br [] []
]
isFinal : JobDetail -> Bool
isFinal job =
case job.state of
"failed" ->
True
"success" ->
True
"cancelled" ->
True
_ ->
False
dimmerSettings : Comp.YesNoDimmer.Settings
dimmerSettings =
let
defaults =
Comp.YesNoDimmer.defaultSettings
in
{ defaults | headerClass = "ui inverted header", headerIcon = "", message = "Cancel/Delete this job?" }
renderInfoCard : Model -> JobDetail -> Html Msg
renderInfoCard model job =
div
[ classList
[ ( "ui fluid card", True )
, ( jobStateColor job, True )
]
]
[ Html.map (DimmerMsg job) (Comp.YesNoDimmer.view2 (model.cancelJobRequest == Just job.id) dimmerSettings model.deleteConfirm)
, div [ class "content" ]
[ div [ class "right floated" ]
[ if isFinal job || job.state == "stuck" then
span [ onClick (ShowLog job) ]
[ i [ class "file link icon", title "Show log" ] []
]
else
span [] []
, i [ class "delete link icon", title "Remove", onClick (RequestCancelJob job) ] []
]
, if isFinal job then
span [ class "invisible" ] []
else
div [ class "right floated" ]
[ div [ class "meta" ]
[ getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
, i
[ classList
[ ( "check icon", job.state == "success" )
, ( "redo icon", job.state == "stuck" )
, ( "bolt icon", job.state == "failed" )
, ( "meh outline icon", job.state == "canceled" )
, ( "cog icon", not (isFinal job) && job.state /= "stuck" )
]
]
[]
, text job.name
]
, div [ class "content" ]
[ div [ class "right floated" ]
[ if isFinal job then
div [ class ("ui basic label " ++ jobStateColor job) ]
[ i [ class "clock icon" ] []
, div [ class "detail" ]
[ getDuration model job |> Maybe.withDefault "-:-" |> text
]
]
else
span [ class "invisible" ] []
, div [ class ("ui basic label " ++ jobStateColor job) ]
[ text "Prio"
, div [ class "detail" ]
[ code []
[ Data.Priority.fromString job.priority
|> Maybe.map Data.Priority.toName
|> Maybe.withDefault job.priority
|> text
]
]
]
, div [ class ("ui basic label " ++ jobStateColor job) ]
[ text "Retries"
, div [ class "detail" ]
[ job.retries |> String.fromInt |> text
]
]
]
, jobStateLabel job
, div [ class "ui basic label" ]
[ Util.Time.formatDateTime job.submitted |> text
]
]
]
jobStateColor : JobDetail -> String
jobStateColor job =
case job.state of
"success" -> "green"
"failed" -> "red"
"canceled" -> "orange"
"stuck" -> "purple"
"scheduled" -> "blue"
"waiting" -> "grey"
_ -> ""
"success" ->
"green"
jobStateLabel: JobDetail -> Html Msg
"failed" ->
"red"
"canceled" ->
"orange"
"stuck" ->
"purple"
"scheduled" ->
"blue"
"waiting" ->
"grey"
_ ->
""
jobStateLabel : JobDetail -> Html Msg
jobStateLabel job =
let
col = jobStateColor job
col =
jobStateColor job
in
div [class ("ui label " ++ col)]
[text job.state
]
div [ class ("ui label " ++ col) ]
[ text job.state
]

35
modules/webapp/src/main/elm/Page/Register/Data.elm
View File

@ -1,23 +1,29 @@
module Page.Register.Data exposing (..)
module Page.Register.Data exposing
( Model
, Msg(..)
, emptyModel
)
import Http
import Api.Model.BasicResult exposing (BasicResult)
import Http
type alias Model =
{ result: Maybe BasicResult
, collId: String
, login: String
, pass1: String
, pass2: String
, showPass1: Bool
, showPass2: Bool
, errorMsg: List String
, loading: Bool
, successMsg: String
, invite: Maybe String
{ result : Maybe BasicResult
, collId : String
, login : String
, pass1 : String
, pass2 : String
, showPass1 : Bool
, showPass2 : Bool
, errorMsg : List String
, loading : Bool
, successMsg : String
, invite : Maybe String
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ result = Nothing
, collId = ""
@ -32,6 +38,7 @@ emptyModel =
, invite = Nothing
}
type Msg
= SetCollId String
| SetLogin String

119
modules/webapp/src/main/elm/Page/Register/Update.elm
View File

@ -1,84 +1,131 @@
module Page.Register.Update exposing (update)
import Api
import Api.Model.Registration exposing (Registration)
import Page.Register.Data exposing (..)
import Data.Flags exposing (Flags)
import Page exposing (Page(..))
import Page.Register.Data exposing (..)
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
RegisterSubmit ->
case model.errorMsg of
[] ->
let
reg = { collectiveName = model.collId
, login = model.login
, password = model.pass1
, invite = model.invite
}
reg =
{ collectiveName = model.collId
, login = model.login
, password = model.pass1
, invite = model.invite
}
in
(model, Api.register flags reg SubmitResp)
( model, Api.register flags reg SubmitResp )
_ ->
(model, Cmd.none)
( model, Cmd.none )
SetCollId str ->
let
m = {model|collId = str}
err = validateForm m
m =
{ model | collId = str }
err =
validateForm m
in
({m|errorMsg = err}, Cmd.none)
( { m | errorMsg = err }, Cmd.none )
SetLogin str ->
let
m = {model|login = str}
err = validateForm m
m =
{ model | login = str }
err =
validateForm m
in
({m|errorMsg = err}, Cmd.none)
( { m | errorMsg = err }, Cmd.none )
SetPass1 str ->
let
m = {model|pass1 = str}
err = validateForm m
m =
{ model | pass1 = str }
err =
validateForm m
in
({m|errorMsg = err}, Cmd.none)
( { m | errorMsg = err }, Cmd.none )
SetPass2 str ->
let
m = {model|pass2 = str}
err = validateForm m
m =
{ model | pass2 = str }
err =
validateForm m
in
({m|errorMsg = err}, Cmd.none)
( { m | errorMsg = err }, Cmd.none )
SetInvite str ->
({model | invite = if str == "" then Nothing else Just str}, Cmd.none)
( { model
| invite =
if str == "" then
Nothing
else
Just str
}
, Cmd.none
)
ToggleShowPass1 ->
({model|showPass1 = not model.showPass1}, Cmd.none)
( { model | showPass1 = not model.showPass1 }, Cmd.none )
ToggleShowPass2 ->
({model|showPass2 = not model.showPass2}, Cmd.none)
( { model | showPass2 = not model.showPass2 }, Cmd.none )
SubmitResp (Ok r) ->
let
m = emptyModel
cmd = if r.success then Page.goto (LoginPage Nothing) else Cmd.none
m =
emptyModel
cmd =
if r.success then
Page.goto (LoginPage Nothing)
else
Cmd.none
in
({m|result = if r.success then Nothing else Just r}, cmd)
( { m
| result =
if r.success then
Nothing
else
Just r
}
, cmd
)
SubmitResp (Err err) ->
(model, Cmd.none)
( model, Cmd.none )
validateForm: Model -> List String
validateForm : Model -> List String
validateForm model =
if model.collId == "" ||
model.login == "" ||
model.pass1 == "" ||
model.pass2 == "" then
[ "All fields are required!"]
if
model.collId
== ""
|| model.login
== ""
|| model.pass1
== ""
|| model.pass2
== ""
then
[ "All fields are required!" ]
else if model.pass1 /= model.pass2 then
["The passwords do not match."]
[ "The passwords do not match." ]
else
[]

253
modules/webapp/src/main/elm/Page/Register/View.elm
View File

@ -1,131 +1,164 @@
module Page.Register.View exposing (view)
import Data.Flags exposing (Flags)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onInput, onSubmit)
import Data.Flags exposing (Flags)
import Page.Register.Data exposing (..)
import Page exposing (Page(..))
import Page.Register.Data exposing (..)
view: Flags -> Model -> Html Msg
view : Flags -> Model -> Html Msg
view flags model =
div [class "register-page"]
[div [class "ui centered grid"]
[div [class "row"]
[div [class "six wide column ui segment register-view"]
[h1 [class "ui cener aligned icon header"]
[img [class "ui image"
,src (flags.config.docspellAssetPath ++ "/img/logo-96.png")][]
,div [class "content"]
[text "Sign up @ Docspell"
]
]
,Html.form [ class "ui large error form raised segment"
, onSubmit RegisterSubmit
, autocomplete False
]
[div [class "required field"]
[label [][text "Collective ID"]
,div [class "ui left icon input"]
[input [type_ "text"
,autocomplete False
,onInput SetCollId
,value model.collId
,autofocus True
][]
,i [class "users icon"][]
]
]
,div [class "required field"]
[label [][text "User Login"]
,div [class "ui left icon input"]
[input [type_ "text"
,autocomplete False
,onInput SetLogin
,value model.login
][]
,i [class "user icon"][]
]
]
,div [class "required field"
]
[label [][text "Password"]
,div [class "ui left icon action input"]
[input [type_ <| if model.showPass1 then "text" else "password"
,autocomplete False
,onInput SetPass1
,value model.pass1
][]
,i [class "lock icon"][]
,button [class "ui icon button", onClick ToggleShowPass1]
[i [class "eye icon"][]
]
]
]
,div [class "required field"
]
[label [][text "Password (repeat)"]
,div [class "ui left icon action input"]
[input [type_ <| if model.showPass2 then "text" else "password"
,autocomplete False
,onInput SetPass2
,value model.pass2
][]
,i [class "lock icon"][]
,button [class "ui icon button", onClick ToggleShowPass2]
[i [class "eye icon"][]
]
]
]
,div [classList [("field", True)
,("invisible", flags.config.signupMode /= "invite")
]]
[label [][text "Invitation Key"]
,div [class "ui left icon input"]
[input [type_ "text"
,autocomplete False
,onInput SetInvite
,model.invite |> Maybe.withDefault "" |> value
][]
,i [class "key icon"][]
]
]
,button [class "ui primary button"
,type_ "submit"
]
[text "Submit"
]
]
,(resultMessage model)
,div [class "ui very basic right aligned segment"]
[text "Already signed up? "
,a [class "ui link", Page.href (LoginPage Nothing)]
[i [class "sign-in icon"][]
,text "Sign in"
]
div [ class "register-page" ]
[ div [ class "ui centered grid" ]
[ div [ class "row" ]
[ div [ class "six wide column ui segment register-view" ]
[ h1 [ class "ui cener aligned icon header" ]
[ img
[ class "ui image"
, src (flags.config.docspellAssetPath ++ "/img/logo-96.png")
]
]
]
]
[]
, div [ class "content" ]
[ text "Sign up @ Docspell"
]
]
, Html.form
[ class "ui large error form raised segment"
, onSubmit RegisterSubmit
, autocomplete False
]
[ div [ class "required field" ]
[ label [] [ text "Collective ID" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "text"
, autocomplete False
, onInput SetCollId
, value model.collId
, autofocus True
]
[]
, i [ class "users icon" ] []
]
]
, div [ class "required field" ]
[ label [] [ text "User Login" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "text"
, autocomplete False
, onInput SetLogin
, value model.login
]
[]
, i [ class "user icon" ] []
]
]
, div
[ class "required field"
]
[ label [] [ text "Password" ]
, div [ class "ui left icon action input" ]
[ input
[ type_ <|
if model.showPass1 then
"text"
else
"password"
, autocomplete False
, onInput SetPass1
, value model.pass1
]
[]
, i [ class "lock icon" ] []
, button [ class "ui icon button", onClick ToggleShowPass1 ]
[ i [ class "eye icon" ] []
]
]
]
, div
[ class "required field"
]
[ label [] [ text "Password (repeat)" ]
, div [ class "ui left icon action input" ]
[ input
[ type_ <|
if model.showPass2 then
"text"
else
"password"
, autocomplete False
, onInput SetPass2
, value model.pass2
]
[]
, i [ class "lock icon" ] []
, button [ class "ui icon button", onClick ToggleShowPass2 ]
[ i [ class "eye icon" ] []
]
]
]
, div
[ classList
[ ( "field", True )
, ( "invisible", flags.config.signupMode /= "invite" )
]
]
[ label [] [ text "Invitation Key" ]
, div [ class "ui left icon input" ]
[ input
[ type_ "text"
, autocomplete False
, onInput SetInvite
, model.invite |> Maybe.withDefault "" |> value
]
[]
, i [ class "key icon" ] []
]
]
, button
[ class "ui primary button"
, type_ "submit"
]
[ text "Submit"
]
]
, resultMessage model
, div [ class "ui very basic right aligned segment" ]
[ text "Already signed up? "
, a [ class "ui link", Page.href (LoginPage Nothing) ]
[ i [ class "sign-in icon" ] []
, text "Sign in"
]
]
]
]
]
]
resultMessage: Model -> Html Msg
resultMessage : Model -> Html Msg
resultMessage model =
case model.result of
Just r ->
if r.success
then
div [class "ui success message"]
[text "Registration successful."
if r.success then
div [ class "ui success message" ]
[ text "Registration successful."
]
else
div [class "ui error message"]
[text r.message
div [ class "ui error message" ]
[ text r.message
]
Nothing ->
if List.isEmpty model.errorMsg then
span [class "invisible"][]
span [ class "invisible" ] []
else
div [class "ui error message"]
(List.map (\s -> div[][text s]) model.errorMsg)
div [ class "ui error message" ]
(List.map (\s -> div [] [ text s ]) model.errorMsg)

95
modules/webapp/src/main/elm/Page/Upload/Data.elm
View File

@ -1,35 +1,53 @@
module Page.Upload.Data exposing (..)
module Page.Upload.Data exposing
( Model
, Msg(..)
, emptyModel
, hasErrors
, isCompleted
, isDone
, isError
, isIdle
, isLoading
, isSuccessAll
, uploadAllTracker
)
import Api.Model.BasicResult exposing (BasicResult)
import Comp.Dropzone
import File exposing (File)
import Http
import Set exposing (Set)
import File exposing (File)
import Api.Model.BasicResult exposing (BasicResult)
import Util.File exposing (makeFileId)
import Comp.Dropzone
type alias Model =
{ incoming: Bool
, singleItem: Bool
, files: List File
, completed: Set String
, errored: Set String
, loading: Set String
, dropzone: Comp.Dropzone.Model
{ incoming : Bool
, singleItem : Bool
, files : List File
, completed : Set String
, errored : Set String
, loading : Set String
, dropzone : Comp.Dropzone.Model
}
dropzoneSettings: Comp.Dropzone.Settings
dropzoneSettings : Comp.Dropzone.Settings
dropzoneSettings =
let
ds = Comp.Dropzone.defaultSettings
ds =
Comp.Dropzone.defaultSettings
in
{ds | classList = (\m -> [("ui attached blue placeholder segment dropzone", True)
,("dragging", m.hover)
,("disabled", not m.active)
])
}
{ ds
| classList =
\m ->
[ ( "ui attached blue placeholder segment dropzone", True )
, ( "dragging", m.hover )
, ( "disabled", not m.active )
]
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ incoming = True
, singleItem = False
@ -40,6 +58,7 @@ emptyModel =
, dropzone = Comp.Dropzone.init dropzoneSettings
}
type Msg
= SubmitUpload
| SingleUploadResp String (Result Http.Error BasicResult)
@ -50,42 +69,50 @@ type Msg
| DropzoneMsg Comp.Dropzone.Msg
isLoading: Model -> File -> Bool
isLoading : Model -> File -> Bool
isLoading model file =
Set.member (makeFileId file)model.loading
Set.member (makeFileId file) model.loading
isCompleted: Model -> File -> Bool
isCompleted : Model -> File -> Bool
isCompleted model file =
Set.member (makeFileId file)model.completed
Set.member (makeFileId file) model.completed
isError: Model -> File -> Bool
isError : Model -> File -> Bool
isError model file =
Set.member (makeFileId file) model.errored
isIdle: Model -> File -> Bool
isIdle : Model -> File -> Bool
isIdle model file =
not (isLoading model file || isCompleted model file || isError model file)
uploadAllTracker: String
uploadAllTracker : String
uploadAllTracker =
"upload-all"
isInitial: Model -> Bool
isInitial model =
Set.isEmpty model.loading &&
Set.isEmpty model.completed &&
Set.isEmpty model.errored
isDone: Model -> Bool
isInitial : Model -> Bool
isInitial model =
Set.isEmpty model.loading
&& Set.isEmpty model.completed
&& Set.isEmpty model.errored
isDone : Model -> Bool
isDone model =
List.map makeFileId model.files
|> List.all (\id -> Set.member id model.completed || Set.member id model.errored)
isSuccessAll: Model -> Bool
isSuccessAll : Model -> Bool
isSuccessAll model =
List.map makeFileId model.files
|> List.all (\id -> Set.member id model.completed)
hasErrors: Model -> Bool
hasErrors : Model -> Bool
hasErrors model =
not (Set.isEmpty model.errored)

182
modules/webapp/src/main/elm/Page/Upload/Update.elm
View File

@ -1,94 +1,156 @@
module Page.Upload.Update exposing (update)
import Api
import Http
import Set exposing (Set)
import Page.Upload.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.Dropzone
import File
import File.Select
import Ports
import Api.Model.ItemUploadMeta
import Comp.Dropzone
import Data.Flags exposing (Flags)
import Http
import Page.Upload.Data exposing (..)
import Ports
import Set exposing (Set)
import Util.File exposing (makeFileId)
import Util.Http
update: (Maybe String) -> Flags -> Msg -> Model -> (Model, Cmd Msg, Sub Msg)
update : Maybe String -> Flags -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
update sourceId flags msg model =
case msg of
ToggleIncoming ->
({model|incoming = not model.incoming}, Cmd.none, Sub.none)
( { model | incoming = not model.incoming }, Cmd.none, Sub.none )
ToggleSingleItem ->
({model|singleItem = not model.singleItem}, Cmd.none, Sub.none)
( { model | singleItem = not model.singleItem }, Cmd.none, Sub.none )
SubmitUpload ->
let
emptyMeta = Api.Model.ItemUploadMeta.empty
meta = {emptyMeta | multiple = not model.singleItem
, direction = if model.incoming then Just "incoming" else Just "outgoing"
}
fileids = List.map makeFileId model.files
uploads = if model.singleItem then Api.uploadSingle flags sourceId meta uploadAllTracker model.files (SingleUploadResp uploadAllTracker)
else Cmd.batch (Api.upload flags sourceId meta model.files SingleUploadResp)
tracker = if model.singleItem then Http.track uploadAllTracker (GotProgress uploadAllTracker)
else Sub.batch <| List.map (\id -> Http.track id (GotProgress id)) fileids
(cm2, _, _) = Comp.Dropzone.update (Comp.Dropzone.setActive False) model.dropzone
emptyMeta =
Api.Model.ItemUploadMeta.empty
meta =
{ emptyMeta
| multiple = not model.singleItem
, direction =
if model.incoming then
Just "incoming"
else
Just "outgoing"
}
fileids =
List.map makeFileId model.files
uploads =
if model.singleItem then
Api.uploadSingle flags sourceId meta uploadAllTracker model.files (SingleUploadResp uploadAllTracker)
else
Cmd.batch (Api.upload flags sourceId meta model.files SingleUploadResp)
tracker =
if model.singleItem then
Http.track uploadAllTracker (GotProgress uploadAllTracker)
else
Sub.batch <| List.map (\id -> Http.track id (GotProgress id)) fileids
( cm2, _, _ ) =
Comp.Dropzone.update (Comp.Dropzone.setActive False) model.dropzone
in
({model|loading = Set.fromList fileids, dropzone = cm2}, uploads, tracker)
( { model | loading = Set.fromList fileids, dropzone = cm2 }, uploads, tracker )
SingleUploadResp fileid (Ok res) ->
let
compl = if res.success then setCompleted model fileid
else model.completed
errs = if not res.success then setErrored model fileid
else model.errored
load = if fileid == uploadAllTracker then Set.empty
else Set.remove fileid model.loading
in
({model|completed = compl, errored = errs, loading = load}
, Ports.setProgress (fileid, 100), Sub.none
)
compl =
if res.success then
setCompleted model fileid
SingleUploadResp fileid (Err err) ->
let
_ = Debug.log "error" err
errs = setErrored model fileid
load = if fileid == uploadAllTracker then Set.empty
else Set.remove fileid model.loading
else
model.completed
errs =
if not res.success then
setErrored model fileid
else
model.errored
load =
if fileid == uploadAllTracker then
Set.empty
else
Set.remove fileid model.loading
in
({model|errored = errs, loading = load}, Cmd.none, Sub.none)
( { model | completed = compl, errored = errs, loading = load }
, Ports.setProgress ( fileid, 100 )
, Sub.none
)
SingleUploadResp fileid (Err _) ->
let
errs =
setErrored model fileid
load =
if fileid == uploadAllTracker then
Set.empty
else
Set.remove fileid model.loading
in
( { model | errored = errs, loading = load }, Cmd.none, Sub.none )
GotProgress fileid progress ->
let
percent = case progress of
Http.Sending p ->
Http.fractionSent p
|> (*) 100
|> round
_ -> 0
updateBars = if percent == 0 then Cmd.none
else if model.singleItem then Ports.setAllProgress (uploadAllTracker, percent)
else Ports.setProgress (fileid, percent)
percent =
case progress of
Http.Sending p ->
Http.fractionSent p
|> (*) 100
|> round
_ ->
0
updateBars =
if percent == 0 then
Cmd.none
else if model.singleItem then
Ports.setAllProgress ( uploadAllTracker, percent )
else
Ports.setProgress ( fileid, percent )
in
(model, updateBars, Sub.none)
( model, updateBars, Sub.none )
Clear ->
(emptyModel, Cmd.none, Sub.none)
( emptyModel, Cmd.none, Sub.none )
DropzoneMsg m ->
let
(m2, c2, files) = Comp.Dropzone.update m model.dropzone
nextFiles = List.append model.files files
( m2, c2, files ) =
Comp.Dropzone.update m model.dropzone
nextFiles =
List.append model.files files
in
({model| files = nextFiles, dropzone = m2}, Cmd.map DropzoneMsg c2, Sub.none)
( { model | files = nextFiles, dropzone = m2 }, Cmd.map DropzoneMsg c2, Sub.none )
setCompleted: Model -> String -> Set String
setCompleted : Model -> String -> Set String
setCompleted model fileid =
if fileid == uploadAllTracker then List.map makeFileId model.files |> Set.fromList
else Set.insert fileid model.completed
if fileid == uploadAllTracker then
List.map makeFileId model.files |> Set.fromList
setErrored: Model -> String -> Set String
else
Set.insert fileid model.completed
setErrored : Model -> String -> Set String
setErrored model fileid =
if fileid == uploadAllTracker then List.map makeFileId model.files |> Set.fromList
else Set.insert fileid model.errored
if fileid == uploadAllTracker then
List.map makeFileId model.files |> Set.fromList
else
Set.insert fileid model.errored

322
modules/webapp/src/main/elm/Page/Upload/View.elm
View File

@ -1,166 +1,190 @@
module Page.Upload.View exposing (view)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick, onCheck)
import Comp.Dropzone
import File exposing (File)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick)
import Page exposing (Page(..))
import Page.Upload.Data exposing (..)
import Util.File exposing (makeFileId)
import Util.Maybe
import Util.Size
view: (Maybe String) -> Model -> Html Msg
view : Maybe String -> Model -> Html Msg
view mid model =
div [class "upload-page ui grid container"]
[div [class "row"]
[div [class "sixteen wide column"]
[div [class "ui top attached segment"]
[renderForm model
]
,Html.map DropzoneMsg (Comp.Dropzone.view model.dropzone)
,div [class "ui bottom attached segment"]
[a [class "ui primary button", href "", onClick SubmitUpload]
[text "Submit"
]
,a [class "ui secondary button", href "", onClick Clear]
[text "Reset"
]
]
]
]
,if isDone model && hasErrors model then renderErrorMsg model
else span[class "invisible"][]
,if List.isEmpty model.files then span[][]
else if isSuccessAll model then renderSuccessMsg (Util.Maybe.nonEmpty mid) model
else renderUploads model
]
renderErrorMsg: Model -> Html Msg
renderErrorMsg model =
div [class "row"]
[div [class "sixteen wide column"]
[div [class "ui large error message"]
[h3 [class "ui header"]
[i [class "meh outline icon"][]
,text "Some files failed to upload"
]
,text "There were errors uploading some files."
]
]
]
renderSuccessMsg: Bool -> Model -> Html Msg
renderSuccessMsg public model =
div [class "row"]
[div [class "sixteen wide column"]
[div [class "ui large success message"]
[h3 [class "ui header"]
[i [class "smile outline icon"][]
,text "All files uploaded"
]
,if public then p [][] else p []
[text "Your files have been successfully uploaded. They are now being processed. Check the "
,a [class "ui link", Page.href HomePage]
[text "Items page"
]
,text " later where the files will arrive eventually. Or go to the "
,a [class "ui link", Page.href QueuePage]
[text "Processing Page"
]
,text " to view the current processing state."
]
,p []
[text "Click "
,a [class "ui link", href "", onClick Clear]
[text "Reset"
]
,text " to upload more files."
]
]
]
]
renderUploads: Model -> Html Msg
renderUploads model =
div [class "row"]
[div [class "sixteen wide column"]
[div [class "ui basic segment"]
[h2 [class "ui header"]
[text "Selected Files"
]
,div [class "ui items"] <|
if model.singleItem then
(List.map (renderFileItem model (Just uploadAllTracker)) model.files)
else
(List.map (renderFileItem model Nothing) model.files)
]
]
]
renderFileItem: Model -> Maybe String -> File -> Html Msg
renderFileItem model mtracker file =
let
name = File.name file
size = File.size file
|> toFloat
|> Util.Size.bytesReadable Util.Size.B
in
div [class "item"]
[i [classList [("large", True)
,("file outline icon", isIdle model file)
,("loading spinner icon", isLoading model file)
,("green check icon", isCompleted model file)
,("red bolt icon", isError model file)
]][]
,div [class "middle aligned content"]
[div [class "header"]
[text name
]
,div [class "right floated meta"]
[text size
]
,div [class "description"]
[div [classList [("ui small indicating progress", True)
,(uploadAllTracker, Util.Maybe.nonEmpty mtracker)
]
, id (makeFileId file)
]
[div [class "bar"]
[]
]
div [ class "upload-page ui grid container" ]
[ div [ class "row" ]
[ div [ class "sixteen wide column" ]
[ div [ class "ui top attached segment" ]
[ renderForm model
]
, Html.map DropzoneMsg (Comp.Dropzone.view model.dropzone)
, div [ class "ui bottom attached segment" ]
[ a [ class "ui primary button", href "", onClick SubmitUpload ]
[ text "Submit"
]
, a [ class "ui secondary button", href "", onClick Clear ]
[ text "Reset"
]
]
]
]
, if isDone model && hasErrors model then
renderErrorMsg model
else
span [ class "invisible" ] []
, if List.isEmpty model.files then
span [] []
renderForm: Model -> Html Msg
renderForm model =
div [class "row"]
[Html.form [class "ui form"]
[div [class "grouped fields"]
[div [class "field"]
[div [class "ui radio checkbox"]
[input [type_ "radio", checked model.incoming, onCheck (\_ ->ToggleIncoming)][]
,label [][text "Incoming"]
]
]
,div [class "field"]
[div [class "ui radio checkbox"]
[input [type_ "radio", checked (not model.incoming), onCheck (\_ -> ToggleIncoming)][]
,label [][text "Outgoing"]
]
]
]
,div [class "inline field"]
[div [class "ui checkbox"]
[input [type_ "checkbox", checked model.singleItem, onCheck (\_ -> ToggleSingleItem)][]
,label [][text "All files are one single item"]
]
]
]
else if isSuccessAll model then
renderSuccessMsg (Util.Maybe.nonEmpty mid) model
else
renderUploads model
]
renderErrorMsg : Model -> Html Msg
renderErrorMsg model =
div [ class "row" ]
[ div [ class "sixteen wide column" ]
[ div [ class "ui large error message" ]
[ h3 [ class "ui header" ]
[ i [ class "meh outline icon" ] []
, text "Some files failed to upload"
]
, text "There were errors uploading some files."
]
]
]
renderSuccessMsg : Bool -> Model -> Html Msg
renderSuccessMsg public model =
div [ class "row" ]
[ div [ class "sixteen wide column" ]
[ div [ class "ui large success message" ]
[ h3 [ class "ui header" ]
[ i [ class "smile outline icon" ] []
, text "All files uploaded"
]
, if public then
p [] []
else
p []
[ text "Your files have been successfully uploaded. They are now being processed. Check the "
, a [ class "ui link", Page.href HomePage ]
[ text "Items page"
]
, text " later where the files will arrive eventually. Or go to the "
, a [ class "ui link", Page.href QueuePage ]
[ text "Processing Page"
]
, text " to view the current processing state."
]
, p []
[ text "Click "
, a [ class "ui link", href "", onClick Clear ]
[ text "Reset"
]
, text " to upload more files."
]
]
]
]
renderUploads : Model -> Html Msg
renderUploads model =
div [ class "row" ]
[ div [ class "sixteen wide column" ]
[ div [ class "ui basic segment" ]
[ h2 [ class "ui header" ]
[ text "Selected Files"
]
, div [ class "ui items" ] <|
if model.singleItem then
List.map (renderFileItem model (Just uploadAllTracker)) model.files
else
List.map (renderFileItem model Nothing) model.files
]
]
]
renderFileItem : Model -> Maybe String -> File -> Html Msg
renderFileItem model mtracker file =
let
name =
File.name file
size =
File.size file
|> toFloat
|> Util.Size.bytesReadable Util.Size.B
in
div [ class "item" ]
[ i
[ classList
[ ( "large", True )
, ( "file outline icon", isIdle model file )
, ( "loading spinner icon", isLoading model file )
, ( "green check icon", isCompleted model file )
, ( "red bolt icon", isError model file )
]
]
[]
, div [ class "middle aligned content" ]
[ div [ class "header" ]
[ text name
]
, div [ class "right floated meta" ]
[ text size
]
, div [ class "description" ]
[ div
[ classList
[ ( "ui small indicating progress", True )
, ( uploadAllTracker, Util.Maybe.nonEmpty mtracker )
]
, id (makeFileId file)
]
[ div [ class "bar" ]
[]
]
]
]
]
renderForm : Model -> Html Msg
renderForm model =
div [ class "row" ]
[ Html.form [ class "ui form" ]
[ div [ class "grouped fields" ]
[ div [ class "field" ]
[ div [ class "ui radio checkbox" ]
[ input [ type_ "radio", checked model.incoming, onCheck (\_ -> ToggleIncoming) ] []
, label [] [ text "Incoming" ]
]
]
, div [ class "field" ]
[ div [ class "ui radio checkbox" ]
[ input [ type_ "radio", checked (not model.incoming), onCheck (\_ -> ToggleIncoming) ] []
, label [] [ text "Outgoing" ]
]
]
]
, div [ class "inline field" ]
[ div [ class "ui checkbox" ]
[ input [ type_ "checkbox", checked model.singleItem, onCheck (\_ -> ToggleSingleItem) ] []
, label [] [ text "All files are one single item" ]
]
]
]
]

20
modules/webapp/src/main/elm/Page/UserSettings/Data.elm
View File

@ -1,19 +1,29 @@
module Page.UserSettings.Data exposing (..)
module Page.UserSettings.Data exposing
( Model
, Msg(..)
, Tab(..)
, emptyModel
)
import Comp.ChangePasswordForm
type alias Model =
{ currentTab: Maybe Tab
, changePassModel: Comp.ChangePasswordForm.Model
{ currentTab : Maybe Tab
, changePassModel : Comp.ChangePasswordForm.Model
}
emptyModel: Model
emptyModel : Model
emptyModel =
{ currentTab = Nothing
, changePassModel = Comp.ChangePasswordForm.emptyModel
}
type Tab = ChangePassTab
type Tab
= ChangePassTab
type Msg
= SetTab Tab

17
modules/webapp/src/main/elm/Page/UserSettings/Update.elm
View File

@ -1,20 +1,23 @@
module Page.UserSettings.Update exposing (update)
import Page.UserSettings.Data exposing (..)
import Data.Flags exposing (Flags)
import Comp.ChangePasswordForm
import Data.Flags exposing (Flags)
import Page.UserSettings.Data exposing (..)
update: Flags -> Msg -> Model -> (Model, Cmd Msg)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
SetTab t ->
let
m = { model | currentTab = Just t }
m =
{ model | currentTab = Just t }
in
(m, Cmd.none)
( m, Cmd.none )
ChangePassMsg m ->
let
(m2, c2) = Comp.ChangePasswordForm.update flags m model.changePassModel
( m2, c2 ) =
Comp.ChangePasswordForm.update flags m model.changePassModel
in
({model | changePassModel = m2}, Cmd.map ChangePassMsg c2)
( { model | changePassModel = m2 }, Cmd.map ChangePassMsg c2 )

67
modules/webapp/src/main/elm/Page/UserSettings/View.elm
View File

@ -1,47 +1,52 @@
module Page.UserSettings.View exposing (view)
import Comp.ChangePasswordForm
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Page.UserSettings.Data exposing (..)
import Util.Html exposing (classActive)
import Page.UserSettings.Data exposing (..)
import Comp.ChangePasswordForm
view: Model -> Html Msg
view : Model -> Html Msg
view model =
div [class "usersetting-page ui padded grid"]
[div [class "four wide column"]
[h4 [class "ui top attached ablue-comp header"]
[text "User"
]
,div [class "ui attached fluid segment"]
[div [class "ui fluid vertical secondary menu"]
[div [classActive (model.currentTab == Just ChangePassTab) "link icon item"
,onClick (SetTab ChangePassTab)
]
[i [class "user secret icon"][]
,text "Change Password"
]
]
]
]
,div [class "twelve wide column"]
[div [class ""]
(case model.currentTab of
Just ChangePassTab -> viewChangePassword model
Nothing -> []
)
div [ class "usersetting-page ui padded grid" ]
[ div [ class "four wide column" ]
[ h4 [ class "ui top attached ablue-comp header" ]
[ text "User"
]
, div [ class "ui attached fluid segment" ]
[ div [ class "ui fluid vertical secondary menu" ]
[ div
[ classActive (model.currentTab == Just ChangePassTab) "link icon item"
, onClick (SetTab ChangePassTab)
]
[ i [ class "user secret icon" ] []
, text "Change Password"
]
]
]
]
, div [ class "twelve wide column" ]
[ div [ class "" ]
(case model.currentTab of
Just ChangePassTab ->
viewChangePassword model
Nothing ->
[]
)
]
]
viewChangePassword: Model -> List (Html Msg)
viewChangePassword : Model -> List (Html Msg)
viewChangePassword model =
[h2 [class "ui header"]
[i [class "ui user secret icon"][]
,div [class "content"]
[text "Change Password"
[ h2 [ class "ui header" ]
[ i [ class "ui user secret icon" ] []
, div [ class "content" ]
[ text "Change Password"
]
]
,Html.map ChangePassMsg (Comp.ChangePasswordForm.view model.changePassModel)
, Html.map ChangePassMsg (Comp.ChangePasswordForm.view model.changePassModel)
]