diff --git a/.assets/assets/manifest.xml b/.assets/assets/manifest.xml index 4def2da6..1e1663ec 100644 --- a/.assets/assets/manifest.xml +++ b/.assets/assets/manifest.xml @@ -1,7 +1,7 @@  5d6f5462-3401-48ec-9406-d12882e9ad83 - 0.4.0 + 0.4.1 Computational Systems Biology en-US diff --git a/.db/docker-compose.yml b/.db/docker-compose.yml index 791c4820..66111141 100644 --- a/.db/docker-compose.yml +++ b/.db/docker-compose.yml @@ -10,7 +10,7 @@ services: volumes: - ./mysql-dump:/docker-entrypoint-initdb.d environment: - MYSQL_ROOT_PASSWORD: {PASSWORD} + MYSQL_ROOT_PASSWORD: example ports: - 42333:3306 diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index b07f4f73..6d006142 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,3 +1,25 @@ +### 0.4.1+d75743c (Released 2021-3-8) +* Additions: + * latest commit #d75743c + * [[#0d9c945](https://github.com/nfdi4plants/Swate/commit/0d9c94558052d7f13e9707da6202e3a3f34440b9)] Add links to template repository. + * [[#6b5a56f](https://github.com/nfdi4plants/Swate/commit/6b5a56f5786eb356703438ecffcb768a6444abcb)] Improve darkmode (Issue #25). + * [[#37503a5](https://github.com/nfdi4plants/Swate/commit/37503a50786536ba88a72d591e2cf51fdfd113dc)] Enable term search without present annotation table (Issue #132). + * [[#05a69b3](https://github.com/nfdi4plants/Swate/commit/05a69b323db6325d1309b7fbd5cf5b7f4279308e)] Increase responsiveness for copy to clipboard. + * [[#44a75d1](https://github.com/nfdi4plants/Swate/commit/44a75d12c1583e138ed2cc328146922d14752d4f)] Add warnings to advanced setting functions. + * [[#7d4060b](https://github.com/nfdi4plants/Swate/commit/7d4060b15def48f17b64dd42d0e1da207a3285cd)] Add function to update used protocols. :sparkles: + * [[#088335f](https://github.com/nfdi4plants/Swate/commit/088335f811d41026269e2489337986331534c4a6)] Add option to update raw custom xml (Issue #123). + * [[#a3286eb](https://github.com/nfdi4plants/Swate/commit/a3286ebcefe217bbc4354c9e19fe79004d7afb6d)] Add checksum content type (Issue #127, Issue #131). + * [[#97407d4](https://github.com/nfdi4plants/Swate/commit/97407d45c5139ded3234824f46c530e68e0556a1)] Changed DateTime to use UTC (Issue #126). + * [[#137cc54](https://github.com/nfdi4plants/Swate/commit/137cc542db62fecb52fad77177bb6de1a72c1965)] Add more info for existing building blocks (Issue #124). + * [[#66fb577](https://github.com/nfdi4plants/Swate/commit/66fb5771c55632c4cc0bf229996d8fa4cd304a69)] Add option to create pointer json template (Issue #129). +* Deletions: + * [[#84d71ee](https://github.com/nfdi4plants/Swate/commit/84d71eef62c1d55bb2130143926d47e8b462fdeb)] Remove 'decimal' validation type. +* Bugfixes: + * [[#d75743c](https://github.com/nfdi4plants/Swate/commit/d75743cc4597ab9ba557ea9522e6beea091db209)] Add minor fixes + * [[#bd13cbf](https://github.com/nfdi4plants/Swate/commit/bd13cbf39f013277381b04bb9f30577d2a929f42)] Fix drag n drop problems in filepicker. + * [[#33695f4](https://github.com/nfdi4plants/Swate/commit/33695f429ac6aa76e8638b9d5b375921b3d856bd)] Fix protocol grouping bug. + * [[#f4d08e8](https://github.com/nfdi4plants/Swate/commit/f4d08e8f1f41c712ff787ce231e4c085795eef2a)] Fix protocol xml not correctly removed bug. + ### 0.4.0+a0e04f3 (Released 2021-3-1) * Additions: * latest commit #a0e04f3 diff --git a/manifest.xml b/manifest.xml index c3478ad3..2437fe5f 100644 --- a/manifest.xml +++ b/manifest.xml @@ -1,7 +1,7 @@  5d6f5462-3401-48ec-9406-d12882e9ad83 - 0.4.0 + 0.4.1 Computational Systems Biology en-US diff --git a/src/Client/Client.fs b/src/Client/Client.fs index f50c3fa3..2c9c460c 100644 --- a/src/Client/Client.fs +++ b/src/Client/Client.fs @@ -114,6 +114,19 @@ let view (model : Model) (dispatch : Msg -> unit) = ] [ //Text.p [] [str ""] ] + | Routing.Route.SettingsDataStewards -> + BaseView.baseViewComponent model dispatch [ + SettingsDataStewardView.settingsDataStewardViewComponent model dispatch + ] [ + //Text.p [] [str ""] + ] + | Routing.Route.SettingsProtocol -> + BaseView.baseViewComponent model dispatch [ + SettingsProtocolView.settingsProtocolViewComponent model dispatch + ] [ + //Text.p [] [str ""] + ] + | Routing.Route.Info -> BaseView.baseViewComponent model dispatch [ @@ -134,28 +147,7 @@ let view (model : Model) (dispatch : Msg -> unit) = div [][ str "This is the Swate web host. For a preview click on the following link." ] a [ Href (Routing.Route.toRouteUrl Routing.Route.TermSearch) ] [ str "Termsearch" ] ] - //| _ -> - // div [ Style [MinHeight "100vh"; BackgroundColor model.SiteStyleState.ColorMode.BodyBackground; Color model.SiteStyleState.ColorMode.Text;] - // ] [ - // Container.container [Container.IsFluid] [ - // br [] - // br [] - // Button.buttonComponent model.SiteStyleState.ColorMode true "make a test db insert xd" (fun _ -> ((sprintf "Me am test %A" (System.Guid.NewGuid())),"1","Me is testerino",System.DateTime.UtcNow,"MEEEMuser") |> TestOntologyInsert |> Request |> Api|> dispatch) - // Button.buttonComponent model.SiteStyleState.ColorMode true "idk man=(" (fun _ -> TryExcel |> ExcelInterop |> dispatch) - // Button.buttonComponent model.SiteStyleState.ColorMode true "create annoation table" (fun _ -> model.SiteStyleState.IsDarkMode |> CreateAnnotationTable |> ExcelInterop |> dispatch) - // Button.buttonComponent model.SiteStyleState.ColorMode true "Log table metadata" (fun _ -> LogTableMetadata |> Dev |> dispatch) - // Button.buttonComponent model.SiteStyleState.ColorMode true "Log table metadata" (fun _ -> LogTableMetadata |> Dev |> dispatch) - - // Footer.footer [ Props [ExcelColors.colorControl model.SiteStyleState.ColorMode]] [ - // Content.content [ - // Content.Modifiers [ Modifier.TextAlignment (Screen.All, TextAlignment.Left)] - // Content.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] - // ][ - - // ] - // ] - // ] - //] + #if DEBUG open Elmish.Debug diff --git a/src/Client/Client.fsproj b/src/Client/Client.fsproj index 84840ba0..02cd520b 100644 --- a/src/Client/Client.fsproj +++ b/src/Client/Client.fsproj @@ -23,6 +23,7 @@ + @@ -30,6 +31,7 @@ + @@ -47,6 +49,8 @@ + + diff --git a/src/Client/CustomComponents/AdvancedSearch.fs b/src/Client/CustomComponents/AdvancedSearch.fs index b41b83b2..24d25c10 100644 --- a/src/Client/CustomComponents/AdvancedSearch.fs +++ b/src/Client/CustomComponents/AdvancedSearch.fs @@ -35,7 +35,6 @@ let createOntologyDropdownItem (model:Model) (dispatch:Msg -> unit) (ontOpt: DbD TabIndex 0 OnClick (fun _ -> ontOpt |> OntologySuggestionUsed |> AdvancedSearch |> dispatch) OnKeyDown (fun k -> if k.key = "Enter" then ontOpt |> OntologySuggestionUsed |> AdvancedSearch |> dispatch) - colorControl model.SiteStyleState.ColorMode ] ][ Text.span [ @@ -62,8 +61,8 @@ let createAdvancedTermSearchResultRows (model:Model) (dispatch: Msg -> unit) (su |> Array.map (fun sugg -> tr [ OnClick (fun _ -> sugg |> suggestionUsedHandler |> dispatch) - colorControl model.SiteStyleState.ColorMode Class "suggestion" + colorControl model.SiteStyleState.ColorMode ] [ td [Class (Tooltip.ClassName + " " + Tooltip.IsTooltipRight + " " + Tooltip.IsMultiline);Tooltip.dataTooltip sugg.Definition] [ Fa.i [Fa.Solid.InfoCircle] [] @@ -140,7 +139,7 @@ let advancedTermSearchComponent (model:Model) (dispatch: Msg -> unit) = Input.input [ Input.Placeholder "... search key words" Input.Size IsSmall - Input.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] + //Input.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] Input.OnChange (fun e -> {model.AdvancedSearchState.AdvancedSearchOptions with SearchTermName = e.Value @@ -161,7 +160,7 @@ let advancedTermSearchComponent (model:Model) (dispatch: Msg -> unit) = Input.input [ Input.Placeholder "... must exist in name" Input.Size IsSmall - Input.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] + //Input.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] Input.OnChange (fun e -> {model.AdvancedSearchState.AdvancedSearchOptions with MustContainName = e.Value @@ -182,7 +181,7 @@ let advancedTermSearchComponent (model:Model) (dispatch: Msg -> unit) = Input.input [ Input.Placeholder "... search key words" Input.Size IsSmall - Input.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] + //Input.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] Input.OnChange (fun e -> {model.AdvancedSearchState.AdvancedSearchOptions with SearchTermDefinition = e.Value @@ -204,7 +203,7 @@ let advancedTermSearchComponent (model:Model) (dispatch: Msg -> unit) = Input.input [ Input.Placeholder "... must exist in definition" Input.Size IsSmall - Input.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] + //Input.Props [ExcelColors.colorControl model.SiteStyleState.ColorMode] Input.OnChange (fun e -> {model.AdvancedSearchState.AdvancedSearchOptions with MustContainDefinition = e.Value @@ -227,7 +226,7 @@ let advancedSearchResultTable (model:Model) (dispatch: Msg -> unit) = ][ Button.buttonComponent model.SiteStyleState.ColorMode true "Change search options" (fun _ -> UpdateAdvancedTermSearchSubpage AdvancedTermSearchSubpages.InputFormSubpage |> AdvancedSearch |> dispatch) ] - Label.label [] [str "Results:"] + Label.label [Label.Props [colorControl model.SiteStyleState.ColorMode]] [str "Results:"] if model.AdvancedSearchState.AdvancedTermSearchSubpage = AdvancedTermSearchSubpages.ResultsSubpage then if model.AdvancedSearchState.HasAdvancedSearchResultsLoading then div [ @@ -251,17 +250,13 @@ let advancedSearchResultTable (model:Model) (dispatch: Msg -> unit) = let advancedSearchSelectedResultDisplay (model:Model) (result:DbDomain.Term) = Container.container [] [ - Heading.h4 [] [str "Selected Result:"] + Heading.h4 [Heading.Props [colorControl model.SiteStyleState.ColorMode]] [str "Selected Result:"] Table.table [Table.IsFullWidth] [ - thead [] [] - tbody [] [ + tbody [colorControl model.SiteStyleState.ColorMode] [ tr [ - colorControl model.SiteStyleState.ColorMode + //colorControl model.SiteStyleState.ColorMode Class "suggestion" ] [ - td [Class (Tooltip.ClassName + " " + Tooltip.IsTooltipRight + " " + Tooltip.IsMultiline);Tooltip.dataTooltip result.Definition] [ - Fa.i [Fa.Solid.InfoCircle] [] - ] td [] [ b [] [str result.Name] ] @@ -281,12 +276,12 @@ let advancedSearchModal (model:Model) (modalId: string) (relatedInputId:string) && model.AdvancedSearchState.ModalId = modalId ) Modal.Props [ - colorControl model.SiteStyleState.ColorMode + //colorControl model.SiteStyleState.ColorMode Id modalId ] ] [ Modal.background [] [] - Modal.Card.card [Props [colorControl model.SiteStyleState.ColorMode]] [ + Modal.Card.card [] [ Modal.Card.head [Props [colorControl model.SiteStyleState.ColorMode]] [ Modal.close [Modal.Close.Size IsLarge; Modal.Close.OnClick (fun _ -> ToggleModal modalId |> AdvancedSearch |> dispatch)] [] Heading.h4 [Heading.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]] [ @@ -306,7 +301,7 @@ let advancedSearchModal (model:Model) (modalId: string) (relatedInputId:string) // |None -> advancedSearchResultTable model dispatch // |Some r -> advancedSearchSelectedResultDisplay model r ] - Modal.Card.foot [] [ + Modal.Card.foot [Props [colorControl model.SiteStyleState.ColorMode]] [ form [ OnSubmit (fun e -> e.preventDefault()) OnKeyDown (fun k -> if k.key = "Enter" then k.preventDefault()) diff --git a/src/Client/CustomComponents/AutocompleteSearch.fs b/src/Client/CustomComponents/AutocompleteSearch.fs index 954c4fc4..c7366d3a 100644 --- a/src/Client/CustomComponents/AutocompleteSearch.fs +++ b/src/Client/CustomComponents/AutocompleteSearch.fs @@ -261,15 +261,13 @@ let autocompleteTermSearchComponent Control.div [Control.IsExpanded] [ AdvancedSearch.advancedSearchModal model autocompleteParams.ModalId autocompleteParams.InputId dispatch autocompleteParams.OnAdvancedSearch Input.input [ + Input.Props [Style [BorderColor ExcelColors.Colorfull.gray40]] Input.Disabled isDisabled Input.Placeholder inputPlaceholderText Input.ValueOrDefault autocompleteParams.StateBinding match inputSize with | Some size -> Input.Size size | _ -> () - Input.Props [ - ExcelColors.colorControl colorMode - ] Input.OnChange ( fun e -> e.Value |> autocompleteParams.OnInputChangeMsg |> dispatch ) @@ -317,8 +315,6 @@ let autocompleteTermSearchComponentOfParentOntology | Some size -> Input.Size size | _ -> () Input.Props [ - - ExcelColors.colorControl colorMode OnFocus (fun e -> //GenericLog ("Info","FOCUSED!") |> Dev |> dispatch GetParentTerm |> ExcelInterop |> dispatch diff --git a/src/Client/CustomComponents/BuildingBlockDetailsModal.fs b/src/Client/CustomComponents/BuildingBlockDetailsModal.fs index 50a71c5d..9874037f 100644 --- a/src/Client/CustomComponents/BuildingBlockDetailsModal.fs +++ b/src/Client/CustomComponents/BuildingBlockDetailsModal.fs @@ -75,16 +75,44 @@ let buildingBlockDetailModal (model:Model) dispatch = th [Class "toExcelColor"][str "RowIndex"] ] tr [][ - th [][str mainColHeader.SearchQuery.Name] - th [][str mainColHeader.SearchQuery.TermAccession] + th [][ + str mainColHeader.SearchQuery.Name + if mainColHeader.TermOpt.IsSome then + span [ + Style [Color NFDIColors.LightBlue.Base; MarginLeft ".5rem"; OverflowY OverflowOptions.Visible] + Class (Tooltip.IsTooltipRight + " " + Tooltip.IsMultiline) + Tooltip.dataTooltip mainColHeader.TermOpt.Value.Definition + ][ + Fa.i [ + Fa.Solid.InfoCircle + ][] + ] + ] + th [][ + a [ Href (Shared.URLs.termAccessionUrlOfAccessionStr mainColHeader.SearchQuery.TermAccession)] [ str mainColHeader.SearchQuery.TermAccession ] + ] th [][str (mainColHeader.ColIndices |> Seq.min |> string)] th [][str "Header"] ] if unitHeaderOpt.IsSome then let unitHeader = unitHeaderOpt.Value tr [][ - th [][str unitHeader.SearchQuery.Name] - th [][str unitHeader.SearchQuery.TermAccession] + th [][ + str unitHeader.SearchQuery.Name + if unitHeader.TermOpt.IsSome then + span [ + Style [Color NFDIColors.LightBlue.Base; MarginLeft ".5rem"; OverflowY OverflowOptions.Visible] + Class (Tooltip.IsTooltipRight + " " + Tooltip.IsMultiline) + Tooltip.dataTooltip unitHeader.TermOpt.Value.Definition + ][ + Fa.i [ + Fa.Solid.InfoCircle + ][] + ] + ] + th [][ + a [ Href (Shared.URLs.termAccessionUrlOfAccessionStr unitHeader.SearchQuery.TermAccession)] [ str unitHeader.SearchQuery.TermAccession] + ] th [][str (unitHeader.ColIndices |> Seq.min |> string)] th [][str "Unit"] ] @@ -93,8 +121,25 @@ let buildingBlockDetailModal (model:Model) dispatch = for t in valueArr do yield tr [] [ - td [][str (if t.SearchQuery.Name = "" then "none" else t.SearchQuery.Name)] - td [][str (sprintf "%A" (if t.TermOpt.IsSome then t.TermOpt.Value.Accession else "none") )] + td [][ + str (if t.SearchQuery.Name = "" then "none" else t.SearchQuery.Name) + if t.TermOpt.IsSome then + span [ + Style [Color NFDIColors.LightBlue.Base; MarginLeft ".5rem"; OverflowY OverflowOptions.Visible] + Class (Tooltip.IsTooltipRight + " " + Tooltip.IsMultiline) + Tooltip.dataTooltip t.TermOpt.Value.Definition + ][ + Fa.i [ + Fa.Solid.InfoCircle + ][] + ] + ] + td [][ + if t.TermOpt.IsSome then + a [ Href (Shared.URLs.termAccessionUrlOfAccessionStr t.TermOpt.Value.Accession)] [ str t.TermOpt.Value.Accession ] + else + str "none" + ] td [][str (mainColHeader.ColIndices |> Seq.min |> string)] td [][str (sprintf "%A" (sprintableRowIndices t.RowIndices) ) ] ] diff --git a/src/Client/CustomComponents/DwnButton.fs b/src/Client/CustomComponents/DwnButton.fs index 3d268758..3e8250b5 100644 --- a/src/Client/CustomComponents/DwnButton.fs +++ b/src/Client/CustomComponents/DwnButton.fs @@ -8,6 +8,7 @@ open Browser.Blob open Fulma open Model +open Messages open Fable.React open Fable.Core diff --git a/src/Client/CustomComponents/Navbar.fs b/src/Client/CustomComponents/Navbar.fs index 8660209c..3bdeeb85 100644 --- a/src/Client/CustomComponents/Navbar.fs +++ b/src/Client/CustomComponents/Navbar.fs @@ -118,30 +118,19 @@ let dropdownShortCutIconList model dispatch = ] ] ] - let quickAccessDropdownElement model dispatch = - let prepIconLists = - let split length (xs: seq<'T>) = - let rec loop xs = - [ - yield Seq.truncate length xs |> Seq.toList - match Seq.length xs <= length with - | false -> yield! loop (Seq.skip length xs) - | true -> () - ] - loop xs - let iconList = navbarShortCutIconList model dispatch - split 3 iconList Navbar.Item.div [ - Navbar.Item.Props [Style [ Color model.SiteStyleState.ColorMode.Text]] + Navbar.Item.Props [ + OnClick (fun e -> ToggleQuickAcessIconsShown |> StyleChange |> dispatch) + Style [ Color model.SiteStyleState.ColorMode.Text] + ] Navbar.Item.CustomClass "hideOver575px" ] [ div [Style [ Position PositionOptions.Relative ]] [ Button.a [ - Button.OnClick (fun e -> ToggleQuickAcessIconsShown |> StyleChange |> dispatch) Button.Props [Style [BackgroundColor model.SiteStyleState.ColorMode.ElementBackground; PaddingLeft "0"; PaddingRight "0"]] Button.Color Color.IsWhite Button.IsInverted @@ -218,8 +207,8 @@ let quickAccessListElement model dispatch = let navbarComponent (model : Model) (dispatch : Msg -> unit) = Navbar.navbar [Navbar.Props [Props.Role "navigation"; AriaLabel "main navigation" ; ExcelColors.colorElement model.SiteStyleState.ColorMode]] [ Navbar.Brand.a [] [ - Navbar.Item.a [Navbar.Item.Props [Props.Href "https://csb.bio.uni-kl.de/"; Target "_Blank"]] [ - img [Props.Src "../assets/Swate_logo_for_excel.svg"] + Navbar.Item.a [Navbar.Item.Props [Props.Href "https://csb.bio.uni-kl.de/"; Target "_Blank"; Style [Width "100px"]]] [ + img [Props.Src @"assets\Swate_logo_for_excel.svg"] ] quickAccessListElement model dispatch @@ -243,11 +232,11 @@ let navbarComponent (model : Model) (dispatch : Msg -> unit) = ] Navbar.menu [Navbar.Menu.Props [Id "navbarMenu"; Class (if model.SiteStyleState.BurgerVisible then "navbar-menu is-active" else "navbar-menu") ; ExcelColors.colorControl model.SiteStyleState.ColorMode]] [ Navbar.Dropdown.div [ ] [ - Navbar.Item.a [Navbar.Item.Props [Style [ Color model.SiteStyleState.ColorMode.Text]]] [ - str "How to use (WIP)" + Navbar.Item.a [Navbar.Item.Props [ Href Shared.URLs.DocsFeatureUrl ; Target "_Blank"; Style [ Color model.SiteStyleState.ColorMode.Text]]] [ + str "How to use" ] - Navbar.Item.a [Navbar.Item.Props [Style [ Color model.SiteStyleState.ColorMode.Text]]] [ - str "Contact (WIP)" + Navbar.Item.a [Navbar.Item.Props [Href @"https://github.com/nfdi4plants/Swate/issues/new/choose"; Target "_Blank"; Style [ Color model.SiteStyleState.ColorMode.Text]]] [ + str "Contact" ] Navbar.Item.a [Navbar.Item.Props [ OnClick (fun e -> diff --git a/src/Client/CustomComponents/PaginatedTable.fs b/src/Client/CustomComponents/PaginatedTable.fs index 3a2aa5e8..b36de91c 100644 --- a/src/Client/CustomComponents/PaginatedTable.fs +++ b/src/Client/CustomComponents/PaginatedTable.fs @@ -18,10 +18,15 @@ type paginationParameters = { } let createPaginationLinkFromIndex (dispatch:Msg->unit) (pageIndex:int) (currentPageinationIndex: int)= - + let isActve = pageIndex = currentPageinationIndex Pagination.Link.a [ - Pagination.Link.Current (pageIndex = currentPageinationIndex) - Pagination.Link.Props [OnClick (fun _ -> pageIndex |> ChangePageinationIndex |> AdvancedSearch |> dispatch)] + Pagination.Link.Current isActve + Pagination.Link.Props [ + Style [ + if isActve then Color "white"; BackgroundColor NFDIColors.Mint.Base; BorderColor NFDIColors.Mint.Base; + ] + OnClick (fun _ -> pageIndex |> ChangePageinationIndex |> AdvancedSearch |> dispatch) + ] ] [ span [] [str (string (pageIndex+1))] ] diff --git a/src/Client/CustomComponents/ResponsiveFA.fs b/src/Client/CustomComponents/ResponsiveFA.fs new file mode 100644 index 00000000..832d8214 --- /dev/null +++ b/src/Client/CustomComponents/ResponsiveFA.fs @@ -0,0 +1,125 @@ +module CustomComponents.ResponsiveFA +open Fable.React +open Fable.React.Props +open Fulma +open Fable.FontAwesome +open Fulma.Extensions.Wikiki +open Fable.Core.JsInterop + +open ExcelColors +open Model +open Messages + +let responsiveFaElement toggle fa faToggled = + div [Style [ + Position PositionOptions.Relative + ]] [ + Fa.i [ + Fa.Props [Style [ + Position PositionOptions.Absolute + Top "0" + Left "0" + Display DisplayOptions.Block + Transition "opacity 0.25s, transform 0.25s" + if toggle then Opacity "0" else Opacity "1" + ]] + fa + ][] + Fa.i [ + Fa.Props [Style [ + Position PositionOptions.Absolute + Top "0" + Left "0" + Display DisplayOptions.Block + Transition "opacity 0.25s, transform 0.25s" + if toggle then Opacity "1" else Opacity "0" + if toggle then Transform "rotate(-180deg)" else Transform "rotate(0deg)" + ]] + faToggled + ][] + // Invis placeholder to create correct space (Height, width, margin, padding, etc.) + Fa.i [ + Fa.Props [Style [ + Display DisplayOptions.Block + Opacity "0" + ]] + fa + ][] + ] + +let private createTriggeredId id = + sprintf "%s_triggered" id + +let private createNonTriggeredId id = + sprintf "%s_triggered_not" id + +let triggerResponsiveReturnEle id = + let notTriggeredId = createNonTriggeredId id + let triggeredId = createTriggeredId id + let ele = Browser.Dom.document.getElementById notTriggeredId + let triggeredEle = Browser.Dom.document.getElementById triggeredId + ele?style?opacity <- "0" + triggeredEle?style?opacity <- "1" + triggeredEle?style?transform <- "rotate(-360deg)" + +let responsiveReturnEle id fa faToggled = + let notTriggeredId = createNonTriggeredId id + let triggeredId = createTriggeredId id + div [Style [ + Position PositionOptions.Relative + ]] [ + Fa.i [ + Fa.Props [ + Style [ + Position PositionOptions.Absolute + Top "0" + Left "0" + Display DisplayOptions.Block + Transition "opacity 0.25s, transform 0.25s" + Opacity "1" + ] + Id notTriggeredId + + OnTransitionEnd (fun e -> + Fable.Core.JS.setTimeout (fun () -> + let ele = Browser.Dom.document.getElementById notTriggeredId + ele?style?opacity <- "1" + ) 1500 |> ignore + () + ) + ] + fa + ][] + Fa.i [ + Fa.Props [ + Style [ + Position PositionOptions.Absolute + Top "0" + Left "0" + Display DisplayOptions.Block + Transition "opacity 0.25s, transform 0.25s" + Opacity "0" + Transform "rotate(0deg)" + ] + Id triggeredId + + OnTransitionEnd (fun e -> + Fable.Core.JS.setTimeout (fun () -> + let triggeredEle = Browser.Dom.document.getElementById triggeredId + triggeredEle?style?opacity <- "0" + triggeredEle?style?transform <- "rotate(0deg)" + ) 1500 |> ignore + () + ) + ] + faToggled + ][] + // Invis placeholder to create correct space (Height, width, margin, padding, etc.) + Fa.i [ + Fa.Props [Style [ + Display DisplayOptions.Block + Opacity "0" + ]] + fa + ][] + ] \ No newline at end of file diff --git a/src/Client/CustomComponents/WarningModal.fs b/src/Client/CustomComponents/WarningModal.fs new file mode 100644 index 00000000..bb765618 --- /dev/null +++ b/src/Client/CustomComponents/WarningModal.fs @@ -0,0 +1,44 @@ +module CustomComponents.WarningModal + +open Fable.React +open Fable.React.Props +open Fulma +open Fulma.Extensions.Wikiki +open Fable.FontAwesome +open ExcelColors +open Model +open Messages +open Shared +open CustomComponents + +let warningModal (model:Model) dispatch = + let msg = fun e -> model.WarningModal.Value.NextMsg |> dispatch + let closeMsg = fun e -> UpdateWarningModal None |> dispatch + let message = model.WarningModal.Value.ModalMessage + Modal.modal [ Modal.IsActive true ] [ + Modal.background [ + Props [ OnClick closeMsg ] + ] [ ] + Notification.notification [ + Notification.Props [Style [MaxWidth "80%"; MaxHeight "80%"; OverflowX OverflowOptions.Auto ]] + ] [ + Notification.delete [ + Props [OnClick closeMsg] + ][] + Field.div [][ + str message + ] + Field.div [][ + Button.a [ + Button.Color IsWarning + Button.Props [Style [Float FloatOptions.Right]] + Button.OnClick (fun e -> + UpdateWarningModal None |> dispatch + model.WarningModal.Value.NextMsg |> dispatch + ) + ][ + str "Continue" + ] + ] + ] + ] \ No newline at end of file diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index a1cce47e..34fa608b 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -35,6 +35,7 @@ type ExcelInteropMsg = | WriteProtocolToXml of newProtocol:Xml.GroupTypes.Protocol | DeleteAllCustomXml | GetSwateCustomXml + | UpdateSwateCustomXml of string // | FillHiddenColsRequest | FillHiddenColumns of tableName:string*SearchTermI [] @@ -43,6 +44,9 @@ type ExcelInteropMsg = | InsertFileNames of fileNameList:string list // Show Details to selected BuildingBlock | GetSelectedBuildingBlockSearchTerms + // + | CreatePointerJson + // // Development | TryExcel | TryExcel2 @@ -177,7 +181,7 @@ type BuildingBlockDetailsMsg = | ToggleShowDetails | UpdateCurrentRequestState of RequestBuildingBlockInfoStates -type SettingXmlMsg = +type SettingsXmlMsg = // // Client // // // Validation Xml | UpdateActiveSwateValidation of OfficeInterop.Types.Xml.ValidationTypes.TableValidation option @@ -191,19 +195,88 @@ type SettingXmlMsg = | UpdateActiveProtocol of OfficeInterop.Types.Xml.GroupTypes.Protocol option | UpdateNextAnnotationTableForActiveProtocol of AnnotationTable option // - | UpdateRawCustomXml of string + | UpdateRawCustomXml of string + | UpdateNextRawCustomXml of string // Excel Interop | GetAllValidationXmlParsedRequest - | GetAllValidationXmlParsedResponse of OfficeInterop.Types.Xml.ValidationTypes.TableValidation list * AnnotationTable [] + | GetAllValidationXmlParsedResponse of OfficeInterop.Types.Xml.ValidationTypes.TableValidation list * AnnotationTable [] | GetAllProtocolGroupXmlParsedRequest - | GetAllProtocolGroupXmlParsedResponse of OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup list * AnnotationTable [] - | ReassignCustomXmlRequest of prevXml:OfficeInterop.Types.Xml.XmlTypes * newXml:OfficeInterop.Types.Xml.XmlTypes - | RemoveCustomXmlRequest of xml: OfficeInterop.Types.Xml.XmlTypes + | GetAllProtocolGroupXmlParsedResponse of OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup list * AnnotationTable [] + | ReassignCustomXmlRequest of prevXml:OfficeInterop.Types.Xml.XmlTypes * newXml:OfficeInterop.Types.Xml.XmlTypes + | RemoveCustomXmlRequest of xml: OfficeInterop.Types.Xml.XmlTypes + +type SettingsDataStewardMsg = + // Client + | UpdatePointerJson of string option + +type SettingsProtocolMsg = + | UpdateProtocolsFromExcel of OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup option + | UpdateProtocolsFromDB of Shared.ProtocolTemplate [] + // ExcelInterop + | GetActiveProtocolGroupXmlParsed + | GetProtocolsFromDBRequest of OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup option + | UpdateProtocolByNewVersion of OfficeInterop.Types.Xml.GroupTypes.Protocol * Shared.ProtocolTemplate type TopLevelMsg = | CloseSuggestions -type Msg = +type Model = { + + ///PageState + PageState : PageState + + ///Data that needs to be persistent once loaded + PersistentStorageState : PersistentStorageState + + ///Debouncing + DebouncerState : Debouncer.State + + ///Error handling, Logging, etc. + DevState : DevState + + ///Site Meta Options (Styling etc) + SiteStyleState : SiteStyleState + + ///States regarding term search + TermSearchState : TermSearchState + + AdvancedSearchState : AdvancedSearchState + + ///Use this in the future to model excel stuff like table data + ExcelState : ExcelState + + ///Use this to log Api calls and maybe handle them better + ApiState : ApiState + + ///States regarding File picker functionality + FilePickerState : FilePickerState + + ProtocolInsertState : ProtocolInsertState + + ///Insert annotation columns + AddBuildingBlockState : AddBuildingBlockState + + ///Create Validation scheme for Table + ValidationState : ValidationState + + ///Used to show selected building block information + BuildingBlockDetailsState : BuildingBlockDetailsState + + ///Used to manage all custom xml settings + SettingsXmlState : SettingsXmlState + + ///Used to manage functions specifically for data stewards + SettingsDataStewardState : SettingsDataStewardState + + ///Used to manage protocols + SettingsProtocolState : SettingsProtocolState + + WarningModal : {|NextMsg:Msg; ModalMessage: string|} option +} with + member this.updateByExcelState (s:ExcelState) = + { this with ExcelState = s} + +and Msg = | Bounce of (System.TimeSpan*string*Msg) | Api of ApiMsg | Dev of DevMsg @@ -218,8 +291,35 @@ type Msg = | Validation of ValidationMsg | ProtocolInsert of ProtocolInsertMsg | BuildingBlockDetails of BuildingBlockDetailsMsg - | SettingXmlMsg of SettingXmlMsg + | SettingsXmlMsg of SettingsXmlMsg + | SettingDataStewardMsg of SettingsDataStewardMsg + | SettingsProtocolMsg of SettingsProtocolMsg | TopLevelMsg of TopLevelMsg | UpdatePageState of Routing.Route option | Batch of seq + /// This function is used to pass any 'Msg' through a warning modal, where the user needs to verify his decision. + | UpdateWarningModal of {|NextMsg:Msg; ModalMessage: string|} option | DoNothing + +open Routing + +let initializeModel (pageOpt: Route option) = { + DebouncerState = Debouncer .create () + PageState = PageState .init pageOpt + PersistentStorageState = PersistentStorageState .init () + DevState = DevState .init () + SiteStyleState = SiteStyleState .init () + TermSearchState = TermSearchState .init () + AdvancedSearchState = AdvancedSearchState .init () + ExcelState = ExcelState .init () + ApiState = ApiState .init () + FilePickerState = FilePickerState .init () + AddBuildingBlockState = AddBuildingBlockState .init () + ValidationState = ValidationState .init () + ProtocolInsertState = ProtocolInsertState .init () + BuildingBlockDetailsState = BuildingBlockDetailsState .init () + SettingsXmlState = SettingsXmlState .init () + SettingsDataStewardState = SettingsDataStewardState .init () + SettingsProtocolState = SettingsProtocolState .init () + WarningModal = None +} diff --git a/src/Client/Model.fs b/src/Client/Model.fs index f365f315..b79ac753 100644 --- a/src/Client/Model.fs +++ b/src/Client/Model.fs @@ -435,6 +435,7 @@ type SettingsXmlState = { NextAnnotationTableForActiveProtocol : AnnotationTable option // RawXml : string + NextRawXml : string FoundTables : Shared.AnnotationTable [] ProtocolGroupXmls : OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup [] ValidationXmls : OfficeInterop.Types.Xml.ValidationTypes.TableValidation [] @@ -450,72 +451,26 @@ type SettingsXmlState = { NextAnnotationTableForActiveProtocol = None // RawXml = "" + NextRawXml = "" FoundTables = [||] ProtocolGroupXmls = [||] ValidationXmls = [||] } -type Model = { - - //PageState - PageState : PageState - - //Data that needs to be persistent once loaded - PersistentStorageState : PersistentStorageState - - //Debouncing - DebouncerState : Debouncer.State - - //Error handling, Logging, etc. - DevState : DevState - - //Site Meta Options (Styling etc) - SiteStyleState : SiteStyleState - - //States regarding term search - TermSearchState : TermSearchState - - AdvancedSearchState : AdvancedSearchState - - //Use this in the future to model excel stuff like table data - ExcelState : ExcelState - - //Use this to log Api calls and maybe handle them better - ApiState : ApiState - - //States regarding File picker functionality - FilePickerState : FilePickerState - - ProtocolInsertState : ProtocolInsertState - - //Insert annotation columns - AddBuildingBlockState : AddBuildingBlockState - - //Create Validation scheme for Table - ValidationState : ValidationState - - //Used to show selected building block information - BuildingBlockDetailsState : BuildingBlockDetailsState - - //Used to manage all xml settings - SettingsXmlState : SettingsXmlState +type SettingsDataStewardState = { + PointerJson : string option +} with + static member init () = { + PointerJson = None + } -} +type SettingsProtocolState = { + ProtocolsFromExcel : OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup option + ProtocolsFromDB : Shared.ProtocolTemplate [] +} with + static member init () = { + ProtocolsFromExcel = None + ProtocolsFromDB = [||] + } -let initializeModel (pageOpt: Route option) = { - DebouncerState = Debouncer .create () - PageState = PageState .init pageOpt - PersistentStorageState = PersistentStorageState .init () - DevState = DevState .init () - SiteStyleState = SiteStyleState .init () - TermSearchState = TermSearchState .init () - AdvancedSearchState = AdvancedSearchState .init () - ExcelState = ExcelState .init () - ApiState = ApiState .init () - FilePickerState = FilePickerState .init () - AddBuildingBlockState = AddBuildingBlockState .init () - ValidationState = ValidationState .init () - ProtocolInsertState = ProtocolInsertState .init () - BuildingBlockDetailsState = BuildingBlockDetailsState .init () - SettingsXmlState = SettingsXmlState .init () -} +/// The main MODEL was shifted to 'Messages.fs' to allow saving 'Msg' diff --git a/src/Client/OfficeInterop/HelperFunctions.fs b/src/Client/OfficeInterop/HelperFunctions.fs index e30189cf..6e06ab48 100644 --- a/src/Client/OfficeInterop/HelperFunctions.fs +++ b/src/Client/OfficeInterop/HelperFunctions.fs @@ -752,8 +752,11 @@ let getSwateProtocolGroupForCurrentTable tableName worksheetName (xmlParsed:XmlE /// Use the 'remove' parameter to remove any Swate protocol group xml for the worksheet annotation table name combination in 'protocolGroup' let updateRemoveSwateProtocolGroup (protocolGroup:Xml.GroupTypes.ProtocolGroup) (previousCompleteCustomXml:XmlElement) (remove:bool) = + printfn "START UPDATE PROTOCOL GROUP" let currentTableXml = getActiveTableXml protocolGroup.AnnotationTable.Name protocolGroup.AnnotationTable.Worksheet previousCompleteCustomXml + + printfn "create next group" let nextTableXml = let newProtocolGroupXml = protocolGroup.toXml |> SimpleXml.parseElement if currentTableXml.IsSome then @@ -774,6 +777,8 @@ let updateRemoveSwateProtocolGroup (protocolGroup:Xml.GroupTypes.ProtocolGroup) {swateTableXmlEle with Children = [newProtocolGroupXml] } + + printfn "filter out previous group" let filterPrevTableFromRootChildren = previousCompleteCustomXml.Children |> List.filter (fun x -> @@ -783,6 +788,7 @@ let updateRemoveSwateProtocolGroup (protocolGroup:Xml.GroupTypes.ProtocolGroup) && x.Attributes.["Worksheet"] = protocolGroup.AnnotationTable.Worksheet isExisting |> not ) + printfn "create new Group" {previousCompleteCustomXml with Children = nextTableXml::filterPrevTableFromRootChildren } @@ -808,10 +814,15 @@ let updateRemoveSwateProtocol (protocol:Xml.GroupTypes.Protocol) (previousComple else isExisting.Value + printfn "START UPDATE" + printfn "CurrentProtocolGroup: %A" currentSwateProtocolGroup + let filteredProtocolChildren = currentSwateProtocolGroup.Protocols |> List.filter (fun x -> x.Id <> protocol.Id) + printfn "filter out children" + let nextProtocolGroup = {currentSwateProtocolGroup with Protocols = @@ -847,7 +858,11 @@ let updateProtocolFromXml (protocol:Xml.GroupTypes.Protocol) (remove:bool) = // Then AnnotationTable was added to protocol. So now we refresh these values at this point. let securityUpdateForProtocol = {protocol with AnnotationTable = AnnotationTable.create annotationTable activeSheet.name} - let nextCustomXml = updateSwateProtocol securityUpdateForProtocol xmlParsed + let nextCustomXml = + if remove then + removeSwateProtocol securityUpdateForProtocol xmlParsed + else + updateSwateProtocol securityUpdateForProtocol xmlParsed let nextCustomXmlString = nextCustomXml |> xmlElementToXmlString diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index 902bef3f..31ac697a 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -64,23 +64,10 @@ open Fable.SimpleXml.Generator /// This is not used in production and only here for development. Its content is always changing to test functions for new features. let exampleExcelFunction1 () = Excel.run(fun context -> - - let annotationTable = "annotationTable" - - let selectedRange = context.workbook.getSelectedRange() - let _ = selectedRange.load(U2.Case2 (ResizeArray(["values";"columnIndex"; "columnCount"]))) - - // Ref. 2 - let annoHeaderRange, annoBodyRange = getBuildingBlocksPreSync context annotationTable - + promise { - let! selectedBuildingBlock = - findSelectedBuildingBlock selectedRange annoHeaderRange annoBodyRange context - - let searchTerms = sortBuildingBlockToSearchTerm selectedBuildingBlock - - return (sprintf "%A" searchTerms) + return (sprintf "0" ) } ) @@ -377,7 +364,7 @@ let getTableRepresentation() = "" activeWorksheet.name annotationTable - System.DateTime.Now + (System.DateTime.Now.ToUniversalTime()) [] newColumnValidations updateTableValidation @@ -513,8 +500,6 @@ let addAnnotationBlock (buildingBlockInfo:MinimalBuildingBlock) = //create an empty column to insert let col value = createEmptyMatrixForTables 1 rowCount value - printfn "%A" buildingBlockInfo.Values - // create main column let createdCol1() = let mainColVal = if buildingBlockInfo.Values.IsSome then buildingBlockInfo.Values.Value.Name else "" @@ -581,7 +566,9 @@ let addAnnotationBlocksAsProtocol (buildingBlockInfoList:MinimalBuildingBlock li } let chainBuildingBlocks buildingBlockInfoList = let promiseList = buildingBlockInfoList |> List.map (fun x -> addBuildingBlock x) + let emptyPromise = promise {return []} + let rec chain ind (promiseList:JS.Promise<(string*string*string) list> list ) resultPromise = if ind >= promiseList.Length then resultPromise @@ -618,8 +605,11 @@ let addAnnotationBlocksAsProtocol (buildingBlockInfoList:MinimalBuildingBlock li if currentProtocolGroup.IsSome then let existsAlready = currentProtocolGroup.Value.Protocols - |> List.tryFind (fun existingProtocol -> - existingProtocol.Id = protocol.Id + |> List.tryFind ( fun existingProtocol -> + if buildingBlockInfoList |> List.exists (fun x -> x.IsAlreadyExisting = true) then + existingProtocol.Id = protocol.Id && existingProtocol.ProtocolVersion = protocol.ProtocolVersion + else + false ) let isComplete = if existsAlready.IsSome then @@ -630,11 +620,20 @@ let addAnnotationBlocksAsProtocol (buildingBlockInfoList:MinimalBuildingBlock li if isComplete then failwith ( sprintf "Protocol %s exists already in %s - %s." existsAlready.Value.Id currentProtocolGroup.Value.AnnotationTable.Name currentProtocolGroup.Value.AnnotationTable.Worksheet) - let! chainProm = chainBuildingBlocks buildingBlockInfoList + /// filter out building blocks that are only passed to keep the colNames + let onlyNonExistingBuildingBlocks = buildingBlockInfoList |> List.filter (fun x -> x.IsAlreadyExisting <> true) + let alreadyExistingBlocks = + buildingBlockInfoList + |> List.filter (fun x -> x.IsAlreadyExisting = true) + |> List.map (fun x -> + x.MainColumnName, "0.00", "" + ) + + let! chainProm = chainBuildingBlocks onlyNonExistingBuildingBlocks - let updateProtocol = {protocol with AnnotationTable = AnnotationTable.create annotationTable activeSheet.name} + let updateProtocol = {protocol with AnnotationTable = AnnotationTable.create annotationTable activeSheet.name} - return (chainProm,updateProtocol) + return (chainProm@alreadyExistingBlocks,updateProtocol) } ) @@ -644,19 +643,72 @@ let addAnnotationBlocksAsProtocol (buildingBlockInfoList:MinimalBuildingBlock li [ for ind in 0 .. blockResults.Length-1 do let colName = blockResults |> List.item ind |> (fun (x,_,_) -> x) - let relatedTermAccession = buildingBlockInfoList |> List.rev |> List.item ind |> (fun x -> - if colName.Contains(x.MainColumnName) |> not then - failwith (sprintf "Had problems relating term accession and term name: %s in %s" x.MainColumnName colName) - if x.MainColumnTermAccession.IsSome then x.MainColumnTermAccession.Value else "" - ) + let relatedTermAccession = + buildingBlockInfoList + |> List.tryFind ( fun x -> colName.Contains(x.MainColumnName) ) + |> fun x -> + if x.IsNone then + failwith ( + sprintf + "Could not find created building block information %s in given list: %A" + colName + (buildingBlockInfoList|> List.map (fun y -> y.MainColumnName)) + ) + else + if x.IsSome && x.Value.MainColumnTermAccession.IsSome then x.Value.MainColumnTermAccession.Value else "" yield Xml.GroupTypes.SpannedBuildingBlock.create colName relatedTermAccession ] let completeProtocolInfo = {info with SpannedBuildingBlocks = createSpannedBlocks} + printfn "%A" completeProtocolInfo return (blockResults,completeProtocolInfo) } -let removeAnnotationBlock () = +/// This function removes a given building block from a given annotation table. +/// It returns the affected column indices. +let removeAnnotationBlock (tableName:string) (annotationBlock:BuildingBlock) = + Excel.run(fun context -> + promise { + + let sheet = context.workbook.worksheets.getActiveWorksheet() + let table = sheet.tables.getItem(tableName) + + // Ref. 2 + + let _ = table.load(U2.Case1 "columns") + let tableCols = table.columns.load(propertyNames = U2.Case1 "items") + + let targetedColIndices = + let hasTSRAndTan = + if annotationBlock.hasCompleteTSRTAN then [|annotationBlock.TAN.Value.Index; annotationBlock.TSR.Value.Index|] else [||] + let hasUnit = + if annotationBlock.hasCompleteUnitBlock then + [|annotationBlock.Unit.Value.MainColumn.Index;annotationBlock.Unit.Value.TSR.Value.Index;annotationBlock.Unit.Value.TAN.Value.Index|] + else + [||] + [| annotationBlock.MainColumn.Index + yield! hasTSRAndTan + yield! hasUnit + |] |> Array.sort + + let! deleteCols = + context.sync().``then``(fun e -> + targetedColIndices |> Array.map (fun targetIndex -> + tableCols.items.[targetIndex].delete() + ) + ) + + return targetedColIndices + } + ) + +let removeAnnotationBlocks (tableName:string) (annotationBlocks:BuildingBlock []) = + annotationBlocks + |> Array.sortByDescending (fun x -> x.MainColumn.Index) + |> Array.map (removeAnnotationBlock tableName) + |> Promise.all + +let removeSelectedAnnotationBlock () = Excel.run(fun context -> promise { @@ -687,27 +739,9 @@ let removeAnnotationBlock () = let! selectedBuildingBlock = BuildingBlockTypes.findSelectedBuildingBlock selectedRange annoHeaderRange annoBodyRange context - let targetedColIndices = - let hasTSRAndTan = - if selectedBuildingBlock.hasCompleteTSRTAN then [|selectedBuildingBlock.TAN.Value.Index; selectedBuildingBlock.TSR.Value.Index|] else [||] - let hasUnit = - if selectedBuildingBlock.hasCompleteUnitBlock then - [|selectedBuildingBlock.Unit.Value.MainColumn.Index;selectedBuildingBlock.Unit.Value.TSR.Value.Index;selectedBuildingBlock.Unit.Value.TAN.Value.Index|] - else - [||] - [| selectedBuildingBlock.MainColumn.Index - yield! hasTSRAndTan - yield! hasUnit - |] |> Array.sort - - let! deleteCols = - context.sync().``then``(fun e -> - targetedColIndices |> Array.map (fun targetIndex -> - tableCols.items.[targetIndex].delete() - ) - ) + let! deleteCols = removeAnnotationBlock annotationTable selectedBuildingBlock - return sprintf "Delete Building Block %s (Cols: %A]" selectedBuildingBlock.MainColumn.Header.Value.Header targetedColIndices + return sprintf "Delete Building Block %s (Cols: %A]" selectedBuildingBlock.MainColumn.Header.Value.Header deleteCols } ) @@ -835,59 +869,62 @@ let getParentTerm () = Excel.run (fun context -> promise { - let! annotationTable = getActiveAnnotationTableName() - // Ref. 2 - let sheet = context.workbook.worksheets.getActiveWorksheet() - let annotationTable = sheet.tables.getItem(annotationTable) - let tableRange = annotationTable.getRange() - let _ = tableRange.load(U2.Case2 (ResizeArray[|"columnIndex"; "rowIndex"; "values"|])) - let range = context.workbook.getSelectedRange() - let _ = range.load(U2.Case2 (ResizeArray[|"columnIndex"; "rowIndex"|])) - - let! res = context.sync().``then``( fun _ -> - - // Ref. 3 - /// recalculate the selected col index from a worksheet perspective to the table perspective. - let newColIndex = - let tableRangeColIndex = tableRange.columnIndex - let selectColIndex = range.columnIndex - selectColIndex - tableRangeColIndex |> int - - let newRowIndex = - let tableRangeRowIndex = tableRange.rowIndex - let selectedRowIndex = range.rowIndex - selectedRowIndex - tableRangeRowIndex |> int - - /// Get all values from the table range - let colHeaderVals = tableRange.values.[0] - let rowVals = tableRange.values - /// Get the index of the last column in the table - let lastColInd = colHeaderVals.Count-1 - /// Get the index of the last row in the table - let lastRowInd = rowVals.Count-1 - let value = - // check if selected range is inside table - if - newColIndex < 0 - || newColIndex > lastColInd - || newRowIndex < 0 - || newRowIndex > lastRowInd - then - None - else - // is selected range is in table then take header value from selected column - let header = tableRange.values.[0].[newColIndex] - let parsedHeader = parseColHeader (string header.Value) - /// as the reference columns also contain a accession tag we want to return the first reference column header - /// instead of the main column header, if the main column header does include an ontology - if parsedHeader.Ontology.IsSome then - tableRange.values.[0].[newColIndex+1] - else + try + let! annotationTable = getActiveAnnotationTableName() + // Ref. 2 + let sheet = context.workbook.worksheets.getActiveWorksheet() + let annotationTable = sheet.tables.getItem(annotationTable) + let tableRange = annotationTable.getRange() + let _ = tableRange.load(U2.Case2 (ResizeArray[|"columnIndex"; "rowIndex"; "values"|])) + let range = context.workbook.getSelectedRange() + let _ = range.load(U2.Case2 (ResizeArray[|"columnIndex"; "rowIndex"|])) + + let! res = context.sync().``then``( fun _ -> + + // Ref. 3 + /// recalculate the selected col index from a worksheet perspective to the table perspective. + let newColIndex = + let tableRangeColIndex = tableRange.columnIndex + let selectColIndex = range.columnIndex + selectColIndex - tableRangeColIndex |> int + + let newRowIndex = + let tableRangeRowIndex = tableRange.rowIndex + let selectedRowIndex = range.rowIndex + selectedRowIndex - tableRangeRowIndex |> int + + /// Get all values from the table range + let colHeaderVals = tableRange.values.[0] + let rowVals = tableRange.values + /// Get the index of the last column in the table + let lastColInd = colHeaderVals.Count-1 + /// Get the index of the last row in the table + let lastRowInd = rowVals.Count-1 + let value = + // check if selected range is inside table + if + newColIndex < 0 + || newColIndex > lastColInd + || newRowIndex < 0 + || newRowIndex > lastRowInd + then None - // return header of selected col - value - ) - return res + else + // is selected range is in table then take header value from selected column + let header = tableRange.values.[0].[newColIndex] + let parsedHeader = parseColHeader (string header.Value) + /// as the reference columns also contain a accession tag we want to return the first reference column header + /// instead of the main column header, if the main column header does include an ontology + if parsedHeader.Ontology.IsSome then + tableRange.values.[0].[newColIndex+1] + else + None + // return header of selected col + value + ) + return res + with + | exn -> return None } ) @@ -1228,7 +1265,34 @@ let getSwateCustomXml() = } ) +let updateSwateCustomXml(newXmlString:String) = + Excel.run(fun context -> + + // The first part accesses current CustomXml + let workbook = context.workbook.load(propertyNames = U2.Case2 (ResizeArray[|"customXmlParts"|])) + let customXmlParts = workbook.customXmlParts.load (propertyNames = U2.Case2 (ResizeArray[|"items"|])) + + promise { + + let! deleteXml = + context.sync().``then``(fun e -> + let items = customXmlParts.items + let xmls = items |> Seq.map (fun x -> x.delete() ) + + xmls |> Array.ofSeq + ) + + let! addNext = + context.sync().``then``(fun e -> + customXmlParts.add(newXmlString) + ) + + return "Info", "Custom xml update successful" + } + ) + let writeProtocolToXml(protocol:GroupTypes.Protocol) = + printfn "%A" protocol updateProtocolFromXml protocol false let removeProtocolFromXml(protocol:GroupTypes.Protocol) = @@ -1264,7 +1328,6 @@ let updateProtocolGroupHeader () = let getGroupHeaderIndicesForProtocol (buildingBlocks:BuildingBlock []) (protocol:Xml.GroupTypes.Protocol) = let buildingBlockOpts = tryFindSpannedBuildingBlocks protocol buildingBlocks - // caluclate list of indices fro group blocks if buildingBlockOpts.IsSome then let getStartAndEnd (mainColIndices:int list) = @@ -1278,15 +1341,16 @@ let updateProtocolGroupHeader () = buildingBlockOpts.Value |> List.map (fun bb -> let nOfCols = - if bb.TAN.IsNone || bb.TSR.IsNone then + if bb.hasCompleteTSRTAN |> not then 1 - elif bb.TAN.IsSome && bb.TSR.IsSome && bb.Unit.IsNone then + elif bb.hasCompleteTSRTAN && bb.hasCompleteUnitBlock |> not then 3 - elif bb.TAN.IsSome && bb.TSR.IsSome && bb.Unit.IsSome then + elif bb.hasCompleteTSRTAN && bb.hasCompleteUnitBlock then 6 else failwith (sprintf "Swate encountered an unknown column pattern for building block: %s " bb.MainColumn.Header.Value.Header) bb.MainColumn.Index, nOfCols ) + |> List.sortBy fst let rec sortIntoBlocks (iteration:int) (currentGroupIterator:int) (bbColNumberAndIndices:(int*int) list) (collector:(int*int*int) list) = if iteration >= bbColNumberAndIndices.Length then collector @@ -1392,7 +1456,7 @@ let updateProtocolGroupHeader () = else // REMOVE INCOMPLETE PROTOCOL - + printfn "REMOVE!" let! remove = removeProtocolFromXml protocol return sprintf "%A" remove @@ -1415,7 +1479,7 @@ let writeTableValidationToXml(tableValidation:ValidationTypes.TableValidation,cu tableValidation with // This line is used to give freshly created TableValidations the current Swate Version SwateVersion = if tableValidation.SwateVersion = "" then currentSwateVersion else tableValidation.SwateVersion - DateTime = System.DateTime.Now + DateTime = System.DateTime.Now.ToUniversalTime() } // The first part accesses current CustomXml @@ -1456,7 +1520,7 @@ let writeTableValidationToXml(tableValidation:ValidationTypes.TableValidation,cu let addTableValidationToExisting (tableValidation:ValidationTypes.TableValidation, colNames: string list) = Excel.run(fun context -> - + printfn "START ADDING TABLEVALIDATION" let getBaseName (colHeader:string) = let parsedHeader = parseColHeader colHeader let ont = if parsedHeader.Ontology.IsSome then sprintf " [%s]" parsedHeader.Ontology.Value.Name else "" @@ -1467,7 +1531,8 @@ let addTableValidationToExisting (tableValidation:ValidationTypes.TableValidatio getBaseName x, x ) |> Map.ofList - + printfn "%A" newColNameMap + printfn "%A" tableValidation //failwith (sprintf "%A" tableValidation) let updateColumnValidationColNames = @@ -1483,7 +1548,7 @@ let addTableValidationToExisting (tableValidation:ValidationTypes.TableValidatio // Update DateTime let newTableValidation = { tableValidation with - DateTime = System.DateTime.Now + DateTime = System.DateTime.Now.ToUniversalTime() ColumnValidations = updateColumnValidationColNames } @@ -1639,6 +1704,26 @@ let getAllValidationXmlParsed() = } ) +let getActiveProtocolGroupXmlParsed() = + Excel.run(fun context -> + + promise { + + let activeSheet = context.workbook.worksheets.getActiveWorksheet().load(propertyNames = U2.Case2 (ResizeArray[|"name"|])) + let! annotationTable = getActiveAnnotationTableName() + + let workbook = context.workbook.load(propertyNames = U2.Case2 (ResizeArray[|"customXmlParts"|])) + let customXmlParts = workbook.customXmlParts.load (propertyNames = U2.Case2 (ResizeArray[|"items"|])) + + let! xmlParsed = getCustomXml customXmlParts context + + let protocolGroup = getSwateProtocolGroupForCurrentTable annotationTable activeSheet.name xmlParsed + + return protocolGroup + + } + ) + let getAllProtocolGroupXmlParsed() = Excel.run(fun context -> @@ -1669,6 +1754,124 @@ let getAllProtocolGroupXmlParsed() = } ) + +/// This function aims to update a protocol with a newer version from the db. To do this with minimum user friction we want the following: +/// Keep all already existing building blocks that still exist in the new version. By doing this we keep already filled in values. +/// Remove all building blocks that are not part of the new version. +/// Add all new building blocks. +// Of couse this is best be done by using already existing functions. Therefore we try the following. Return information necessary to use: +// Msg 'AddAnnotationBlocks' -> this will add all new blocks that are mentioned in 'minimalBuildingBlocks', add validationXml to existing and also add protocol xml. +// 'Remove building block' functionality by passing the correct indices +let updateProtocolByNewVersion (prot:OfficeInterop.Types.Xml.GroupTypes.Protocol, dbTemplate:Shared.ProtocolTemplate) = + Excel.run(fun context -> + + promise { + + let! annotationTable = getActiveAnnotationTableName() + + // Ref. 2 + let activeWorksheet = context.workbook.worksheets.getActiveWorksheet().load(U2.Case1 "name") + let annoHeaderRange, annoBodyRange = BuildingBlockTypes.getBuildingBlocksPreSync context annotationTable + + //let workbook = context.workbook.load(propertyNames = U2.Case2 (ResizeArray[|"customXmlParts"|])) + //let customXmlParts = workbook.customXmlParts.load (propertyNames = U2.Case2 (ResizeArray[|"items"|])) + + //let! xmlParsed = getCustomXml customXmlParts context + //let currentProtocolGroup = getSwateValidationForCurrentTable annotationTable activeWorksheet.name xmlParsed + + let! allBuildingBlocks = + context.sync().``then``( fun _ -> + let buildingBlocks = getBuildingBlocks annoHeaderRange annoBodyRange + + buildingBlocks + ) + + let filterBuildingBlocksForProtocol = + allBuildingBlocks |> Array.filter (fun bb -> + prot.SpannedBuildingBlocks |> List.exists (fun spannedBB -> spannedBB.ColumnName = bb.MainColumn.Header.Value.Header) + ) + + let minBuildingBlocksInfoDB = dbTemplate.TableXml |> MinimalBuildingBlock.ofExcelTableXml |> snd + + let minimalBuildingBlocksToAdd = + minBuildingBlocksInfoDB + |> List.filter (fun minimalBB -> + filterBuildingBlocksForProtocol + |> Array.exists (fun bb -> minimalBB = MinimalBuildingBlock.ofBuildingBlockWithoutValues false bb) + |> not + ) + + let buildingBlocksToRemove = + filterBuildingBlocksForProtocol + |> Array.filter (fun x -> + minBuildingBlocksInfoDB + |> List.exists (fun minimalBB -> minimalBB = MinimalBuildingBlock.ofBuildingBlockWithoutValues false x) + |> not + ) + + let alreadyExistingBuildingBlocks = + filterBuildingBlocksForProtocol + |> Array.filter (fun bb -> + buildingBlocksToRemove + |> Array.contains bb + |> not + ) + |> Array.map (fun bb -> + MinimalBuildingBlock.ofBuildingBlockWithoutValues true bb + |> fun minBB -> {minBB with MainColumnName = bb.MainColumn.Header.Value.Header} + ) + |> List.ofArray + + let! remove = + removeAnnotationBlocks annotationTable buildingBlocksToRemove + + let! reloadBuildingBlocks = + let annoHeaderRange, annoBodyRange = BuildingBlockTypes.getBuildingBlocksPreSync context annotationTable + + let allBuildingBlocks = + context.sync().``then``( fun _ -> + let buildingBlocks = getBuildingBlocks annoHeaderRange annoBodyRange + + buildingBlocks + ) + + allBuildingBlocks + + let filterReloadedBuildingBlocksForProtocol = + reloadBuildingBlocks |> Array.filter (fun bb -> + prot.SpannedBuildingBlocks |> List.exists (fun spannedBB -> spannedBB.ColumnName = bb.MainColumn.Header.Value.Header) + ) + + let table = activeWorksheet.tables.getItem(annotationTable) + + //Auto select place to add new building blocks. + let! selectCorrectIndex = context.sync().``then``(fun e -> + let lastInd = filterReloadedBuildingBlocksForProtocol |> Array.map (fun bb -> bb.MainColumn.Index) |> Array.max |> float + + table.getDataBodyRange().getColumn(lastInd).select() + ) + + let validationType = + dbTemplate.CustomXml + |> ValidationTypes.TableValidation.ofXml + |> Some + + let protocol = + let id = dbTemplate.Name + let version = dbTemplate.Version + /// This could be outdated and needs to be updated during Msg-handling + let swateVersion = prot.SwateVersion + GroupTypes.Protocol.create id version swateVersion [] annotationTable activeWorksheet.name + + /// Need to connect both again. 'alreadyExistingBuildingBlocks' is marked as already existing and is only passed to remain info about + let minimalBuildingBlockInfo = + minimalBuildingBlocksToAdd@alreadyExistingBuildingBlocks + + return minimalBuildingBlockInfo, protocol, validationType + } + ) + + let removeXmlType(xmlType:XmlTypes) = Excel.run(fun context -> @@ -1755,4 +1958,41 @@ let updateAnnotationTableByXmlType(prevXmlType:XmlTypes, nextXmlType:XmlTypes) = return (sprintf "Updated %s BY %s" prevXmlType.toStringRdb nextXmlType.toStringRdb) } + ) + +let createPointerJson() = + Excel.run(fun context -> + + let activeSheet = context.workbook.worksheets.getActiveWorksheet().load(propertyNames = U2.Case2 (ResizeArray[|"name"|])) + + promise { + let! annotationTable = getActiveAnnotationTableName() + let workbook = context.workbook.load(U2.Case1 "name") + + let! json = context.sync().``then``(fun e -> + [ + "name" , Fable.SimpleJson.JString "" + "version" , Fable.SimpleJson.JString "" + "author" , Fable.SimpleJson.JString "" + "description" , Fable.SimpleJson.JString "" + "docslink" , Fable.SimpleJson.JString "" + "tags" , Fable.SimpleJson.JArray [] + "Workbook" , Fable.SimpleJson.JString workbook.name + "Worksheet" , Fable.SimpleJson.JString activeSheet.name + "Table" , Fable.SimpleJson.JString annotationTable + ] + |> List.map (fun x -> + [x] + |> Map.ofList + |> Fable.SimpleJson.JObject + |> Fable.SimpleJson.SimpleJson.toString + |> fun x -> " " + x.Replace("{","").Replace("}","") + ) + |> String.concat (sprintf ",%s" System.Environment.NewLine) + |> fun jsonbody -> + sprintf "{%s%s%s}" System.Environment.NewLine jsonbody System.Environment.NewLine + ) + + return json + } ) \ No newline at end of file diff --git a/src/Client/OfficeInterop/Regex.fs b/src/Client/OfficeInterop/Regex.fs index 0a1c8850..b50752d8 100644 --- a/src/Client/OfficeInterop/Regex.fs +++ b/src/Client/OfficeInterop/Regex.fs @@ -136,7 +136,7 @@ module MinimalBuildingBlock = let newCurrentMinBBCol = let ont = if currentCol.Ontology.IsSome then sprintf " [%s]" currentCol.Ontology.Value.Name else "" let name = sprintf "%s%s" currentCol.CoreName.Value ont - MinimalBuildingBlock.create name None None None None |> Some + MinimalBuildingBlock.create name None None None None false |> Some let newMinBBColList = if currentMinBBCol.IsSome then currentMinBBCol.Value::minBBColList else minBBColList parseToMinBB (iterator+1) newCurrentMinBBCol newMinBBColList diff --git a/src/Client/OfficeInterop/Types.fs b/src/Client/OfficeInterop/Types.fs index 2f8dd25d..6069964a 100644 --- a/src/Client/OfficeInterop/Types.fs +++ b/src/Client/OfficeInterop/Types.fs @@ -180,16 +180,28 @@ module Xml = [] let ValidationXmlRoot = "TableValidation" + //type Checksum = + // | MD5 + // | Sha256 + // | NoChecksum + + // static member tryOfString str = + // match str with + // | "MD5" -> Some MD5 + // | "Sha256" -> Some Sha256 + // | "None" -> Some NoChecksum + // | anyElse -> None + /// User can define what kind of input a column should have type ContentType = - | OntologyTerm of string - | UnitTerm of string + | OntologyTerm of string + | UnitTerm of string + | Checksum of string * string | Text | Url | Boolean | Number | Int - | Decimal member this.toReadableString = match this with @@ -197,6 +209,8 @@ module Xml = sprintf "Ontology [%s]" po | UnitTerm ut -> sprintf "Unit [%s]" ut + | Checksum (checksum,col) -> + sprintf "Checksum [%A%s]" checksum (if col <> "" then "," + col else "") | _ -> string this @@ -208,12 +222,18 @@ module Xml = | unit when str.StartsWith "UnitTerm " -> let s = unit.Replace("UnitTerm ", "").Replace("\"","") UnitTerm s + | checksum when str.StartsWith "Checksum " -> + let split = checksum.Replace("Checksum ","").Replace("\"","") + let s = split.[1..split.Length-2] + let hasColumn = + let split = s.Split([|","|], 1, StringSplitOptions.RemoveEmptyEntries) + if split.Length = 2 then Some split.[1] else None + Checksum (s,if hasColumn.IsNone then "" else hasColumn.Value) | "Text" -> Text | "Url" -> Url | "Boolean" -> Boolean | "Number" -> Number | "Int" -> Int - | "Decimal" -> Decimal | _ -> failwith ( sprintf "Tried parsing '%s' to ContenType. No match found." str ) @@ -260,7 +280,7 @@ module Xml = static member init (?swateVersion, ?worksheetName,?tableName, (?dateTime:DateTime), ?userList) = { SwateVersion = if swateVersion.IsSome then swateVersion.Value else "" AnnotationTable = Shared.AnnotationTable.create (if tableName.IsSome then tableName.Value else "") (if worksheetName.IsSome then worksheetName.Value else "") - DateTime = if dateTime.IsSome then dateTime.Value else DateTime.Now + DateTime = if dateTime.IsSome then dateTime.Value else DateTime.Now.ToUniversalTime() Userlist = if userList.IsSome then userList.Value else [] ColumnValidations = [] } @@ -427,18 +447,24 @@ module BuildingBlockTypes = open ISADotNetHelpers type MinimalBuildingBlock = { + /// If 'IsAlreadyExisting' = false then this is just a core name + ont (e.g. Parameter [instrument model], so no id). + /// If 'IsAlreadyExisting' = true this is the real value from the table. MainColumnName : string MainColumnTermAccession : string option UnitName : string option UnitTermAccession : string option Values : OntologyInfo option + /// When this type is given to 'AddBuildingBlocks' this parameter differentiates between term that were already found in the table and term that + /// need to be added. This is important to correctly update existing protocols by their newest version from the DB + IsAlreadyExisting : bool } with - static member create mainColName colTermAccession unitName unitTermAccession values = { + static member create mainColName colTermAccession unitName unitTermAccession values isExisting = { MainColumnName = mainColName MainColumnTermAccession = colTermAccession UnitName = unitName UnitTermAccession = unitTermAccession Values = values + IsAlreadyExisting = isExisting } // This function assumes that Process.ExecutesProtocol.Parameters.IsSome and Process.ParameterValues.IsSome. @@ -458,9 +484,29 @@ module BuildingBlockTypes = let unitName = if hasUnit then paramValuePair.Unit.Value.Name.Value |> ISADotNetHelpers.annotationValueToString |> Some else None let unitTermAccession = if hasUnit then paramValuePair.Unit.Value.TermAccessionNumber.Value |> ISADotNetHelpers.termAccessionReduce |> Some else None let values = if hasOntologyValue.IsSome then hasOntologyValue else OntologyInfo.create (ISADotNetHelpers.valueToString paramValuePair.Value.Value) "" |> Some - MinimalBuildingBlock.create mainColName (Some colTermAccession) unitName unitTermAccession values + MinimalBuildingBlock.create mainColName (Some colTermAccession) unitName unitTermAccession values false ) + static member ofBuildingBlockWithoutValues isExisting (buildingBlock:BuildingBlock) = + let bbHeader = buildingBlock.MainColumn.Header.Value + let mainColName = + let ont = if bbHeader.Ontology.IsSome then sprintf " [%s]" bbHeader.Ontology.Value.Name else "" + sprintf "%s%s" bbHeader.CoreName.Value ont + let mainColAccession = + if bbHeader.Ontology.IsSome then bbHeader.Ontology.Value.TermAccession |> Some else None + let unitName, unitTermAccession = + if buildingBlock.hasCompleteUnitBlock then + let unitHeader = buildingBlock.Unit.Value.MainColumn.Header.Value + let unitColName = + if unitHeader.Ontology.IsSome then unitHeader.Ontology.Value.Name |> Some else None + let unitColAccession = + if unitHeader.Ontology.IsSome then unitHeader.Ontology.Value.TermAccession |> Some else None + unitColName,unitColAccession + else + None, None + MinimalBuildingBlock.create mainColName mainColAccession unitName unitTermAccession None isExisting + + diff --git a/src/Client/Routing.fs b/src/Client/Routing.fs index e840229a..ea9fa4c7 100644 --- a/src/Client/Routing.fs +++ b/src/Client/Routing.fs @@ -18,6 +18,8 @@ type Route = | ActivityLog | Settings | SettingsXml +| SettingsDataStewards +| SettingsProtocol | NotFound static member toRouteUrl (route:Route) = @@ -32,30 +34,17 @@ type Route = | Route.Info -> "/#Info" | Route.ActivityLog -> "/#ActivityLog" | Route.Settings -> "/#Settings" - | Route.SettingsXml -> "/#SettingsXml" + | Route.SettingsXml -> "/#Settings/Xml" + | Route.SettingsDataStewards-> "/#Settings/DataStewards" + | Route.SettingsProtocol -> "/#Settings/Protocol" | Route.NotFound -> "/#NotFound" - static member toString (route:Route) = - match route with - | Route.Home -> "" - | Route.AddBuildingBlock -> "AddBuildingBlock" - | Route.TermSearch -> "TermSearch" - | Route.Validation -> "Validation" - | Route.ProtocolInsert -> "ProtocolInsert" - | Route.ProtocolSearch -> "ProtocolSearch" - | Route.Info -> "Info" - | Route.FilePicker -> "FilePicker" - | Route.ActivityLog -> "ActivityLog" - | Route.Settings -> "Settings" - | Route.SettingsXml -> "SettingsXml" - | Route.NotFound -> "NotFound" - member this.toStringRdbl = match this with | Route.Home -> "" | Route.AddBuildingBlock -> "Manage Building Blocks" | Route.TermSearch -> "Manage Terms" - | Route.Validation -> "Validation" + | Route.Validation -> "Checklist Editor" | Route.FilePicker -> "File Picker" | Route.ProtocolInsert -> "Protocol Insert" | Route.ProtocolSearch -> "Protocol Search" @@ -63,9 +52,10 @@ type Route = | Route.ActivityLog -> "Activity Log" | Route.Settings -> "Settings" | Route.SettingsXml -> "Xml Settings" + | Route.SettingsDataStewards-> "Settings for Data Stewards" + | Route.SettingsProtocol -> "Protocol Settings" | Route.NotFound -> "NotFound" - static member toIcon (p: Route)= let createElem icons name = Fable.React.Standard.span [ @@ -99,18 +89,20 @@ module Routing = /// The URL is turned into a Result. let route : Parser Route,_> = oneOf [ - map Route.Home (s "") - map Route.TermSearch (s "TermSearch") - map Route.AddBuildingBlock (s "AddBuildingBlock") - map Route.Validation (s "Validation") - map Route.FilePicker (s "FilePicker") - map Route.Info (s "Info") - map Route.ProtocolInsert (s "ProtocolInsert") - map Route.ProtocolSearch (s "ProtocolSearch") - map Route.ActivityLog (s "ActivityLog") - map Route.Settings (s "Settings") - map Route.SettingsXml (s "SettingsXml") - map Route.NotFound (s "NotFound") + map Route.Home (s "") + map Route.TermSearch (s "TermSearch") + map Route.AddBuildingBlock (s "AddBuildingBlock") + map Route.Validation (s "Validation") + map Route.FilePicker (s "FilePicker") + map Route.Info (s "Info") + map Route.ProtocolInsert (s "ProtocolInsert") + map Route.ProtocolSearch (s "ProtocolSearch") + map Route.ActivityLog (s "ActivityLog") + map Route.Settings (s "Settings") + map Route.SettingsXml (s "Settings" s "Xml") + map Route.SettingsProtocol (s "Settings" s "Protocol") + map Route.SettingsDataStewards (s "Settings" s "DataStewards") + map Route.NotFound (s "NotFound") ] //this would be the way to got if we would use push based routing, but i decided to use hash based routing. Ill leave this here for now as a note. diff --git a/src/Client/Update.fs b/src/Client/Update.fs index f5ae562d..94736fae 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -52,7 +52,7 @@ let urlUpdate (route: Route option) (currentModel:Model) : Model * Cmd = } nextModel,Cmd.none -let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:ExcelState) : ExcelState * Cmd = +let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentModel:Model) : Model * Cmd = match excelInteropMsg with @@ -63,7 +63,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel () (GenericLog >> Dev) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | UpdateProtocolGroupHeader -> let cmd = @@ -72,16 +72,16 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel () (GenericLog >> Dev) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | Initialized (h,p) -> let welcomeMsg = sprintf "Ready to go in %s running on %s" h p - let nextState = { - currentState with + let nextModel = { + currentModel.ExcelState with Host = h Platform = p - } + } let cmd = Cmd.batch [ @@ -95,7 +95,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel Cmd.ofMsg (("Info",welcomeMsg) |> (GenericLog >> Dev)) ] - nextState, cmd + currentModel.updateByExcelState nextModel, cmd | AnnotationTableExists annoTableOpt -> let exists = @@ -103,11 +103,11 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel | Success name -> true | _ -> false let nextState = { - currentState with + currentModel.ExcelState with HasAnnotationTable = exists } - nextState,Cmd.none + currentModel.updateByExcelState nextState,Cmd.none | FillSelection (fillValue,fillTerm) -> let cmd = @@ -116,7 +116,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel (fillValue,fillTerm) (GenericLog >> Dev) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | AddAnnotationBlock (minBuildingBlockInfo) -> let cmd = @@ -131,7 +131,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | AddAnnotationBlocks (minBuildingBlockInfos, protocol, validationOpt) -> let cmd = @@ -153,16 +153,15 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel AddTableValidationtoExisting (updatedValidation, newColNames, protocolInfo) |> ExcelInterop else WriteProtocolToXml protocolInfo |> ExcelInterop - ] ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | RemoveAnnotationBlock -> let cmd = Cmd.OfPromise.either - OfficeInterop.removeAnnotationBlock + OfficeInterop.removeSelectedAnnotationBlock () (fun msg -> Msg.Batch [ @@ -172,7 +171,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | AddUnitToAnnotationBlock (format, unitTermOpt) -> let cmd = @@ -186,7 +185,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | FormatColumn (colName,format) -> let cmd = @@ -200,7 +199,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) (GenericError >> Dev) - currentState,cmd + currentModel,cmd | FormatColumns (resList) -> let cmd = @@ -214,7 +213,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) (GenericError >> Dev) - currentState,cmd + currentModel,cmd | CreateAnnotationTable (isDark) -> let cmd = @@ -225,11 +224,11 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel AnnotationtableCreated (msg) |> ExcelInterop ) (GenericError >> Dev) - currentState,cmd + currentModel,cmd | AnnotationtableCreated (range) -> let nextState = { - currentState with + currentModel.ExcelState with HasAnnotationTable = true } let msg = @@ -238,7 +237,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel UpdateProtocolGroupHeader |> ExcelInterop GenericLog ("info", range) |> Dev ] - nextState, Cmd.ofMsg msg + currentModel.updateByExcelState nextState, Cmd.ofMsg msg | GetParentTerm -> @@ -248,7 +247,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel () (StoreParentOntologyFromOfficeInterop >> TermSearch) (GenericError >> Dev) - currentState, cmd + currentModel, cmd // | GetTableValidationXml -> let cmd = @@ -258,7 +257,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel (fun (currentTableValidation, buildingBlocks,msg) -> StoreTableRepresentationFromOfficeInterop (currentTableValidation, buildingBlocks, msg) |> Validation) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | WriteTableValidationToXml (newTableValidation,currentSwateVersion) -> let cmd = Cmd.OfPromise.either @@ -272,7 +271,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | AddTableValidationtoExisting (newTableValidation, newColNames, protocolInfo) -> let cmd = @@ -283,11 +282,10 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel Msg.Batch [ GenericLog x |> Dev WriteProtocolToXml protocolInfo |> ExcelInterop - //PipeActiveAnnotationTable GetTableValidationXml |> ExcelInterop ] ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | WriteProtocolToXml protocolInfo -> let cmd = @@ -298,10 +296,11 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel Msg.Batch [ GenericLog res |> Dev UpdateProtocolGroupHeader |> ExcelInterop + if currentModel.PageState.CurrentPage = Route.SettingsProtocol then GetActiveProtocolGroupXmlParsed |> SettingsProtocolMsg ] ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | DeleteAllCustomXml -> let cmd = Cmd.OfPromise.either @@ -314,7 +313,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd | GetSwateCustomXml -> let cmd = Cmd.OfPromise.either @@ -323,11 +322,24 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel (fun xml -> Msg.Batch [ GenericLog xml |> Dev - UpdateRawCustomXml (snd xml) |> SettingXmlMsg + UpdateRawCustomXml (snd xml) |> SettingsXmlMsg ] ) (GenericError >> Dev) - currentState, cmd + currentModel, cmd + | UpdateSwateCustomXml newCustomXml -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.updateSwateCustomXml + newCustomXml + (fun x -> + Msg.Batch [ + x |> (GenericLog >> Dev) + GetSwateCustomXml |> ExcelInterop + ] + ) + (GenericError >> Dev) + currentModel, cmd // | FillHiddenColsRequest -> let cmd = @@ -342,7 +354,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) let cmd2 = UpdateFillHiddenColsState FillHiddenColsState.ExcelCheckHiddenCols |> ExcelInterop |> Cmd.ofMsg let cmds = Cmd.batch [cmd; cmd2] - currentState, cmds + currentModel, cmds | FillHiddenColumns (tableName,insertTerms) -> let cmd = @@ -362,18 +374,17 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) let cmd2 = UpdateFillHiddenColsState FillHiddenColsState.ExcelWriteFoundTerms |> ExcelInterop |> Cmd.ofMsg let cmds = Cmd.batch [cmd; cmd2] - currentState, cmds + currentModel, cmds | UpdateFillHiddenColsState newState -> let nextState = { - currentState with + currentModel.ExcelState with FillHiddenColsStateStore = newState } - nextState, Cmd.none + currentModel.updateByExcelState nextState, Cmd.none // | InsertFileNames (fileNameList) -> - let nextState = currentState let cmd = Cmd.OfPromise.either OfficeInterop.insertFileNamesFromFilePicker @@ -382,7 +393,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ("Debug",x) |> GenericLog) >> Dev ) (GenericError >> Dev) - nextState, cmd + currentModel, cmd // | GetSelectedBuildingBlockSearchTerms -> @@ -398,11 +409,19 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ] ) let cmd2 = Cmd.ofMsg (UpdateCurrentRequestState RequestBuildingBlockInfoStates.RequestExcelInformation |> BuildingBlockDetails) - currentState, Cmd.batch [cmd;cmd2] + currentModel, Cmd.batch [cmd;cmd2] + // + | CreatePointerJson -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.createPointerJson + () + (fun x -> Some x |> UpdatePointerJson |> SettingDataStewardMsg) + (GenericError >> Dev) + currentModel, cmd /// DEV | TryExcel -> - let nextState = currentState let cmd = Cmd.OfPromise.either OfficeInterop.exampleExcelFunction1 @@ -411,9 +430,8 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ("Debug",x) |> GenericLog) >> Dev ) (GenericError >> Dev) - nextState, cmd + currentModel, cmd | TryExcel2 -> - let nextState = currentState let cmd = Cmd.OfPromise.either OfficeInterop.exampleExcelFunction2 @@ -422,7 +440,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ("Debug",x) |> GenericLog) >> Dev ) (GenericError >> Dev) - nextState, cmd + currentModel, cmd //| _ -> // printfn "Hit currently non existing message" // currentState, Cmd.none @@ -913,23 +931,7 @@ let handleApiResponseMsg (resMsg: ApiResponseMsg) (currentState: ApiState) : Api match resMsg with | TermSuggestionResponse suggestions -> - //let finishedCall = { - // currentState.currentCall with - // Status = Successfull - //} - - //let nextState = { - // currentState with - // currentCall = noCall - // callHistory = finishedCall::currentState.callHistory - //} - //let cmds = Cmd.batch [ - // ("Debug",sprintf "[ApiSuccess]: Call %s successfull." finishedCall.FunctionName) |> ApiSuccess |> Api |> Cmd.ofMsg - // suggestions |> NewSuggestions |> TermSearch |> Cmd.ofMsg - //] - - //nextState, cmds handleTermSuggestionResponse (NewSuggestions >> TermSearch) suggestions @@ -1355,7 +1357,7 @@ let handleFileUploadJsonMsg (fujMsg:ProtocolInsertMsg) (currentState: ProtocolIn let nextState = {currentState with Loading = true} let cmd = Cmd.OfAsync.either - Api.api.getAllProtocols + Api.api.getAllProtocolsWithoutXml () (GetAllProtocolsResponse >> ProtocolInsert) (GenericError >> Dev) @@ -1370,7 +1372,7 @@ let handleFileUploadJsonMsg (fujMsg:ProtocolInsertMsg) (currentState: ProtocolIn | GetProtocolXmlByProtocolRequest prot -> let cmd = Cmd.OfAsync.either - Api.api.getProtocolBlocksForProtocol + Api.api.getProtocolXmlForProtocol prot (ParseProtocolXmlByProtocolRequest >> ProtocolInsert) (GenericError >> Dev) @@ -1500,19 +1502,19 @@ let handleBuildingBlockMsg (topLevelMsg:BuildingBlockDetailsMsg) (currentState: } nextState, Cmd.none -let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : SettingsXmlState * Cmd = +let handleSettingsXmlMsg (msg:SettingsXmlMsg) (currentState: SettingsXmlState) : SettingsXmlState * Cmd = let matchXmlTypeToUpdateMsg msg (xmlType:OfficeInterop.Types.Xml.XmlTypes) = match xmlType with | OfficeInterop.Types.Xml.XmlTypes.ValidationType v -> Msg.Batch [ GenericLog ("Info", msg) |> Dev - GetAllValidationXmlParsedRequest |> SettingXmlMsg + GetAllValidationXmlParsedRequest |> SettingsXmlMsg ] | OfficeInterop.Types.Xml.XmlTypes.GroupType _ | OfficeInterop.Types.Xml.XmlTypes.ProtocolType _ -> Msg.Batch [ GenericLog ("Info", msg) |> Dev - GetAllProtocolGroupXmlParsedRequest |> SettingXmlMsg + GetAllProtocolGroupXmlParsedRequest |> SettingsXmlMsg UpdateProtocolGroupHeader |> ExcelInterop ] @@ -1582,7 +1584,14 @@ let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : S | UpdateRawCustomXml rawXmlStr -> let nextState = { currentState with - RawXml = rawXmlStr + RawXml = rawXmlStr + NextRawXml = "" + } + nextState, Cmd.none + | UpdateNextRawCustomXml nextRawCustomXml -> + let nextState = { + currentState with + NextRawXml = nextRawCustomXml } nextState, Cmd.none // OfficeInterop @@ -1596,7 +1605,7 @@ let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : S Cmd.OfPromise.either OfficeInterop.getAllValidationXmlParsed () - (GetAllValidationXmlParsedResponse >> SettingXmlMsg) + (GetAllValidationXmlParsedResponse >> SettingsXmlMsg) (GenericError >> Dev) nextState, cmd | GetAllValidationXmlParsedResponse (tableValidations, annoTables) -> @@ -1620,7 +1629,7 @@ let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : S Cmd.OfPromise.either OfficeInterop.getAllProtocolGroupXmlParsed () - (GetAllProtocolGroupXmlParsedResponse >> SettingXmlMsg) + (GetAllProtocolGroupXmlParsedResponse >> SettingsXmlMsg) (GenericError >> Dev) nextState, cmd | GetAllProtocolGroupXmlParsedResponse (protocolGroupXmls, annoTables) -> @@ -1650,6 +1659,68 @@ let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : S (GenericError >> Dev) currentState, cmd +let handleSettingsDataStewardMsg (topLevelMsg:SettingsDataStewardMsg) (currentState: SettingsDataStewardState) : SettingsDataStewardState * Cmd = + match topLevelMsg with + // Client + | UpdatePointerJson nextPointerJson -> + let nextState = { + currentState with + PointerJson = nextPointerJson + } + nextState, Cmd.none + +let handleSettingsProtocolMsg (topLevelMsg:SettingsProtocolMsg) (currentState: SettingsProtocolState) : SettingsProtocolState * Cmd = + match topLevelMsg with + // Client + | UpdateProtocolsFromDB nextProtFromDB -> + let nextState = { + currentState with + ProtocolsFromDB = nextProtFromDB + } + nextState, Cmd.none + | UpdateProtocolsFromExcel nextProtFromExcel -> + let nextState = { + currentState with + ProtocolsFromExcel = nextProtFromExcel + } + nextState, Cmd.none + // Excel + | GetActiveProtocolGroupXmlParsed -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.getActiveProtocolGroupXmlParsed + () + (fun x -> + Msg.Batch [ + UpdateProtocolsFromExcel x |> SettingsProtocolMsg + GetProtocolsFromDBRequest x |> SettingsProtocolMsg + ] + ) + (GenericError >> Dev) + currentState, cmd + | UpdateProtocolByNewVersion (prot, protTemplate) -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.updateProtocolByNewVersion + (prot,protTemplate) + (AddAnnotationBlocks >> ExcelInterop) + (GenericError >> Dev) + currentState, cmd + // Server + | GetProtocolsFromDBRequest activeProtGroupOpt -> + let cmd = + match activeProtGroupOpt with + | Some protGroup -> + let protNames = protGroup.Protocols |> List.map (fun x -> x.Id) |> Array.ofList + Cmd.OfAsync.either + Api.api.getProtocolsByName + protNames + (UpdateProtocolsFromDB >> SettingsProtocolMsg) + (GenericError >> Dev) + | None -> + GenericLog ("Info", "No protocols found for active table") |> Dev |> Cmd.ofMsg + currentState, cmd + let handleTopLevelMsg (topLevelMsg:TopLevelMsg) (currentModel: Model) : Model * Cmd = match topLevelMsg with // Client @@ -1679,6 +1750,12 @@ let update (msg : Msg) (currentModel : Model) : Model * Cmd = msgSeq |> Seq.map Cmd.ofMsg ] currentModel, cmd + | UpdateWarningModal (nextModalOpt) -> + let nextModel = { + currentModel with + WarningModal = nextModalOpt + } + nextModel, Cmd.none | UpdatePageState (pageOpt:Route option) -> let nextCmd = match pageOpt with @@ -1731,14 +1808,9 @@ let update (msg : Msg) (currentModel : Model) : Model * Cmd = nextModel, debouncerCmd | ExcelInterop excelMsg -> - let nextExcelState,nextCmd = - currentModel.ExcelState + let nextModel,nextCmd = + currentModel |> handleExcelInteropMsg excelMsg - - let nextModel = { - currentModel with - ExcelState = nextExcelState - } nextModel,nextCmd | TermSearch termSearchMsg -> @@ -1864,16 +1936,36 @@ let update (msg : Msg) (currentModel : Model) : Model * Cmd = } nextModel, nextCmd - | SettingXmlMsg msg -> + | SettingsXmlMsg msg -> let nextState, nextCmd = currentModel.SettingsXmlState - |> handleSettingXmlMsg msg + |> handleSettingsXmlMsg msg let nextModel = { currentModel with SettingsXmlState = nextState } nextModel, nextCmd + | SettingDataStewardMsg msg -> + let nextState, nextCmd = + currentModel.SettingsDataStewardState + |> handleSettingsDataStewardMsg msg + let nextModel = { + currentModel with + SettingsDataStewardState = nextState + } + nextModel, nextCmd + + | SettingsProtocolMsg msg -> + let nextState, nextCmd = + currentModel.SettingsProtocolState + |> handleSettingsProtocolMsg msg + let nextModel = { + currentModel with + SettingsProtocolState = nextState + } + nextModel, nextCmd + | TopLevelMsg topLevelMsg -> let nextModel, nextCmd = handleTopLevelMsg topLevelMsg currentModel diff --git a/src/Client/Views/ActivityLogView.fs b/src/Client/Views/ActivityLogView.fs index 21a21c8d..5810ef25 100644 --- a/src/Client/Views/ActivityLogView.fs +++ b/src/Client/Views/ActivityLogView.fs @@ -32,6 +32,17 @@ let debugBox model dispatch = ] [ str "Try Excel2" ] + Button.a [ + Button.IsFullWidth + Button.OnClick (fun e -> + let msg = UpdateWarningModal None + let message = "This is a warning modal. Be careful if you know what you are doing." + let nM = {|ModalMessage = message; NextMsg = msg|} |> Some + UpdateWarningModal nM |> dispatch + ) + ][ + str "Test" + ] Label.label [][str "Dangerzone"] Container.container [ Container.Props [Style [ diff --git a/src/Client/Views/AddBuildingBlockView.fs b/src/Client/Views/AddBuildingBlockView.fs index 06c345ee..9c21a6b8 100644 --- a/src/Client/Views/AddBuildingBlockView.fs +++ b/src/Client/Views/AddBuildingBlockView.fs @@ -74,7 +74,7 @@ let createBuildingBlockDropdownItem (model:Model) (dispatch:Msg -> unit) (block: ] let addBuildingBlockFooterComponent (model:Model) (dispatch:Msg -> unit) = - Content.content [] [ + Content.content [ ] [ Label.label [Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]] [ str (sprintf "More about %s:" (model.AddBuildingBlockState.CurrentBuildingBlock.Type |> AnnotationBuildingBlockType.toString)) ] @@ -98,15 +98,17 @@ let addBuildingBlockElements (model:Model) (dispatch:Msg -> unit) = Field.HasAddons ] [ Control.div [] [ - Dropdown.dropdown [Dropdown.IsActive model.AddBuildingBlockState.ShowBuildingBlockSelection] [ + Dropdown.dropdown [ + Dropdown.IsActive model.AddBuildingBlockState.ShowBuildingBlockSelection + ] [ Dropdown.trigger [] [ Button.a [Button.OnClick (fun _ -> ToggleSelectionDropdown |> AddBuildingBlock |> dispatch)] [ span [Style [MarginRight "5px"]] [model.AddBuildingBlockState.CurrentBuildingBlock.Type |> AnnotationBuildingBlockType.toString |> str] Fa.i [Fa.Solid.AngleDown] [] ] ] - Dropdown.menu [Props[colorControl model.SiteStyleState.ColorMode]] [ - Dropdown.content [] ([ + Dropdown.menu [ ] [ + Dropdown.content [Props [colorControl model.SiteStyleState.ColorMode]] ([ Parameter Factor Characteristics @@ -220,7 +222,7 @@ let addBuildingBlockElements (model:Model) (dispatch:Msg -> unit) = | true, str -> Some str //sprintf "0.00 \"%s\"" str let unitTerm = if model.AddBuildingBlockState.UnitSelectedTerm.IsSome then Some model.AddBuildingBlockState.UnitSelectedTerm.Value.Accession else None - let minBuildingBlock = OfficeInterop.Types.BuildingBlockTypes.MinimalBuildingBlock.create colName colTerm unitName unitTerm None + let minBuildingBlock = OfficeInterop.Types.BuildingBlockTypes.MinimalBuildingBlock.create colName colTerm unitName unitTerm None false AddAnnotationBlock minBuildingBlock |> ExcelInterop |> dispatch ) ] [ @@ -290,6 +292,7 @@ let addBuildingBlockComponent (model:Model) (dispatch:Msg -> unit) = OnSubmit (fun e -> e.preventDefault()) // https://keycode.info/ OnKeyDown (fun k -> if k.key = "Enter" then k.preventDefault()) + ] [ Label.label [Label.Size Size.IsLarge; Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]][ str "Annotation building block selection"] diff --git a/src/Client/Views/BaseView.fs b/src/Client/Views/BaseView.fs index 78403181..55a22a32 100644 --- a/src/Client/Views/BaseView.fs +++ b/src/Client/Views/BaseView.fs @@ -76,6 +76,7 @@ let footerContentStatic (model:Model) dispatch = ] open Fable.Core.JsInterop +open Fable.FontAwesome /// The base react component for all views in the app. contains the navbar and takes body and footer components to create the full view. let baseViewComponent (model: Model) (dispatch: Msg -> unit) (bodyChildren: ReactElement list) (footerChildren: ReactElement list) = @@ -106,6 +107,9 @@ let baseViewComponent (model: Model) (dispatch: Msg -> unit) (bodyChildren: Reac if model.DevState.LastFullError.IsSome then CustomComponents.ErrorModal.errorModal model dispatch + if model.WarningModal.IsSome then + CustomComponents.WarningModal.warningModal model dispatch + if model.BuildingBlockDetailsState.ShowDetails then CustomComponents.BuildingBlockDetailsModal.buildingBlockDetailModal model dispatch diff --git a/src/Client/Views/FilePickerView.fs b/src/Client/Views/FilePickerView.fs index 27df5d81..d8b3b278 100644 --- a/src/Client/Views/FilePickerView.fs +++ b/src/Client/Views/FilePickerView.fs @@ -16,31 +16,6 @@ open Update open Shared open Browser.Types -//let createFileList (model:Model) (dispatch: Msg -> unit) = -// if model.FilePickerState.FileNames.Length > 0 then -// model.FilePickerState.FileNames -// |> List.map (fun fileName -> -// tr [ -// colorControl model.SiteStyleState.ColorMode -// ] [ -// td [ -// ] [ -// Delete.delete [ -// Delete.OnClick (fun _ -> fileName |> RemoveFileFromFileList |> FilePicker |> dispatch) -// ][] -// ] -// td [] [ -// b [] [str fileName] -// ] - -// ]) -// else -// [ -// tr [] [ -// td [] [str "No Files selected."] -// ] -// ] - [] let fileTileHeight = "50px" @@ -127,8 +102,6 @@ let dragAndDropClone (model:Model) dispatch id = then let clone = clone() if mustUpdateModel then - //printfn "trigger model reorder" - printfn "prev list: %A" model.FilePickerState.FileNames // Update model list let newList = [ @@ -150,14 +123,14 @@ let dragAndDropClone (model:Model) dispatch id = clone?style?opacity <- 0 //clone?style?visibility <- "hidden" clone?style?transition <- "all 0s ease 0s" - child()?style?display <- "block" + child()?style?opacity <- "1" else clone?style?opacity <- 0 //clone?style?visibility <- "hidden" clone?style?transition <- "all 0s ease 0s" - child()?style?display <- "block" - + child()?style?opacity <- "1" ) + OnDragOver(fun e -> e.preventDefault()) ][ Delete.delete [ Delete.Props [ Style [ @@ -168,7 +141,7 @@ let dragAndDropClone (model:Model) dispatch id = str (sprintf "%s" fileName) ] -let findIndByFileName (model:Model) id= +let findIndByFileName (model:Model) id = model.FilePickerState.FileNames |> List.find (fun (ind,name) -> name = id) |> fst let dragAndDropElement (model:Model) (dispatch: Msg -> unit) id = @@ -193,13 +166,13 @@ let dragAndDropElement (model:Model) (dispatch: Msg -> unit) id = OnDragStart (fun eve -> dropped <- false UpdateDNDDropped false |> FilePicker |> dispatch - + printfn "START" eve.stopPropagation() let offset = child().getBoundingClientRect() let windowScrollY = Browser.Dom.window.scrollY parent()?style?height <- "0px" - // Display none child - child()?style?display <- "none" + // display stopped working, so we use opacity now. + child()?style?opacity <- "0" let clone = clone() let x = offset.left let y = offset.top + windowScrollY - offset.height @@ -229,19 +202,20 @@ let dragAndDropElement (model:Model) (dispatch: Msg -> unit) id = eve.preventDefault() //eve.target?style?backgroundColor <- "lightgrey" //eve.target?style?borderBottom <- "5px solid darkgrey" - parent()?style?backgroundColor <- "lightgrey" + parent()?style?backgroundColor <- model.SiteStyleState.ColorMode.ControlForeground parent()?style?borderBottom <- "5px solid darkgrey" ) OnDragLeave (fun eve -> eve.preventDefault() //eve.target?style?backgroundColor <- ExcelColors.colorfullMode.BodyBackground //eve.target?style?borderBottom <- "0px solid darkgrey" - parent()?style?backgroundColor <- ExcelColors.colorfullMode.BodyBackground + parent()?style?backgroundColor <- model.SiteStyleState.ColorMode.BodyBackground parent()?style?borderBottom <- "0px solid darkgrey" ) OnDragEnd (fun eve -> // restore wrapper parent()?style?height <- fileTileHeight + printfn "END" let slideClone = if coordinates.IsNone then failwith "Unknown Drag and Drop pattern 0.2" if dropped then @@ -257,25 +231,21 @@ let dragAndDropElement (model:Model) (dispatch: Msg -> unit) id = () ) OnDrop (fun eve -> + printfn "DROPPED" //eve.stopPropagation() eve.preventDefault() dropped <- true UpdateDNDDropped true |> FilePicker |> dispatch - //eve.target?style?backgroundColor <- ExcelColors.colorfullMode.BodyBackground - //eve.target?style?borderBottom <- "0px solid darkgrey" - parent()?style?backgroundColor <- ExcelColors.colorfullMode.BodyBackground - parent()?style?borderBottom <- "0px solid darkgrey" + parent()?style?backgroundColor <- model.SiteStyleState.ColorMode.BodyBackground + parent()?style?borderBottom <- "0px solid darkgrey" let prevId = eve.dataTransfer.getData("text") let prevEle = Browser.Dom.document.getElementById(createEleId prevId) let prevWrapper = Browser.Dom.document.getElementById(createWrapperId prevId) let prevClone = Browser.Dom.document.getElementById(createCloneId prevId) - //printfn "prev id: %i" prevId - //let dragEleOrder = prevWrapper?style?order let dragEleOrder = findIndByFileName model prevId let dragDown = dragEleOrder < findIndByFileName model id //parent()?style?order let dragUp = dragEleOrder > findIndByFileName model id //parent()?style?order - //printfn "up: %b, down: %b" dragUp dragDown let droppenOnEleOrder = if dragDown then @@ -408,8 +378,7 @@ let placeOnTopElement model dispatch = Order "-1" BorderBottom "2px solid white" ] - ][ - ] + ][] let fileElementContainer (model:Model) dispatch = div [ @@ -497,8 +466,7 @@ let fileNameElements (model:Model) dispatch = let sortButton icon msg = Button.a [ - Button.IsOutlined - Button.Color IsPrimary + Button.Color IsInfo Button.OnClick msg ][ Fa.i [ Fa.Size Fa.FaLarge; icon ] [ ] @@ -507,9 +475,10 @@ let sortButton icon msg = let fileSortElements (model:Model) dispatch = div [Style [MarginBottom "1rem"; Display DisplayOptions.Flex]][ Button.a [ - Button.IsOutlined - Button.Color IsPrimary + Button.Props [Title "Copy to Clipboard"] + Button.Color IsInfo Button.OnClick (fun e -> + CustomComponents.ResponsiveFA.triggerResponsiveReturnEle "clipboard_filepicker" let txt = model.FilePickerState.FileNames |> List.map snd |> String.concat System.Environment.NewLine let textArea = Browser.Dom.document.createElement "textarea" textArea?value <- txt @@ -528,7 +497,7 @@ let fileSortElements (model:Model) dispatch = () ) ][ - Fa.i [Fa.Props [Title "Copy to Clipboard"]; Fa.Regular.Clipboard ] [] + CustomComponents.ResponsiveFA.responsiveReturnEle "clipboard_filepicker" Fa.Regular.Clipboard Fa.Solid.Check ] Button.list [ @@ -580,5 +549,4 @@ let filePickerComponent (model:Model) (dispatch:Msg -> unit) = /// COlored container element for all uploaded file names and sort elements fileContainer model dispatch inputId - ] \ No newline at end of file diff --git a/src/Client/Views/ProtocolInsertView.fs b/src/Client/Views/ProtocolInsertView.fs index ba3447de..86b2c346 100644 --- a/src/Client/Views/ProtocolInsertView.fs +++ b/src/Client/Views/ProtocolInsertView.fs @@ -98,14 +98,18 @@ let isViableISADotNetProcess (isaProcess:ISADotNet.Process) = else false, Some <| sprintf "Process contains missing values: %A" (isExistingChecks |> Collections.Array.map fst) -let paramValuePairElement (ppv:ISADotNet.ProcessParameterValue) = - Table.table [Table.IsFullWidth; Table.IsBordered][ +let paramValuePairElement (model:Model) (ppv:ISADotNet.ProcessParameterValue) = + Table.table [ + Table.IsFullWidth; + Table.IsBordered + Table.Props [Style [BackgroundColor model.SiteStyleState.ColorMode.BodyBackground; Color model.SiteStyleState.ColorMode.Text]] + ][ thead [][ tr [][ - th [Style [Width "50%"]] [ + th [Style [Width "50%"; Color model.SiteStyleState.ColorMode.Text]] [ str (annotationValueToString ppv.Category.Value.ParameterName.Value.Name.Value) ] - th [][ + th [Style [Color model.SiteStyleState.ColorMode.Text]][ str (termAccessionReduce ppv.Category.Value.ParameterName.Value.TermAccessionNumber.Value) ] ] @@ -156,7 +160,7 @@ let displayProtocolInfoElement isViable (errorMsg:string option) (model:Model) d str (sprintf " - Version %s" model.ProtocolInsertState.ProcessModel.Value.ExecutesProtocol.Value.Version.Value) ] for paramValuePair in paramValuePairs do - yield paramValuePairElement paramValuePair + yield paramValuePairElement model paramValuePair ] ] @@ -247,7 +251,6 @@ let protocolInsertElement uploadId (model:Model) dispatch = div [ Style [ BorderLeft (sprintf "5px solid %s" NFDIColors.Mint.Base) - //BorderRadius "15px 15px 0 0" Padding "0.25rem 1rem" MarginBottom "1rem" ] @@ -305,13 +308,12 @@ let addFromDBToTableButton (model:Model) dispatch = let version = p.Version let swateVersion = model.PersistentStorageState.AppVersion GroupTypes.Protocol.create id version swateVersion [] "" "" - let minBuildingBlockInfos = - model.ProtocolInsertState.BuildingBlockMinInfoList |> List.rev + let minBuildingBlockInfos = model.ProtocolInsertState.BuildingBlockMinInfoList |> List.rev /// Use x.Value |> Some to force an error if isNone. Otherwise AddAnnotationBlocks would just ignore it and it might be overlooked. let validation = model.ProtocolInsertState.ValidationXml.Value |> Some ProtocolIncreaseTimesUsed preProtocol.Id |> ProtocolInsert |> dispatch - AddAnnotationBlocks (minBuildingBlockInfos,preProtocol, validation) |> ExcelInterop |> dispatch + AddAnnotationBlocks (minBuildingBlockInfos, preProtocol, validation) |> ExcelInterop |> dispatch ) ] [ str "Insert protocol annotation blocks" @@ -344,13 +346,17 @@ let showDatabaseProtocolTemplate (model:Model) dispatch = toProtocolSearchElement model dispatch if model.ProtocolInsertState.ProtocolSelected.IsSome then - Table.table [Table.IsFullWidth; Table.IsStriped; Table.IsBordered][ + Table.table [ + Table.IsFullWidth; + Table.IsBordered + Table.Props [Style [Color model.SiteStyleState.ColorMode.Text; BackgroundColor model.SiteStyleState.ColorMode.BodyBackground]] + ][ thead [][ tr [][ - th [][str "Column"] - th [][str "Column TAN"] - th [][str "Unit"] - th [][str "Unit TAN"] + th [Style [Color model.SiteStyleState.ColorMode.Text]][str "Column"] + th [Style [Color model.SiteStyleState.ColorMode.Text]][str "Column TAN"] + th [Style [Color model.SiteStyleState.ColorMode.Text]][str "Unit"] + th [Style [Color model.SiteStyleState.ColorMode.Text]][str "Unit TAN"] ] ] tbody [][ diff --git a/src/Client/Views/ProtocolSearchView.fs b/src/Client/Views/ProtocolSearchView.fs index 547102c5..804b108f 100644 --- a/src/Client/Views/ProtocolSearchView.fs +++ b/src/Client/Views/ProtocolSearchView.fs @@ -14,7 +14,7 @@ open Model open Messages -let breadcrumbEle dispatch = +let breadcrumbEle (model:Model) dispatch = Breadcrumb.breadcrumb [Breadcrumb.HasArrowSeparator][ Breadcrumb.item [][ a [ @@ -23,8 +23,11 @@ let breadcrumbEle dispatch = str (Routing.Route.ProtocolInsert.toStringRdbl) ] ] - Breadcrumb.item [ Breadcrumb.Item.IsActive true ][ + Breadcrumb.item [ + Breadcrumb.Item.IsActive true + ][ a [ + Style [Color model.SiteStyleState.ColorMode.Text] OnClick (fun e -> UpdatePageState (Some Routing.Route.ProtocolInsert) |> dispatch) ][ str Routing.Route.ProtocolSearch.toStringRdbl @@ -62,9 +65,9 @@ let fileSortElements (model:Model) dispatch = else [||] div [ Style [MarginBottom "0.75rem"] ][ - Columns.columns [Columns.IsMobile; Columns.Props [Style [MarginBottom "0"]]] [ + Columns.columns [Columns.IsMobile; Columns.Props [Style [MarginBottom "0";]]] [ Column.column [ ] [ - Label.label [Label.Size IsSmall] [str "Search by protocol name"] + Label.label [Label.Size IsSmall; Label.Props [Style [Color model.SiteStyleState.ColorMode.Text]]] [str "Search by protocol name"] Control.div [ Control.HasIconRight ] [ @@ -80,7 +83,7 @@ let fileSortElements (model:Model) dispatch = ] Column.column [ ] [ - Label.label [Label.Size IsSmall] [str "Search for tags"] + Label.label [Label.Size IsSmall; Label.Props [Style [Color model.SiteStyleState.ColorMode.Text]]] [str "Search for tags"] Control.div [ Control.HasIconRight ] [ @@ -95,9 +98,10 @@ let fileSortElements (model:Model) dispatch = [ ] ] /// Pseudo dropdown Box.box' [Props [Style [ + yield! ExcelColors.colorControlInArray model.SiteStyleState.ColorMode Position PositionOptions.Absolute Width "100%" - Border "0.5px solid darkgrey" + //Border "0.5px solid" if hitTagList |> Array.isEmpty then Display DisplayOptions.None ]]] [ Tag.list [][ @@ -120,7 +124,7 @@ let fileSortElements (model:Model) dispatch = yield Control.div [ ] [ Tag.list [Tag.List.HasAddons][ - Tag.tag [Tag.Color IsInfo; Tag.Props [Style [Border (sprintf "0.2px solid %s" NFDIColors.LightBlue.Base) ]]] [str selectedTag] + Tag.tag [Tag.Color IsInfo; Tag.Props [Style [Border "0px"]]] [str selectedTag] Tag.delete [ Tag.CustomClass "clickableTagDelete" //Tag.Color IsWarning; @@ -146,7 +150,7 @@ let protocolElement i (sortedTable:ProtocolTemplate []) (model:Model) dispatch = if isActive then Class "nonSelectText" else - Class "nonSelectText validationTableEle" + Class "nonSelectText hoverTableEle" Style [ Cursor "pointer" UserSelect UserSelectOptions.None @@ -179,13 +183,13 @@ let protocolElement i (sortedTable:ProtocolTemplate []) (model:Model) dispatch = Style [ Padding "0" if isActive then - BorderBottom (sprintf "2px solid %s" ExcelColors.colorfullMode.Accent) + BorderBottom (sprintf "2px solid %s" model.SiteStyleState.ColorMode.Accent) if not isActive then Display DisplayOptions.None ] ColSpan 5 ] [ - Box.box' [][ + Box.box' [Props [Style [BorderRadius "0px"; yield! ExcelColors.colorControlInArray model.SiteStyleState.ColorMode]]][ Columns.columns [][ Column.column [][ Text.div [][ @@ -258,22 +262,29 @@ let protocolElementContainer (model:Model) dispatch = MarginBottom "1rem" ] ] [ + Field.div [][ + Help.help [][ + b [][str "Search for protocol templates."] + str " For more information you can look " + a [ Href @"https://github.com/nfdi4plants/SWATE_templates/wiki"; Target "_Blank" ][str "here"] + str ". If you find any problems with a protocol or have other suggestions you can contact us " + a [ Href @"https://github.com/nfdi4plants/SWATE_templates/issues/new/choose"; Target "_Blank" ] [str "here"] + str "." + ] + ] fileSortElements model dispatch Table.table [ - //Table.IsBordered Table.IsFullWidth Table.IsStriped + Table.Props [Style [BackgroundColor model.SiteStyleState.ColorMode.BodyBackground; Color model.SiteStyleState.ColorMode.Text]] ] [ thead [][ tr [][ - - ] - tr [][ - th [][ str "Protocol Name" ] - th [][ str "Documentation" ] - th [][ str "Protocol Version" ] - th [][ str "Uses" ] - th [][] + th [ Style [ Color model.SiteStyleState.ColorMode.Text] ][ str "Protocol Name" ] + th [ Style [ Color model.SiteStyleState.ColorMode.Text] ][ str "Documentation" ] + th [ Style [ Color model.SiteStyleState.ColorMode.Text] ][ str "Protocol Version" ] + th [ Style [ Color model.SiteStyleState.ColorMode.Text] ][ str "Uses" ] + th [ Style [ Color model.SiteStyleState.ColorMode.Text] ][] ] ] tbody [][ @@ -292,7 +303,7 @@ let protocolSearchViewComponent (model:Model) dispatch = // https://keycode.info/ OnKeyDown (fun k -> if k.key = "Enter" then k.preventDefault()) ] [ - breadcrumbEle dispatch + breadcrumbEle model dispatch if isEmpty && not isLoading then Help.help [Help.Color IsDanger][str "No Protocols were found. This can happen if connection to the server was lost. You can try reload this site or contact a developer."] diff --git a/src/Client/Views/SettingsDataStewardView.fs b/src/Client/Views/SettingsDataStewardView.fs new file mode 100644 index 00000000..77ad4c7b --- /dev/null +++ b/src/Client/Views/SettingsDataStewardView.fs @@ -0,0 +1,129 @@ +module SettingsDataStewardView + +open Fulma +open Fable +open Fable.React +open Fable.React.Props +open Fable.FontAwesome +//open Fable.Core.JS +open Fable.Core.JsInterop + +open Shared + +open Model +open Messages + + +let breadcrumbEle dispatch = + Breadcrumb.breadcrumb [Breadcrumb.HasArrowSeparator][ + Breadcrumb.item [][ + a [ + OnClick (fun e -> UpdatePageState (Some Routing.Route.Settings) |> dispatch) + ][ + str (Routing.Route.Settings.toStringRdbl) + ] + ] + Breadcrumb.item [ Breadcrumb.Item.IsActive true ][ + a [ + OnClick (fun e -> UpdatePageState (Some Routing.Route.SettingsDataStewards) |> dispatch) + ][ + str Routing.Route.SettingsXml.toStringRdbl + ] + ] + ] + +let createPointerJsonButton (model:Model) dispatch = + Columns.columns [Columns.IsMobile][ + Column.column [][ + Button.a [ + Button.Color IsInfo + Button.IsFullWidth + Button.OnClick (fun e -> CreatePointerJson |> ExcelInterop |> dispatch) + ][ + str "Create pointer json" + ] + ] + if model.SettingsDataStewardState.PointerJson.IsSome then + Column.column [Column.Width (Screen.All, Column.IsNarrow)][ + Button.a [ + Button.OnClick (fun e -> UpdatePointerJson None |> SettingDataStewardMsg |> dispatch) + Button.Color IsDanger + ][ + Fa.i [Fa.Solid.Times][] + ] + ] + ] + +let textFieldEle (model:Model) dispatch = + Columns.columns [Columns.IsMobile][ + Column.column [][ + Textarea.textarea [ + Textarea.Color IsSuccess + Textarea.IsReadOnly true + Textarea.Value model.SettingsDataStewardState.PointerJson.Value + ][] + ] + Column.column [Column.Width (Screen.All, Column.IsNarrow)] [ + Field.div [][ + Button.a [ + Button.Props [ + Style [Width "40.5px"] + Title "Copy to Clipboard" + ] + Button.Color IsInfo + Button.OnClick (fun e -> + CustomComponents.ResponsiveFA.triggerResponsiveReturnEle "clipboard_settingsDataSteward" + let txt = model.SettingsDataStewardState.PointerJson.Value + let textArea = Browser.Dom.document.createElement "textarea" + textArea?value <- txt + textArea?style?top <- "0" + textArea?style?left <- "0" + textArea?style?position <- "fixed" + + Browser.Dom.document.body.appendChild textArea |> ignore + + textArea.focus() + /// Can't belive this actually worked + textArea?select() + + let t = Browser.Dom.document.execCommand("copy") + Browser.Dom.document.body.removeChild(textArea) |> ignore + () + ) + ][ + CustomComponents.ResponsiveFA.responsiveReturnEle "clipboard_settingsDataSteward" Fa.Regular.Clipboard Fa.Solid.Check + ] + ] + ] + ] + +let createPointerJsonEle (model:Model) dispatch = + div [ + Style [ + BorderLeft (sprintf "5px solid %s" NFDIColors.Mint.Base) + Padding "0.25rem 1rem" + MarginBottom "1rem" + ] + ][ + Field.div [][ + createPointerJsonButton model dispatch + ] + + if model.SettingsDataStewardState.PointerJson.IsSome then + Field.div [][ + textFieldEle model dispatch + ] + ] + +let settingsDataStewardViewComponent (model:Model) dispatch = + form [ + OnSubmit (fun e -> e.preventDefault()) + // https://keycode.info/ + OnKeyDown (fun k -> if k.key = "Enter" then k.preventDefault()) + ] [ + breadcrumbEle dispatch + + Label.label [Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]] [str "Display raw custom xml."] + createPointerJsonEle model dispatch + + ] \ No newline at end of file diff --git a/src/Client/Views/SettingsProtocolView.fs b/src/Client/Views/SettingsProtocolView.fs new file mode 100644 index 00000000..513aa50e --- /dev/null +++ b/src/Client/Views/SettingsProtocolView.fs @@ -0,0 +1,159 @@ +module SettingsProtocolView + +open Fulma +open Fable +open Fable.React +open Fable.React.Props +open Fable.FontAwesome +//open Fable.Core.JS +open Fable.Core.JsInterop + +open Shared + +open Model +open Messages + +let breadcrumbEle dispatch = + Breadcrumb.breadcrumb [Breadcrumb.HasArrowSeparator][ + Breadcrumb.item [][ + a [ + OnClick (fun e -> UpdatePageState (Some Routing.Route.Settings) |> dispatch) + ][ + str (Routing.Route.Settings.toStringRdbl) + ] + ] + Breadcrumb.item [ Breadcrumb.Item.IsActive true ][ + a [ + OnClick (fun e -> UpdatePageState (Some Routing.Route.SettingsXml) |> dispatch) + ][ + str Routing.Route.SettingsProtocol.toStringRdbl + ] + ] + ] + +let getActiveProtocolButton (model:Model) dispatch = + Columns.columns [Columns.IsMobile][ + Column.column [][ + Button.a [ + Button.IsFullWidth + Button.Color IsInfo + Button.OnClick (fun e -> GetActiveProtocolGroupXmlParsed |> SettingsProtocolMsg |> dispatch) + ][ + str "Check protocols for version" + ] + ] + if model.SettingsProtocolState.ProtocolsFromDB <> [||] || model.SettingsProtocolState.ProtocolsFromExcel.IsSome then + Column.column [Column.Width(Screen.All, Column.IsNarrow)][ + Button.a [ + Button.OnClick (fun e -> + UpdateProtocolsFromDB [||] |> SettingsProtocolMsg |> dispatch + UpdateProtocolsFromExcel None |> SettingsProtocolMsg |> dispatch + ) + Button.Color IsDanger + ][ + Fa.i [Fa.Solid.Times][] + ] + ] + ] + +let splitVersion (str:string) = + let s = str.Split([|"."|], System.StringSplitOptions.RemoveEmptyEntries) + {|Major = s.[0]; Minor = s.[1]; Patch = s.[2]|} + +open OfficeInterop.Types.Xml.GroupTypes + +let applyNewestVersionButton (protocol:Protocol) (dbProtocolTemplate:Shared.ProtocolTemplate) dispatch = + Button.a [ + Button.IsStatic (protocol.ProtocolVersion = dbProtocolTemplate.Version) + Button.Size IsSmall + Button.Color IsWarning + Button.IsFullWidth + Button.OnClick (fun e -> + let msg = UpdateProtocolByNewVersion (protocol, dbProtocolTemplate) |> SettingsProtocolMsg + let messageBody = "This function has major impact on your table. Please save your progress before clicking 'Continue'." + let nM = {|ModalMessage = messageBody;NextMsg = msg|} |> Some + UpdateWarningModal nM |> dispatch + ) + ][ + str "update" + ] + +let displayVersionControlEle (model:Model) dispatch = + Table.table [Table.IsFullWidth][ + thead [][ + tr [][ + th [][str "Protocol Name"] + th [][str "Used Version"] + th [][str "Newest Version"] + th [][str "Docs"] + th [][] + ] + ] + tbody [][ + for prot in model.SettingsProtocolState.ProtocolsFromExcel.Value.Protocols do + let dbProts = model.SettingsProtocolState.ProtocolsFromDB + let relatedDBProt = dbProts |> Array.tryFind (fun x -> x.Name = prot.Id) + let color = + if relatedDBProt.IsNone then + None + else + let dbVersion = splitVersion relatedDBProt.Value.Version + let usedVersion = splitVersion prot.ProtocolVersion + if dbVersion.Major > usedVersion.Major then + Some NFDIColors.Red.Base + elif dbVersion.Minor > usedVersion.Minor then + Some "orange" + elif dbVersion.Patch > usedVersion.Patch then + Some NFDIColors.Yellow.Lighter20 + elif dbVersion = usedVersion then + Some NFDIColors.Mint.Base + else + None + let docTag() = Tag.tag [] [ a [ OnClick (fun e -> e.stopPropagation()); Href relatedDBProt.Value.DocsLink; Target "_Blank" ] [str "docs"] ] + yield + tr [][ + td [][str prot.Id] + td [ + if relatedDBProt.IsNone then + Title "Could not find protocol in DB." + elif color.IsNone then + Title "Versions could not be compared. Make sure they have the format '1.0.0'" + else + Style [Color color.Value; FontWeight "bold"] + ][ + str prot.ProtocolVersion + ] + td [][str (if relatedDBProt.IsSome then relatedDBProt.Value.Version else "-")] + td [][if relatedDBProt.IsSome then docTag() else str "-"] + td [][if relatedDBProt.IsSome && relatedDBProt.Value.Version <> prot.ProtocolVersion then applyNewestVersionButton prot relatedDBProt.Value dispatch] + ] + ] + ] + +let checkProtocolEle (model:Model) dispatch = + div [ Style [ + BorderLeft (sprintf "5px solid %s" NFDIColors.Mint.Base) + Padding "0.25rem 1rem" + MarginBottom "1rem" + ]] [ + Field.div [][ + getActiveProtocolButton model dispatch + ] + + if model.SettingsProtocolState.ProtocolsFromExcel.IsSome then + Field.div [][ + displayVersionControlEle model dispatch + ] + ] + +let settingsProtocolViewComponent (model:Model) dispatch = + form [ + OnSubmit (fun e -> e.preventDefault()) + // https://keycode.info/ + OnKeyDown (fun k -> if k.key = "Enter" then k.preventDefault()) + ] [ + breadcrumbEle dispatch + + Label.label [Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]] [str "Check protocols for newest versions."] + checkProtocolEle model dispatch + ] \ No newline at end of file diff --git a/src/Client/Views/SettingsView.fs b/src/Client/Views/SettingsView.fs index 2ed6e3ca..2ccb40df 100644 --- a/src/Client/Views/SettingsView.fs +++ b/src/Client/Views/SettingsView.fs @@ -44,16 +44,50 @@ let customXmlSettings (model:Model) dispatch = ] ] +let dataStewardsSettings (model:Model) dispatch = + Level.level [Level.Level.IsMobile][ + Level.left [][ + str "Data Stewards" + ] + Level.right [ Props [ Style [if model.SiteStyleState.IsDarkMode then Color model.SiteStyleState.ColorMode.Text else Color model.SiteStyleState.ColorMode.Fade]]] [ + Button.a [ + Button.Color IsInfo + Button.IsOutlined + Button.OnClick (fun e -> UpdatePageState (Some Routing.Route.SettingsDataStewards) |> dispatch ) + ][ + str "Advanced Settings" + ] + ] + ] + +let protocolSettings (model:Model) dispatch = + Level.level [Level.Level.IsMobile][ + Level.left [][ + str Routing.Route.SettingsProtocol.toStringRdbl + ] + Level.right [ Props [ Style [if model.SiteStyleState.IsDarkMode then Color model.SiteStyleState.ColorMode.Text else Color model.SiteStyleState.ColorMode.Fade]]] [ + Button.a [ + Button.Color IsInfo + Button.IsOutlined + Button.OnClick (fun e -> UpdatePageState (Some Routing.Route.SettingsProtocol) |> dispatch ) + ][ + str "Advanced Settings" + ] + ] + ] + let settingsViewComponent (model:Model) dispatch = div [ //Style [MaxWidth "500px"] ][ Label.label [Label.Size Size.IsLarge; Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]][ str "Swate Settings"] - Label.label [][str "Customize Swate"] + Label.label [Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]][str "Customize Swate"] toggleDarkModeElement model dispatch - Label.label [][str "Advanced Settings"] + Label.label [Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]][str "Advanced Settings"] customXmlSettings model dispatch + dataStewardsSettings model dispatch + protocolSettings model dispatch ] \ No newline at end of file diff --git a/src/Client/Views/SettingsXmlView.fs b/src/Client/Views/SettingsXmlView.fs index 892c82e9..7f7729fe 100644 --- a/src/Client/Views/SettingsXmlView.fs +++ b/src/Client/Views/SettingsXmlView.fs @@ -71,24 +71,29 @@ let showRawCustomXmlButton model dispatch = ] let textAreaEle (model:Model) dispatch = - Media.media [][ - Media.content [][ - Field.div [][ - Control.div [][ - Textarea.textarea [ - Textarea.Props [Style []] - Textarea.IsReadOnly true - Textarea.Value model.SettingsXmlState.RawXml - ][ ] - ] + Columns.columns [Columns.IsMobile][ + Column.column [][ + Control.div [][ + Textarea.textarea [ + Textarea.OnChange (fun e -> + UpdateNextRawCustomXml e.Value |> SettingsXmlMsg |> dispatch + ) + Textarea.DefaultValue model.SettingsXmlState.RawXml + ][ ] ] ] - Media.right [][ + Column.column [ + Column.Width (Screen.All,Column.IsNarrow) + ][ Field.div [][ Button.a [ - Button.Props [Title "Copy to Clipboard"] + Button.Props [ + Style [Width "40.5px"] + Title "Copy to Clipboard" + ] Button.Color IsInfo Button.OnClick (fun e -> + CustomComponents.ResponsiveFA.triggerResponsiveReturnEle "clipboard_customxmlSettings_rawXml" let txt = model.SettingsXmlState.RawXml let textArea = Browser.Dom.document.createElement "textarea" textArea?value <- txt @@ -107,7 +112,31 @@ let textAreaEle (model:Model) dispatch = () ) ][ - Fa.i [Fa.Regular.Clipboard ] [] + CustomComponents.ResponsiveFA.responsiveReturnEle "clipboard_customxmlSettings_rawXml" Fa.Regular.Clipboard Fa.Solid.Check + ] + ] + Field.div [][ + Button.a [ + Button.IsStatic (model.SettingsXmlState.NextRawXml = "") + Button.Props [ + Style [Width "40.5px"] + Title "Apply Changes" + ] + Button.Color IsWarning + Button.OnClick (fun e -> + let rmvWhiteSpace = + let xmlEle = model.SettingsXmlState.NextRawXml |> Fable.SimpleXml.SimpleXml.parseElementNonStrict + xmlEle + |> OfficeInterop.HelperFunctions.xmlElementToXmlString + let msg = ExcelInteropMsg.UpdateSwateCustomXml rmvWhiteSpace |> ExcelInterop + let modalBody = "Changes in this field could potentially invalidate your checklist and protocol xml. Please safe a copy before clicking 'Continue'." + let nM = {|ModalMessage = modalBody; NextMsg = msg|} |> Some + UpdateWarningModal nM |> dispatch + ) + ][ + Fa.i [ + Fa.Solid.Pen + ] [] ] ] ] @@ -121,25 +150,34 @@ let showRawCustomXmlEle (model:Model) dispatch = MarginBottom "1rem" ] ][ - Columns.columns [Columns.IsMobile][ - Column.column [][ - showRawCustomXmlButton model dispatch + Field.div [][ + Help.help [Help.Modifiers [Modifier.TextAlignment (Screen.All,TextAlignment.Justified)]][ + str "Here you can display all custom xml of your Swate table. This can help debug your Swate table and/or fix any problems occuring." ] - if model.SettingsXmlState.RawXml <> "" then - Column.column [Column.Width (Screen.All,Column.IsNarrow)][ - Button.a [ - Button.OnClick (fun e -> UpdateRawCustomXml "" |> SettingXmlMsg |> dispatch) - Button.Color IsDanger - Button.Props [Title "Remove custom xml from the text area"] - ][ - Fa.i [Fa.Solid.Times][] - ] - ] ] + Field.div [][ + Columns.columns [Columns.IsMobile][ + Column.column [][ + showRawCustomXmlButton model dispatch + ] + if model.SettingsXmlState.RawXml <> "" then + Column.column [Column.Width (Screen.All,Column.IsNarrow)][ + Button.a [ + Button.OnClick (fun e -> UpdateRawCustomXml "" |> SettingsXmlMsg |> dispatch) + Button.Color IsDanger + Button.Props [Title "Remove custom xml from the text area"] + ][ + Fa.i [Fa.Solid.Times][] + ] + ] + ] + ] if model.SettingsXmlState.RawXml <> "" then - textAreaEle model dispatch + Field.div [][ + textAreaEle model dispatch + ] ] @@ -155,7 +193,7 @@ let getValidationXmlButton (model:Model) dispatch = Button.Color IsInfo Button.IsFullWidth Button.OnClick (fun e -> - GetAllValidationXmlParsedRequest |> SettingXmlMsg |> dispatch + GetAllValidationXmlParsedRequest |> SettingsXmlMsg |> dispatch ) ][ str "Load checklist xml" @@ -165,7 +203,7 @@ let removeValidationXmlButton (model:Model) dispatch = Button.span [ Button.Color IsDanger Button.OnClick (fun e -> - UpdateValidationXmls [||] |> SettingXmlMsg |> dispatch + UpdateValidationXmls [||] |> SettingsXmlMsg |> dispatch ) ][ Fa.i [Fa.Solid.Times][] @@ -195,7 +233,7 @@ let applyChangesToTableValidationButton (model:Model) dispatch (tableValidation: (if newat.Name = "" then prevat.Name else newat.Name) (if newat.Worksheet = "" then prevat.Worksheet else newat.Worksheet) } - ReassignCustomXmlRequest (prevXml,newXml) |> SettingXmlMsg |> dispatch + ReassignCustomXmlRequest (prevXml,newXml) |> SettingsXmlMsg |> dispatch ) ][ text [if isNextValidForWorkbook then Style [Color "white"]] [str "Apply Changes"] @@ -205,7 +243,10 @@ let removeTableValidationButton (model:Model) dispatch (tableValidation:Validati Button.a [ Button.OnClick (fun e -> let xmlType = XmlTypes.ValidationType tableValidation - RemoveCustomXmlRequest xmlType |> SettingXmlMsg |> dispatch + let msg = RemoveCustomXmlRequest xmlType |> SettingsXmlMsg + let modalBody = "This function will remove the related checklist xml without chance of recovery. Please safe a copy before clicking 'Continue'." + let nM = {|ModalMessage = modalBody; NextMsg = msg|} |> Some + UpdateWarningModal nM |> dispatch ) Button.Color IsDanger ][ @@ -241,10 +282,10 @@ let displaySingleTableValidationEle (model:Model) dispatch (tableValidation:Vali thead [][ tr [ Style [Cursor "pointer"] - Class "validationTableEle" + Class "hoverTableEle" OnClick (fun e -> let next = if isActive then None else Some tableValidation - UpdateActiveSwateValidation next |> SettingXmlMsg |> dispatch + UpdateActiveSwateValidation next |> SettingsXmlMsg |> dispatch ) ][ th [ @@ -264,7 +305,7 @@ let displaySingleTableValidationEle (model:Model) dispatch (tableValidation:Vali { model.SettingsXmlState.NextAnnotationTableForActiveValidation.Value with Name = e.Value } else AnnotationTable.create e.Value "" |> Some - UpdateNextAnnotationTableForActiveValidation nextAnnoT |> SettingXmlMsg |> dispatch + UpdateNextAnnotationTableForActiveValidation nextAnnoT |> SettingsXmlMsg |> dispatch ) ] else @@ -286,7 +327,7 @@ let displaySingleTableValidationEle (model:Model) dispatch (tableValidation:Vali { model.SettingsXmlState.NextAnnotationTableForActiveValidation.Value with Worksheet = e.Value } else AnnotationTable.create "" e.Value |> Some - UpdateNextAnnotationTableForActiveValidation nextAnnoT |> SettingXmlMsg |> dispatch + UpdateNextAnnotationTableForActiveValidation nextAnnoT |> SettingsXmlMsg |> dispatch ) ] else @@ -346,6 +387,14 @@ let showValidationXmlEle (model:Model) dispatch = MarginBottom "1rem" ] ][ + Field.div [][ + Help.help [Help.Modifiers [Modifier.TextAlignment (Screen.All,TextAlignment.Justified)]][ + str "This block will display all checklist xml for this workbook. You can then remove single elements or assign + them to a new table-sheet combination. Should Swate find any information not related to an existing table-sheet + combination these will be marked in red." + ] + ] + Field.div [][ Columns.columns [Columns.IsMobile][ Column.column [][ @@ -377,7 +426,7 @@ let getProtocolGroupXmlButton (model:Model) dispatch = Button.Color IsInfo Button.IsFullWidth Button.OnClick (fun e -> - GetAllProtocolGroupXmlParsedRequest |> SettingXmlMsg |> dispatch + GetAllProtocolGroupXmlParsedRequest |> SettingsXmlMsg |> dispatch ) ][ str "Load protocol group xml" @@ -387,7 +436,7 @@ let removeProtocolGroupXmlButton (model:Model) dispatch = Button.span [ Button.Color IsDanger Button.OnClick (fun e -> - UpdateProtocolGroupXmls [||] |> SettingXmlMsg |> dispatch + UpdateProtocolGroupXmls [||] |> SettingsXmlMsg |> dispatch ) ][ Fa.i [Fa.Solid.Times][] @@ -408,7 +457,7 @@ let applyChangesToProtocolGroupButton (model:Model) dispatch (protGroup:GroupTyp AnnotationTable = AnnotationTable.create newName newWorksheet Protocols = protGroup.Protocols |> List.map (fun x -> {x with AnnotationTable = AnnotationTable.create newName newWorksheet}) } - ReassignCustomXmlRequest (prevXml,newXml) |> SettingXmlMsg |> dispatch + ReassignCustomXmlRequest (prevXml,newXml) |> SettingsXmlMsg |> dispatch ) ][ text [if isNextValidForWorkbook then Style [Color "white"]] [str "Apply Changes"] @@ -418,7 +467,10 @@ let removeProtocolGroupButton (model:Model) dispatch (protGroup:GroupTypes.Proto Button.a [ Button.OnClick (fun e -> let xmlType = XmlTypes.GroupType protGroup - RemoveCustomXmlRequest xmlType |> SettingXmlMsg |> dispatch + let msg = RemoveCustomXmlRequest xmlType |> SettingsXmlMsg + let modalBody = "This function will remove the related protocol xml without chance of recovery. Please safe a copy before clicking 'Continue'." + let nM = {|ModalMessage = modalBody; NextMsg = msg|} |> Some + UpdateWarningModal nM |> dispatch ) Button.Color IsDanger ][ @@ -449,7 +501,10 @@ let protocolChildList (protocol:GroupTypes.Protocol) isActive model dispatch = Button.Color IsDanger Button.OnClick (fun e -> let xml = XmlTypes.ProtocolType protocol - RemoveCustomXmlRequest xml |> SettingXmlMsg |> dispatch + let msg = RemoveCustomXmlRequest xml |> SettingsXmlMsg + let modalBody = "This function will remove the related protocol xml without chance of recovery. Please safe a copy before clicking 'Continue'." + let nM = {|ModalMessage = modalBody; NextMsg = msg|} |> Some + UpdateWarningModal nM |> dispatch ) ][ str "Remove" @@ -491,10 +546,10 @@ let displaySingleProtocolGroupEle model dispatch (protocolGroup:GroupTypes.Proto thead [][ tr [ Style [Cursor "pointer"] - Class "validationTableEle" + Class "hoverTableEle" OnClick (fun e -> let next = if isActive then None else Some protocolGroup - UpdateActiveProtocolGroup next |> SettingXmlMsg |> dispatch + UpdateActiveProtocolGroup next |> SettingsXmlMsg |> dispatch ) ][ th [ @@ -514,7 +569,7 @@ let displaySingleProtocolGroupEle model dispatch (protocolGroup:GroupTypes.Proto { model.SettingsXmlState.NextAnnotationTableForActiveProtGroup.Value with Name = e.Value } else AnnotationTable.create e.Value "" |> Some - UpdateNextAnnotationTableForActiveProtGroup nextAnnoT |> SettingXmlMsg |> dispatch + UpdateNextAnnotationTableForActiveProtGroup nextAnnoT |> SettingsXmlMsg |> dispatch ) ] else @@ -536,7 +591,7 @@ let displaySingleProtocolGroupEle model dispatch (protocolGroup:GroupTypes.Proto { model.SettingsXmlState.NextAnnotationTableForActiveProtGroup.Value with Worksheet = e.Value } else AnnotationTable.create "" e.Value |> Some - UpdateNextAnnotationTableForActiveProtGroup nextAnnoT |> SettingXmlMsg |> dispatch + UpdateNextAnnotationTableForActiveProtGroup nextAnnoT |> SettingsXmlMsg |> dispatch ) ] else @@ -567,13 +622,14 @@ let displaySingleProtocolGroupEle model dispatch (protocolGroup:GroupTypes.Proto Button.Color IsInfo Button.OnClick (fun e -> let nextProtocol = if isActiveProt then None else Some protocol - UpdateActiveProtocol nextProtocol |> SettingXmlMsg |> dispatch + UpdateActiveProtocol nextProtocol |> SettingsXmlMsg |> dispatch ) Button.IsOutlined + Button.IsFullWidth Button.Props [Style [BorderRadius "0"]] ][ Fa.i [ - Fa.Props [Style [Transition "transform 0.25s"]] + Fa.Props [Style [Transition "transform 0.4s"]] if isActiveProt then Fa.Rotate180 Fa.Solid.AngleDown ][] @@ -613,6 +669,14 @@ let showProtocolGroupXmlEle (model:Model) dispatch = MarginBottom "1rem" ] ][ + Field.div [][ + Help.help [Help.Modifiers [Modifier.TextAlignment (Screen.All,TextAlignment.Justified)]][ + str "This block will display all protocol xml for this workbook. You can then remove single elements or assign + them to a new table-sheet combination. Should Swate find any information not related to an existing table-sheet + combination these will be marked in red." + ] + ] + Field.div [][ Columns.columns [Columns.IsMobile][ Column.column [][ @@ -641,6 +705,8 @@ let settingsXmlViewComponent (model:Model) dispatch = ] [ breadcrumbEle dispatch + Help.help [][str "The functions on this page allow more or less direct manipulation of the Xml used to save additional information about your Swate table. Please use them with care."] + Label.label [Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]] [str "Display raw custom xml."] showRawCustomXmlEle model dispatch diff --git a/src/Client/Views/TermSearchView.fs b/src/Client/Views/TermSearchView.fs index d9bbc2a0..6f3e9493 100644 --- a/src/Client/Views/TermSearchView.fs +++ b/src/Client/Views/TermSearchView.fs @@ -125,6 +125,9 @@ let simpleSearchComponent (model:Model) (dispatch: Msg -> unit) = Button.Props [Title "Copy to Clipboard"] Button.Color IsInfo Button.OnClick (fun e -> + /// trigger icon response + CustomComponents.ResponsiveFA.triggerResponsiveReturnEle "clipboard_termsearch" + // let t = model.TermSearchState.SelectedTerm.Value let txt = [t.Name; t.Accession |> Shared.URLs.termAccessionUrlOfAccessionStr; t.Accession.Split(@":").[0] ] |> String.concat System.Environment.NewLine let textArea = Browser.Dom.document.createElement "textarea" @@ -144,7 +147,7 @@ let simpleSearchComponent (model:Model) (dispatch: Msg -> unit) = () ) ][ - Fa.i [Fa.Regular.Clipboard ] [] + CustomComponents.ResponsiveFA.responsiveReturnEle "clipboard_termsearch" Fa.Regular.Clipboard Fa.Solid.Check ] ] ] diff --git a/src/Client/Views/ValidationView.fs b/src/Client/Views/ValidationView.fs index 857b8308..681112a2 100644 --- a/src/Client/Views/ValidationView.fs +++ b/src/Client/Views/ValidationView.fs @@ -31,13 +31,16 @@ let columnListElement ind (columnValidation:ColumnValidation) (model:Model) disp if isActive then Class "nonSelectText" else - Class "nonSelectText validationTableEle" + Class "nonSelectText hoverTableEle" Style [ Cursor "pointer" UserSelect UserSelectOptions.None if isActive then - BackgroundColor model.SiteStyleState.ColorMode.ElementBackground + BackgroundColor NFDIColors.Mint.Darker10 + if isActive then Color "white" + else + Color model.SiteStyleState.ColorMode.Text ] OnClick (fun e -> e.preventDefault() @@ -79,25 +82,6 @@ let updateTableValidationByColValidation (model:Model) (updatedColValidation:Col let checkradioElement (id:int) (contentTypeOpt:ContentType option) (columnValidation:ColumnValidation) (model:Model) dispatch = let contentType = if contentTypeOpt.IsSome then contentTypeOpt.Value.toReadableString else "None" - /// See issue #54 - //Checkradio.radio [ - // //Checkradio.InputProps [Style [Border "1px solid red"]] - // Checkradio.Id (sprintf "checkradio%i%s" id contentType) - // Checkradio.Disabled (contentType = "Ontology [None]") - // Checkradio.Name (sprintf "ContentType%i" id) - // Checkradio.OnChange (fun e -> - // let newFormat = { - // format with - // ContentType = contentTypeOpt - // } - // UpdateValidationFormat (format,newFormat) |> Validation |> dispatch - // ) - // Checkradio.Checked (contentTypeOpt = format.ContentType) - // Checkradio.LabelProps [Class "nonSelectText"] - // Checkradio.Color IsSuccess - //][ - // str contentType - //] let isDisabled = (contentType = "Ontology [None]" || contentType = "Unit [None]") div [Style [Position PositionOptions.Relative]] [ input [ @@ -128,6 +112,81 @@ let checkradioElement (id:int) (contentTypeOpt:ContentType option) (columnValida ][] ] +let checkradioCheckssumElement (id:int) (contentTypeOpt:ContentType option) (columnValidation:ColumnValidation) (model:Model) dispatch = + let contentType = if contentTypeOpt.IsSome then contentTypeOpt.Value.toReadableString else "None" + let isDisabled = contentType = "Checksum [None]" + div [Style [Position PositionOptions.Relative]] [ + input [ + Type "checkbox"; + Class "checkbox-input" + Id (sprintf "checkradio%i%s" id contentType) + Name (sprintf "ContentType%i" id) + Disabled isDisabled + OnChange (fun e -> + let nextColumnValidation = { + columnValidation with + ValidationFormat = contentTypeOpt + } + let nextTableValidation = + updateTableValidationByColValidation model nextColumnValidation + UpdateTableValidationScheme nextTableValidation |> Validation |> dispatch + ) + Checked ( + contentTypeOpt.IsSome && columnValidation.ValidationFormat.IsSome + && match contentTypeOpt.Value with + | Checksum (_,_) -> true + | _ -> false + && match columnValidation.ValidationFormat.Value with + | Checksum (_,_) -> true + | _ -> false + + ) + + ] + label [ + Class "checkbox-label" + HtmlFor (sprintf "checkradio%i%s" id contentType) + ][str contentType] + label [ + Class "checkbox-checkmark"; + HtmlFor (sprintf "checkradio%i%s" id contentType) + ][] + Select.select [ + Select.Props [ + Style [MarginLeft "0.75rem"] + ] + Select.Size IsSmall + Select.Color (if isDisabled then IsGreyLight else IsSuccess) + ][ + select [ + Disabled isDisabled + OnChange (fun e -> + let newContentType = + match contentTypeOpt.Value with + | Checksum (checksumType,_) -> + let newVal = if e.Value = "None" then "" else e.Value + Checksum (checksumType,newVal) |> Some + | _ -> None + if newContentType.IsSome then + let nextColumnValidation = { + columnValidation with + ValidationFormat = newContentType + } + let nextTableValidation = + updateTableValidationByColValidation model nextColumnValidation + UpdateTableValidationScheme nextTableValidation |> Validation |> dispatch + else + () + ) + ][ + yield option [][str "None"] + for col in model.ValidationState.TableValidationScheme.ColumnValidations do + yield + option [ ][ str col.ColumnHeader ] + ] + ] + ] + let findOntology (columnValidation:ColumnValidation) (buildingBlocks:OfficeInterop.Types.BuildingBlockTypes.BuildingBlock []) = buildingBlocks |> Array.find (fun x -> x.MainColumn.Header.Value.Header = columnValidation.ColumnHeader) @@ -138,7 +197,10 @@ let checkradioList (ind:int) colVal model dispatch = let unitContent = if colVal.Unit.IsSome then ContentType.UnitTerm colVal.Unit.Value |> Some else ContentType.UnitTerm "None" |> Some - + + let checksumContent = + if colVal.Unit.IsSome then ContentType.Checksum (colVal.Unit.Value,"") |> Some else ContentType.Checksum ("None","") |> Some + let ontologyContent = if hasOntology.IsSome then ContentType.OntologyTerm hasOntology.Value.Name |> Some else ContentType.OntologyTerm "None" |> Some @@ -147,12 +209,13 @@ let checkradioList (ind:int) colVal model dispatch = checkradioElement ind (Some ContentType.Number) colVal model dispatch checkradioElement ind (Some ContentType.Int) colVal model dispatch - checkradioElement ind (Some ContentType.Decimal) colVal model dispatch checkradioElement ind (Some ContentType.Text) colVal model dispatch checkradioElement ind (Some ContentType.Url) colVal model dispatch checkradioElement ind ontologyContent colVal model dispatch checkradioElement ind unitContent colVal model dispatch + + checkradioCheckssumElement ind checksumContent colVal model dispatch ] @@ -191,16 +254,44 @@ let sliderElements id columnValidation model dispatch = // ] //] div [][ - for i in 1 .. 5 do + Field.div [Field.HasAddons][ + for i in 1 .. 5 do + yield + Control.div [][ + Button.a [ + Button.Color IsWarning + //Button.IsLight + Button.IsOutlined + Button.Props [Style [Padding "0rem"; BorderColor model.SiteStyleState.ColorMode.BodyForeground]] + Button.OnClick (fun e -> + let nextColumnValidation = { + columnValidation with + Importance = i |> Some + } + let nextTableValidation = + updateTableValidationByColValidation model nextColumnValidation + UpdateTableValidationScheme nextTableValidation |> Validation |> dispatch + ) + ][ + Fa.span [ + Fa.Size Fa.FaLarge + if columnValidation.Importance.IsSome && columnValidation.Importance.Value >= i then + Fa.Solid.Star + else + Fa.Regular.Star + //Fa.Props [Style [Color NFDIColors.Yellow.Base]] + ][] + ] + ] yield Button.a [ - Button.Color IsWarning - Button.Props [Style [Padding "0rem"]] - Button.IsLight + Button.Color IsDanger + Button.Props [Style [BorderColor model.SiteStyleState.ColorMode.BodyForeground]] + Button.IsOutlined Button.OnClick (fun e -> let nextColumnValidation = { columnValidation with - Importance = i |> Some + Importance = None } let nextTableValidation = updateTableValidationByColValidation model nextColumnValidation @@ -209,30 +300,9 @@ let sliderElements id columnValidation model dispatch = ][ Fa.span [ Fa.Size Fa.FaLarge - if columnValidation.Importance.IsSome && columnValidation.Importance.Value >= i then - Fa.Solid.Star - else - Fa.Regular.Star - Fa.Props [Style [Color NFDIColors.Yellow.Base]] + Fa.Solid.Backspace ][] ] - yield Button.a [ - Button.Color IsDanger - Button.IsLight - Button.OnClick (fun e -> - let nextColumnValidation = { - columnValidation with - Importance = None - } - let nextTableValidation = - updateTableValidationByColValidation model nextColumnValidation - UpdateTableValidationScheme nextTableValidation |> Validation |> dispatch - ) - ][ - Fa.span [ - Fa.Size Fa.FaLarge - Fa.Solid.Backspace - ][] ] ] @@ -275,7 +345,7 @@ let optionsElement ind (columnValidation:ColumnValidation) (model:Model) dispatc ColSpan 4 Style [ Padding "0"; - if isVisible then BorderBottom (sprintf "2px solid %s" ExcelColors.colorfullMode.Accent) + if isVisible then BorderBottom (sprintf "2px solid %s" NFDIColors.Mint.Base) ] ][ Box.box' [ @@ -283,6 +353,9 @@ let optionsElement ind (columnValidation:ColumnValidation) (model:Model) dispatc Style [ Display (if isVisible then DisplayOptions.Block else DisplayOptions.None) Width "100%" + BorderRadius "0px" + BackgroundColor model.SiteStyleState.ColorMode.BodyForeground + Color model.SiteStyleState.ColorMode.Text ] ] ][ @@ -301,8 +374,6 @@ let optionsElement ind (columnValidation:ColumnValidation) (model:Model) dispatc Help.help [][str "Define how important it is to fill in the column correctly."] sliderElements ind columnValidation model dispatch - - //submitButton ind columnValidation model dispatch ] ] ] @@ -345,13 +416,16 @@ let validationElements (model:Model) dispatch = ) ) ] - Table.table [ Table.IsHoverable; Table.IsFullWidth ] [ + Table.table [ + Table.Props [Style [BackgroundColor model.SiteStyleState.ColorMode.BodyBackground]] + Table.IsHoverable; Table.IsFullWidth + ] [ thead [ ] [ tr [ ] [ - th [ ] [ str "Column Header" ] - th [ ] [ str "Importance" ] - th [ ] [ str "Content Type" ] - th [][] + th [ Style [Color model.SiteStyleState.ColorMode.Text] ] [ str "Column Header" ] + th [ Style [Color model.SiteStyleState.ColorMode.Text] ] [ str "Importance" ] + th [ Style [Color model.SiteStyleState.ColorMode.Text] ] [ str "Content Type" ] + th [ Style [Color model.SiteStyleState.ColorMode.Text] ] [ ] ] ] tbody [ ] [ diff --git a/src/Client/style.scss b/src/Client/style.scss index 1d87b4f7..519e1518 100644 --- a/src/Client/style.scss +++ b/src/Client/style.scss @@ -81,16 +81,21 @@ a:hover { @extend .delete } +a.navbar-item:hover { + background: linear-gradient(rgba(0, 0, 0, 0.4), rgba(0, 0, 0, 0.4)) !important; +} + .delete:hover { @extend .delete; background-color: $danger } -.validationTableEle { +.hoverTableEle { } -.validationTableEle:hover { - background-color: #E8E8E8 !important +.hoverTableEle:hover { + /*background-color: #E8E8E8 !important*/ + background: linear-gradient(rgba(0, 0, 0, 0.4), rgba(0, 0, 0, 0.4)); } .clickableTag { diff --git a/src/Server/ProtocolDB.fs b/src/Server/ProtocolDB.fs index 59cf9ef0..dd2abc48 100644 --- a/src/Server/ProtocolDB.fs +++ b/src/Server/ProtocolDB.fs @@ -65,23 +65,20 @@ let getProtocolByName cString (queryStr:string) = queryParam.Value <- queryStr use reader = cmd.ExecuteReader() - [| - while reader.Read() do - let tags = reader.GetString(6).Split([|";"|], StringSplitOptions.RemoveEmptyEntries) |> Array.map (fun s -> s.Trim()) - yield - ProtocolTemplate.create - (reader.GetString(0)) // name - (reader.GetString(1)) // version - (reader.GetDateTime(2)) // created - (reader.GetString(3)) // author - (reader.GetString(4)) // description - (reader.GetString(5)) // docs link - tags - "" // customXml - "" // tableXml - (reader.GetInt32(7)) // used - (reader.GetInt32(8)) // rating - |] + reader.Read() |> ignore + let tags = reader.GetString(6).Split([|";"|], StringSplitOptions.RemoveEmptyEntries) |> Array.map (fun s -> s.Trim()) + ProtocolTemplate.create + (reader.GetString(0)) // name + (reader.GetString(1)) // version + (reader.GetDateTime(2)) // created + (reader.GetString(3)) // author + (reader.GetString(4)) // description + (reader.GetString(5)) // docs link + tags + "" // customXml + "" // tableXml + (reader.GetInt32(7)) // used + (reader.GetInt32(8)) // rating let getXmlByProtocol cString (protocol:ProtocolTemplate) = use connection = establishConnection cString diff --git a/src/Server/Server.fs b/src/Server/Server.fs index 4a6acb71..ca75e9b0 100644 --- a/src/Server/Server.fs +++ b/src/Server/Server.fs @@ -174,12 +174,18 @@ let annotatorApi cString = { return result } - getAllProtocols = fun () -> async { + getAllProtocolsWithoutXml = fun () -> async { let protocols = ProtocolDB.getAllProtocols cString return protocols } - getProtocolBlocksForProtocol = fun prot -> async { return ProtocolDB.getXmlByProtocol cString prot } + getProtocolXmlForProtocol = fun prot -> async { return ProtocolDB.getXmlByProtocol cString prot } + + getProtocolsByName = fun (names) -> async { + let protsWithoutXml = names |> Array.map (fun x -> ProtocolDB.getProtocolByName cString x) + let protsWithXml = protsWithoutXml |> Array.map (ProtocolDB.getXmlByProtocol cString) + return protsWithXml + } increaseTimesUsed = fun templateName -> async { ProtocolDB.increaseTimesUsed cString templateName diff --git a/src/Server/Version.fs b/src/Server/Version.fs index a0156cf6..00b42ad2 100644 --- a/src/Server/Version.fs +++ b/src/Server/Version.fs @@ -3,11 +3,11 @@ namespace System open System.Reflection [] -[] -[] +[] +[] do () module internal AssemblyVersionInformation = let [] AssemblyTitle = "SWATE" - let [] AssemblyVersion = "0.4.0" - let [] AssemblyMetadata_ReleaseDate = "01/03/2021" + let [] AssemblyVersion = "0.4.1" + let [] AssemblyMetadata_ReleaseDate = "08/03/2021" diff --git a/src/Shared/Shared.fs b/src/Shared/Shared.fs index dabc2b4a..caa38734 100644 --- a/src/Shared/Shared.fs +++ b/src/Shared/Shared.fs @@ -20,7 +20,7 @@ module URLs = let AnnotationPrinciplesUrl = @"https://nfdi4plants.github.io/AnnotationPrinciples/" [] - let DocsFeatureUrl = @"https://github.com/nfdi4plants/Swate#swate" + let DocsFeatureUrl = @"https://github.com/nfdi4plants/Swate/wiki" [] let DocsApiUrl = @"/api/IAnnotatorAPIv1/docs" @@ -235,9 +235,10 @@ type IAnnotatorAPIv1 = { getTermsByNames : SearchTermI [] -> Async // Protocol apis - getAllProtocols : unit -> Async - getProtocolBlocksForProtocol : ProtocolTemplate -> Async - increaseTimesUsed : string -> Async + getAllProtocolsWithoutXml : unit -> Async + getProtocolsByName : string [] -> Async + getProtocolXmlForProtocol : ProtocolTemplate -> Async + increaseTimesUsed : string -> Async } \ No newline at end of file