From 4534b8284d424138967b4100dd3e061456123897 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Tue, 2 Mar 2021 13:22:26 +0100 Subject: [PATCH 01/24] Correct routing name. --- src/Client/Routing.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Client/Routing.fs b/src/Client/Routing.fs index e840229a..27516cf8 100644 --- a/src/Client/Routing.fs +++ b/src/Client/Routing.fs @@ -55,7 +55,7 @@ type Route = | 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" From 84d71eef62c1d55bb2130143926d47e8b462fdeb Mon Sep 17 00:00:00 2001 From: Kevin F Date: Tue, 2 Mar 2021 14:15:08 +0100 Subject: [PATCH 02/24] Remove 'decimal' validation type. --- src/Client/OfficeInterop/Types.fs | 2 -- src/Client/Views/ValidationView.fs | 1 - 2 files changed, 3 deletions(-) diff --git a/src/Client/OfficeInterop/Types.fs b/src/Client/OfficeInterop/Types.fs index 2f8dd25d..74ba72e1 100644 --- a/src/Client/OfficeInterop/Types.fs +++ b/src/Client/OfficeInterop/Types.fs @@ -189,7 +189,6 @@ module Xml = | Boolean | Number | Int - | Decimal member this.toReadableString = match this with @@ -213,7 +212,6 @@ module Xml = | "Boolean" -> Boolean | "Number" -> Number | "Int" -> Int - | "Decimal" -> Decimal | _ -> failwith ( sprintf "Tried parsing '%s' to ContenType. No match found." str ) diff --git a/src/Client/Views/ValidationView.fs b/src/Client/Views/ValidationView.fs index 857b8308..caba7ce1 100644 --- a/src/Client/Views/ValidationView.fs +++ b/src/Client/Views/ValidationView.fs @@ -147,7 +147,6 @@ 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 From 088335f811d41026269e2489337986331534c4a6 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Wed, 3 Mar 2021 17:05:37 +0100 Subject: [PATCH 03/24] Add option to update raw custom xml (Issue #123). --- src/Client/Messages.fs | 12 +++--- src/Client/Model.fs | 2 + src/Client/OfficeInterop/OfficeInterop.fs | 26 ++++++++++++ src/Client/Update.fs | 17 +++++++- src/Client/Views/SettingsXmlView.fs | 50 +++++++++++++++++------ 5 files changed, 89 insertions(+), 18 deletions(-) diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index a1cce47e..a6f7713e 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 [] @@ -191,14 +192,15 @@ 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 TopLevelMsg = | CloseSuggestions diff --git a/src/Client/Model.fs b/src/Client/Model.fs index f365f315..4a684e90 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,6 +451,7 @@ type SettingsXmlState = { NextAnnotationTableForActiveProtocol = None // RawXml = "" + NextRawXml = "" FoundTables = [||] ProtocolGroupXmls = [||] ValidationXmls = [||] diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index 902bef3f..bb78ed65 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -1228,6 +1228,32 @@ 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) = updateProtocolFromXml protocol false diff --git a/src/Client/Update.fs b/src/Client/Update.fs index f5ae562d..178310e1 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -328,6 +328,14 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ) (GenericError >> Dev) currentState, cmd + | UpdateSwateCustomXml newCustomXml -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.updateSwateCustomXml + newCustomXml + (GenericLog >> Dev) + (GenericError >> Dev) + currentState, cmd // | FillHiddenColsRequest -> let cmd = @@ -1582,7 +1590,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 diff --git a/src/Client/Views/SettingsXmlView.fs b/src/Client/Views/SettingsXmlView.fs index 892c82e9..5bced714 100644 --- a/src/Client/Views/SettingsXmlView.fs +++ b/src/Client/Views/SettingsXmlView.fs @@ -71,22 +71,26 @@ 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 |> SettingXmlMsg |> 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 -> let txt = model.SettingsXmlState.RawXml @@ -110,6 +114,28 @@ let textAreaEle (model:Model) dispatch = Fa.i [Fa.Regular.Clipboard ] [] ] ] + 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 + printfn "%A" rmvWhiteSpace + ExcelInteropMsg.UpdateSwateCustomXml rmvWhiteSpace |> ExcelInterop |> dispatch + ) + ][ + Fa.i [ + Fa.Solid.Pen + ] [] + ] + ] ] ] From a3286ebcefe217bbc4354c9e19fe79004d7afb6d Mon Sep 17 00:00:00 2001 From: Kevin F Date: Thu, 4 Mar 2021 08:46:30 +0100 Subject: [PATCH 04/24] Add checksum content type (Issue #127). --- src/Client/OfficeInterop/Types.fs | 20 ++++++++++++++++++-- src/Client/Views/ValidationView.fs | 4 ++++ 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/src/Client/OfficeInterop/Types.fs b/src/Client/OfficeInterop/Types.fs index 74ba72e1..afd54624 100644 --- a/src/Client/OfficeInterop/Types.fs +++ b/src/Client/OfficeInterop/Types.fs @@ -180,10 +180,21 @@ module Xml = [] let ValidationXmlRoot = "TableValidation" + type Checksum = + | MD5 + | Sha256 + + static member ofString str = + match str with + | "MD5" -> MD5 + | "Sha256" -> Sha256 + | anyElse -> failwith (sprintf "Cannot convert '%s' into known Checksum type" anyElse) + /// 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 Checksum | Text | Url | Boolean @@ -196,6 +207,8 @@ module Xml = sprintf "Ontology [%s]" po | UnitTerm ut -> sprintf "Unit [%s]" ut + | Checksum checksum -> + sprintf "Checksum %A" checksum | _ -> string this @@ -207,6 +220,9 @@ module Xml = | unit when str.StartsWith "UnitTerm " -> let s = unit.Replace("UnitTerm ", "").Replace("\"","") UnitTerm s + | checksum when str.StartsWith "Checksum " -> + let s = checksum.Replace("Checksum ","").Replace("\"","") |> Checksum.ofString + Checksum s | "Text" -> Text | "Url" -> Url | "Boolean" -> Boolean diff --git a/src/Client/Views/ValidationView.fs b/src/Client/Views/ValidationView.fs index caba7ce1..9aa14755 100644 --- a/src/Client/Views/ValidationView.fs +++ b/src/Client/Views/ValidationView.fs @@ -150,8 +150,12 @@ let checkradioList (ind:int) colVal model dispatch = checkradioElement ind (Some ContentType.Text) colVal model dispatch checkradioElement ind (Some ContentType.Url) colVal model dispatch + checkradioElement ind (Some <| ContentType.Checksum Checksum.MD5) colVal model dispatch + checkradioElement ind (Some <| ContentType.Checksum Checksum.Sha256) colVal model dispatch + checkradioElement ind ontologyContent colVal model dispatch checkradioElement ind unitContent colVal model dispatch + ] From 97407d45c5139ded3234824f46c530e68e0556a1 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Thu, 4 Mar 2021 08:53:16 +0100 Subject: [PATCH 05/24] Changed DateTime to use UTC (Issue #126). --- src/Client/OfficeInterop/OfficeInterop.fs | 6 +++--- src/Client/OfficeInterop/Types.fs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index bb78ed65..4640f801 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -377,7 +377,7 @@ let getTableRepresentation() = "" activeWorksheet.name annotationTable - System.DateTime.Now + (System.DateTime.Now.ToUniversalTime()) [] newColumnValidations updateTableValidation @@ -1441,7 +1441,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 @@ -1509,7 +1509,7 @@ let addTableValidationToExisting (tableValidation:ValidationTypes.TableValidatio // Update DateTime let newTableValidation = { tableValidation with - DateTime = System.DateTime.Now + DateTime = System.DateTime.Now.ToUniversalTime() ColumnValidations = updateColumnValidationColNames } diff --git a/src/Client/OfficeInterop/Types.fs b/src/Client/OfficeInterop/Types.fs index afd54624..2fd457f4 100644 --- a/src/Client/OfficeInterop/Types.fs +++ b/src/Client/OfficeInterop/Types.fs @@ -274,7 +274,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 = [] } From 137cc542db62fecb52fad77177bb6de1a72c1965 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Thu, 4 Mar 2021 10:03:22 +0100 Subject: [PATCH 06/24] Add more info for existing building blocks (Issue #124). --- .../BuildingBlockDetailsModal.fs | 57 +++++++++++++++++-- 1 file changed, 51 insertions(+), 6 deletions(-) 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) ) ] ] From 66fb5771c55632c4cc0bf229996d8fa4cd304a69 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Thu, 4 Mar 2021 11:15:23 +0100 Subject: [PATCH 07/24] Add option to create pointer json template (Issue #129). --- src/Client/Client.fs | 6 + src/Client/Client.fsproj | 1 + src/Client/Messages.fs | 7 ++ src/Client/Model.fs | 38 +++--- src/Client/OfficeInterop/OfficeInterop.fs | 37 ++++++ src/Client/Routing.fs | 46 +++---- src/Client/Update.fs | 29 +++++ src/Client/Views/SettingsDataStewardView.fs | 128 ++++++++++++++++++++ src/Client/Views/SettingsView.fs | 17 +++ 9 files changed, 266 insertions(+), 43 deletions(-) create mode 100644 src/Client/Views/SettingsDataStewardView.fs diff --git a/src/Client/Client.fs b/src/Client/Client.fs index f50c3fa3..0d320b0e 100644 --- a/src/Client/Client.fs +++ b/src/Client/Client.fs @@ -114,6 +114,12 @@ 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.Info -> BaseView.baseViewComponent model dispatch [ diff --git a/src/Client/Client.fsproj b/src/Client/Client.fsproj index 84840ba0..46c281c7 100644 --- a/src/Client/Client.fsproj +++ b/src/Client/Client.fsproj @@ -47,6 +47,7 @@ + diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index a6f7713e..ba67f624 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -44,6 +44,8 @@ type ExcelInteropMsg = | InsertFileNames of fileNameList:string list // Show Details to selected BuildingBlock | GetSelectedBuildingBlockSearchTerms + // + | CreatePointerJson // Development | TryExcel | TryExcel2 @@ -202,6 +204,10 @@ type SettingXmlMsg = | ReassignCustomXmlRequest of prevXml:OfficeInterop.Types.Xml.XmlTypes * newXml:OfficeInterop.Types.Xml.XmlTypes | RemoveCustomXmlRequest of xml: OfficeInterop.Types.Xml.XmlTypes +type SettingDataStewardMsg = + // Client + | UpdatePointerJson of string option + type TopLevelMsg = | CloseSuggestions @@ -221,6 +227,7 @@ type Msg = | ProtocolInsert of ProtocolInsertMsg | BuildingBlockDetails of BuildingBlockDetailsMsg | SettingXmlMsg of SettingXmlMsg + | SettingDataStewardMsg of SettingDataStewardMsg | TopLevelMsg of TopLevelMsg | UpdatePageState of Routing.Route option | Batch of seq diff --git a/src/Client/Model.fs b/src/Client/Model.fs index 4a684e90..d98325ae 100644 --- a/src/Client/Model.fs +++ b/src/Client/Model.fs @@ -457,51 +457,60 @@ type SettingsXmlState = { ValidationXmls = [||] } +type SettingsDataStewardState = { + PointerJson : string option +} with + static member init () = { + PointerJson = None + } + type Model = { - //PageState + ///PageState PageState : PageState - //Data that needs to be persistent once loaded + ///Data that needs to be persistent once loaded PersistentStorageState : PersistentStorageState - //Debouncing + ///Debouncing DebouncerState : Debouncer.State - //Error handling, Logging, etc. + ///Error handling, Logging, etc. DevState : DevState - //Site Meta Options (Styling etc) + ///Site Meta Options (Styling etc) SiteStyleState : SiteStyleState - //States regarding term search + ///States regarding term search TermSearchState : TermSearchState AdvancedSearchState : AdvancedSearchState - //Use this in the future to model excel stuff like table data + ///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 + ///Use this to log Api calls and maybe handle them better ApiState : ApiState - //States regarding File picker functionality + ///States regarding File picker functionality FilePickerState : FilePickerState ProtocolInsertState : ProtocolInsertState - //Insert annotation columns + ///Insert annotation columns AddBuildingBlockState : AddBuildingBlockState - //Create Validation scheme for Table + ///Create Validation scheme for Table ValidationState : ValidationState - //Used to show selected building block information + ///Used to show selected building block information BuildingBlockDetailsState : BuildingBlockDetailsState - //Used to manage all xml settings - SettingsXmlState : SettingsXmlState + ///Used to manage all custom xml settings + SettingsXmlState : SettingsXmlState + ///Used to manage functions specifically for data stewards + SettingsDataStewardState : SettingsDataStewardState } let initializeModel (pageOpt: Route option) = { @@ -520,4 +529,5 @@ let initializeModel (pageOpt: Route option) = { ProtocolInsertState = ProtocolInsertState .init () BuildingBlockDetailsState = BuildingBlockDetailsState .init () SettingsXmlState = SettingsXmlState .init () + SettingsDataStewardState = SettingsDataStewardState .init () } diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index 4640f801..8586c3b8 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -1781,4 +1781,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/Routing.fs b/src/Client/Routing.fs index 27516cf8..be469633 100644 --- a/src/Client/Routing.fs +++ b/src/Client/Routing.fs @@ -18,6 +18,7 @@ type Route = | ActivityLog | Settings | SettingsXml +| SettingsDataStewards | NotFound static member toRouteUrl (route:Route) = @@ -32,24 +33,10 @@ type Route = | Route.Info -> "/#Info" | Route.ActivityLog -> "/#ActivityLog" | Route.Settings -> "/#Settings" - | Route.SettingsXml -> "/#SettingsXml" + | Route.SettingsXml -> "/#Settings/Xml" + | Route.SettingsDataStewards-> "/#Settings/DataStewards" | 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 -> "" @@ -63,9 +50,9 @@ type Route = | Route.ActivityLog -> "Activity Log" | Route.Settings -> "Settings" | Route.SettingsXml -> "Xml Settings" + | Route.SettingsDataStewards-> "Settings for Data Stewards" | Route.NotFound -> "NotFound" - static member toIcon (p: Route)= let createElem icons name = Fable.React.Standard.span [ @@ -99,18 +86,19 @@ 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.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 178310e1..68aa260f 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -407,6 +407,15 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ) let cmd2 = Cmd.ofMsg (UpdateCurrentRequestState RequestBuildingBlockInfoStates.RequestExcelInformation |> BuildingBlockDetails) currentState, Cmd.batch [cmd;cmd2] + // + | CreatePointerJson -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.createPointerJson + () + (fun x -> Some x |> UpdatePointerJson |> SettingDataStewardMsg) + (GenericError >> Dev) + currentState, cmd /// DEV | TryExcel -> @@ -1665,6 +1674,16 @@ let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : S (GenericError >> Dev) currentState, cmd +let handleSettingDataStewardMsg (topLevelMsg:SettingDataStewardMsg) (currentState: SettingsDataStewardState) : SettingsDataStewardState * Cmd = + match topLevelMsg with + // Client + | UpdatePointerJson nextPointerJson -> + let nextState = { + currentState with + PointerJson = nextPointerJson + } + nextState, Cmd.none + let handleTopLevelMsg (topLevelMsg:TopLevelMsg) (currentModel: Model) : Model * Cmd = match topLevelMsg with // Client @@ -1889,6 +1908,16 @@ let update (msg : Msg) (currentModel : Model) : Model * Cmd = } nextModel, nextCmd + | SettingDataStewardMsg msg -> + let nextState, nextCmd = + currentModel.SettingsDataStewardState + |> handleSettingDataStewardMsg msg + let nextModel = { + currentModel with + SettingsDataStewardState = nextState + } + nextModel, nextCmd + | TopLevelMsg topLevelMsg -> let nextModel, nextCmd = handleTopLevelMsg topLevelMsg currentModel diff --git a/src/Client/Views/SettingsDataStewardView.fs b/src/Client/Views/SettingsDataStewardView.fs new file mode 100644 index 00000000..215ed3fd --- /dev/null +++ b/src/Client/Views/SettingsDataStewardView.fs @@ -0,0 +1,128 @@ +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 -> + 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 + () + ) + ][ + Fa.i [Fa.Regular.Clipboard ] [] + ] + ] + ] + ] + +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 + ] + + Field.div [][ + if model.SettingsDataStewardState.PointerJson.IsSome then + 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/SettingsView.fs b/src/Client/Views/SettingsView.fs index 2ed6e3ca..4aa4cab4 100644 --- a/src/Client/Views/SettingsView.fs +++ b/src/Client/Views/SettingsView.fs @@ -44,6 +44,22 @@ 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 settingsViewComponent (model:Model) dispatch = div [ //Style [MaxWidth "500px"] @@ -56,4 +72,5 @@ let settingsViewComponent (model:Model) dispatch = Label.label [][str "Advanced Settings"] customXmlSettings model dispatch + dataStewardsSettings model dispatch ] \ No newline at end of file From f4d08e8f1f41c712ff787ce231e4c085795eef2a Mon Sep 17 00:00:00 2001 From: Kevin F Date: Fri, 5 Mar 2021 17:27:11 +0100 Subject: [PATCH 08/24] Fix protocol xml not correctly removed bug. --- src/Client/OfficeInterop/HelperFunctions.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Client/OfficeInterop/HelperFunctions.fs b/src/Client/OfficeInterop/HelperFunctions.fs index e30189cf..5d77b23c 100644 --- a/src/Client/OfficeInterop/HelperFunctions.fs +++ b/src/Client/OfficeInterop/HelperFunctions.fs @@ -847,7 +847,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 From 33695f429ac6aa76e8638b9d5b375921b3d856bd Mon Sep 17 00:00:00 2001 From: Kevin F Date: Sun, 7 Mar 2021 15:05:20 +0100 Subject: [PATCH 09/24] Fix protocol grouping bug and start with protocol update function. --- src/Client/OfficeInterop/OfficeInterop.fs | 226 +++++++++++++++++----- 1 file changed, 179 insertions(+), 47 deletions(-) diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index 8586c3b8..e71c7d58 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" ) } ) @@ -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,9 +605,7 @@ 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 -> existingProtocol.Id = protocol.Id ) let isComplete = if existsAlready.IsSome then (tryFindSpannedBuildingBlocks existsAlready.Value buildingBlocks).IsSome @@ -632,7 +617,7 @@ let addAnnotationBlocksAsProtocol (buildingBlockInfoList:MinimalBuildingBlock li let! chainProm = chainBuildingBlocks buildingBlockInfoList - let updateProtocol = {protocol with AnnotationTable = AnnotationTable.create annotationTable activeSheet.name} + let updateProtocol = {protocol with AnnotationTable = AnnotationTable.create annotationTable activeSheet.name} return (chainProm,updateProtocol) } @@ -656,7 +641,51 @@ let addAnnotationBlocksAsProtocol (buildingBlockInfoList:MinimalBuildingBlock li 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 +716,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 } ) @@ -1290,7 +1301,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) = @@ -1304,15 +1314,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 @@ -1418,7 +1429,7 @@ let updateProtocolGroupHeader () = else // REMOVE INCOMPLETE PROTOCOL - + printfn "REMOVE!" let! remove = removeProtocolFromXml protocol return sprintf "%A" remove @@ -1665,6 +1676,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 -> @@ -1695,6 +1726,107 @@ 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 bb) + |> not + ) + + let buildingBlocksToRemove = + filterBuildingBlocksForProtocol + |> Array.filter (fun x -> + minBuildingBlocksInfoDB + |> List.exists (fun minimalBB -> minimalBB = MinimalBuildingBlock.ofBuildingBlockWithoutValues x) + |> not + ) + + 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 + + return minimalBuildingBlocksToAdd, protocol, validationType + } + ) + + let removeXmlType(xmlType:XmlTypes) = Excel.run(fun context -> From 7d4060b15def48f17b64dd42d0e1da207a3285cd Mon Sep 17 00:00:00 2001 From: Kevin F Date: Sun, 7 Mar 2021 16:34:17 +0100 Subject: [PATCH 10/24] Add function to update used protocols. :sparkles: --- .assets/assets/manifest.xml | 2 +- RELEASE_NOTES.md | 12 ++ manifest.xml | 2 +- src/Client/Client.fs | 7 + src/Client/Client.fsproj | 1 + src/Client/CustomComponents/Navbar.fs | 36 ++-- src/Client/Messages.fs | 18 +- src/Client/Model.fs | 17 +- src/Client/OfficeInterop/HelperFunctions.fs | 11 ++ src/Client/OfficeInterop/OfficeInterop.fs | 61 +++++-- src/Client/OfficeInterop/Regex.fs | 2 +- src/Client/OfficeInterop/Types.fs | 30 ++- src/Client/Routing.fs | 4 + src/Client/Update.fs | 193 ++++++++++++-------- src/Client/Views/AddBuildingBlockView.fs | 2 +- src/Client/Views/ProtocolInsertView.fs | 5 +- src/Client/Views/SettingsProtocolView.fs | 152 +++++++++++++++ src/Client/Views/SettingsView.fs | 17 ++ src/Client/Views/SettingsXmlView.fs | 36 ++-- src/Server/ProtocolDB.fs | 31 ++-- src/Server/Server.fs | 10 +- src/Server/Version.fs | 8 +- src/Shared/Shared.fs | 7 +- 23 files changed, 500 insertions(+), 164 deletions(-) create mode 100644 src/Client/Views/SettingsProtocolView.fs 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/RELEASE_NOTES.md b/RELEASE_NOTES.md index b07f4f73..cf6d2dff 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,3 +1,15 @@ +### 0.4.1+66fb577 (Released 2021-3-5) +* Additions: + * latest commit #66fb577 + * [[#4534b82](https://github.com/nfdi4plants/Swate/commit/4534b8284d424138967b4100dd3e061456123897)] Correct routing name. + * [[#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). + * [[#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. + ### 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 0d320b0e..db2c1369 100644 --- a/src/Client/Client.fs +++ b/src/Client/Client.fs @@ -120,6 +120,13 @@ let view (model : Model) (dispatch : Msg -> unit) = ] [ //Text.p [] [str ""] ] + | Routing.Route.SettingsProtocol -> + BaseView.baseViewComponent model dispatch [ + SettingsProtocolView.settingsProtocolViewComponent model dispatch + ] [ + //Text.p [] [str ""] + ] + | Routing.Route.Info -> BaseView.baseViewComponent model dispatch [ diff --git a/src/Client/Client.fsproj b/src/Client/Client.fsproj index 46c281c7..96d106c0 100644 --- a/src/Client/Client.fsproj +++ b/src/Client/Client.fsproj @@ -47,6 +47,7 @@ + diff --git a/src/Client/CustomComponents/Navbar.fs b/src/Client/CustomComponents/Navbar.fs index 8660209c..448397ad 100644 --- a/src/Client/CustomComponents/Navbar.fs +++ b/src/Client/CustomComponents/Navbar.fs @@ -118,30 +118,32 @@ 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 + //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.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 +220,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 diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index ba67f624..2acddd0f 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -46,6 +46,7 @@ type ExcelInteropMsg = | GetSelectedBuildingBlockSearchTerms // | CreatePointerJson + // // Development | TryExcel | TryExcel2 @@ -180,7 +181,7 @@ type BuildingBlockDetailsMsg = | ToggleShowDetails | UpdateCurrentRequestState of RequestBuildingBlockInfoStates -type SettingXmlMsg = +type SettingsXmlMsg = // // Client // // // Validation Xml | UpdateActiveSwateValidation of OfficeInterop.Types.Xml.ValidationTypes.TableValidation option @@ -204,10 +205,18 @@ type SettingXmlMsg = | ReassignCustomXmlRequest of prevXml:OfficeInterop.Types.Xml.XmlTypes * newXml:OfficeInterop.Types.Xml.XmlTypes | RemoveCustomXmlRequest of xml: OfficeInterop.Types.Xml.XmlTypes -type SettingDataStewardMsg = +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 @@ -226,8 +235,9 @@ type Msg = | Validation of ValidationMsg | ProtocolInsert of ProtocolInsertMsg | BuildingBlockDetails of BuildingBlockDetailsMsg - | SettingXmlMsg of SettingXmlMsg - | SettingDataStewardMsg of SettingDataStewardMsg + | SettingsXmlMsg of SettingsXmlMsg + | SettingDataStewardMsg of SettingsDataStewardMsg + | SettingsProtocolMsg of SettingsProtocolMsg | TopLevelMsg of TopLevelMsg | UpdatePageState of Routing.Route option | Batch of seq diff --git a/src/Client/Model.fs b/src/Client/Model.fs index d98325ae..7d29489c 100644 --- a/src/Client/Model.fs +++ b/src/Client/Model.fs @@ -464,6 +464,15 @@ type SettingsDataStewardState = { PointerJson = None } +type SettingsProtocolState = { + ProtocolsFromExcel : OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup option + ProtocolsFromDB : Shared.ProtocolTemplate [] +} with + static member init () = { + ProtocolsFromExcel = None + ProtocolsFromDB = [||] + } + type Model = { ///PageState @@ -511,7 +520,12 @@ type Model = { ///Used to manage functions specifically for data stewards SettingsDataStewardState : SettingsDataStewardState -} + + ///Used to manage protocols + SettingsProtocolState : SettingsProtocolState +} with + member this.updateByExcelState (s:ExcelState) = + { this with ExcelState = s} let initializeModel (pageOpt: Route option) = { DebouncerState = Debouncer .create () @@ -530,4 +544,5 @@ let initializeModel (pageOpt: Route option) = { BuildingBlockDetailsState = BuildingBlockDetailsState .init () SettingsXmlState = SettingsXmlState .init () SettingsDataStewardState = SettingsDataStewardState .init () + SettingsProtocolState = SettingsProtocolState .init () } diff --git a/src/Client/OfficeInterop/HelperFunctions.fs b/src/Client/OfficeInterop/HelperFunctions.fs index 5d77b23c..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 = diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index e71c7d58..fd7710ed 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -615,11 +615,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} - return (chainProm,updateProtocol) + return (chainProm@alreadyExistingBlocks,updateProtocol) } ) @@ -629,15 +638,24 @@ 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) } @@ -1266,6 +1284,7 @@ let updateSwateCustomXml(newXmlString:String) = ) let writeProtocolToXml(protocol:GroupTypes.Protocol) = + printfn "%A" protocol updateProtocolFromXml protocol false let removeProtocolFromXml(protocol:GroupTypes.Protocol) = @@ -1493,7 +1512,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 "" @@ -1504,7 +1523,8 @@ let addTableValidationToExisting (tableValidation:ValidationTypes.TableValidatio getBaseName x, x ) |> Map.ofList - + printfn "%A" newColNameMap + printfn "%A" tableValidation //failwith (sprintf "%A" tableValidation) let updateColumnValidationColNames = @@ -1769,7 +1789,7 @@ let updateProtocolByNewVersion (prot:OfficeInterop.Types.Xml.GroupTypes.Protocol minBuildingBlocksInfoDB |> List.filter (fun minimalBB -> filterBuildingBlocksForProtocol - |> Array.exists (fun bb -> minimalBB = MinimalBuildingBlock.ofBuildingBlockWithoutValues bb) + |> Array.exists (fun bb -> minimalBB = MinimalBuildingBlock.ofBuildingBlockWithoutValues false bb) |> not ) @@ -1777,10 +1797,23 @@ let updateProtocolByNewVersion (prot:OfficeInterop.Types.Xml.GroupTypes.Protocol filterBuildingBlocksForProtocol |> Array.filter (fun x -> minBuildingBlocksInfoDB - |> List.exists (fun minimalBB -> minimalBB = MinimalBuildingBlock.ofBuildingBlockWithoutValues x) + |> 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 @@ -1822,7 +1855,11 @@ let updateProtocolByNewVersion (prot:OfficeInterop.Types.Xml.GroupTypes.Protocol let swateVersion = prot.SwateVersion GroupTypes.Protocol.create id version swateVersion [] annotationTable activeWorksheet.name - return minimalBuildingBlocksToAdd, protocol, validationType + /// 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 } ) 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 2fd457f4..36e3fdce 100644 --- a/src/Client/OfficeInterop/Types.fs +++ b/src/Client/OfficeInterop/Types.fs @@ -441,18 +441,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. @@ -472,9 +478,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 be469633..ea9fa4c7 100644 --- a/src/Client/Routing.fs +++ b/src/Client/Routing.fs @@ -19,6 +19,7 @@ type Route = | Settings | SettingsXml | SettingsDataStewards +| SettingsProtocol | NotFound static member toRouteUrl (route:Route) = @@ -35,6 +36,7 @@ type Route = | Route.Settings -> "/#Settings" | Route.SettingsXml -> "/#Settings/Xml" | Route.SettingsDataStewards-> "/#Settings/DataStewards" + | Route.SettingsProtocol -> "/#Settings/Protocol" | Route.NotFound -> "/#NotFound" member this.toStringRdbl = @@ -51,6 +53,7 @@ type Route = | 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)= @@ -97,6 +100,7 @@ module Routing = 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") ] diff --git a/src/Client/Update.fs b/src/Client/Update.fs index 68aa260f..ba2aa182 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,11 @@ 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 @@ -335,7 +334,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel newCustomXml (GenericLog >> Dev) (GenericError >> Dev) - currentState, cmd + currentModel, cmd // | FillHiddenColsRequest -> let cmd = @@ -350,7 +349,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 = @@ -370,18 +369,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 @@ -390,7 +388,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel ("Debug",x) |> GenericLog) >> Dev ) (GenericError >> Dev) - nextState, cmd + currentModel, cmd // | GetSelectedBuildingBlockSearchTerms -> @@ -406,7 +404,7 @@ 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 = @@ -415,11 +413,10 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel () (fun x -> Some x |> UpdatePointerJson |> SettingDataStewardMsg) (GenericError >> Dev) - currentState, cmd + currentModel, cmd /// DEV | TryExcel -> - let nextState = currentState let cmd = Cmd.OfPromise.either OfficeInterop.exampleExcelFunction1 @@ -428,9 +425,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 @@ -439,7 +435,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 @@ -930,23 +926,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 @@ -1372,7 +1352,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) @@ -1387,7 +1367,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) @@ -1517,19 +1497,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 ] @@ -1620,7 +1600,7 @@ let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : S Cmd.OfPromise.either OfficeInterop.getAllValidationXmlParsed () - (GetAllValidationXmlParsedResponse >> SettingXmlMsg) + (GetAllValidationXmlParsedResponse >> SettingsXmlMsg) (GenericError >> Dev) nextState, cmd | GetAllValidationXmlParsedResponse (tableValidations, annoTables) -> @@ -1644,7 +1624,7 @@ let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : S Cmd.OfPromise.either OfficeInterop.getAllProtocolGroupXmlParsed () - (GetAllProtocolGroupXmlParsedResponse >> SettingXmlMsg) + (GetAllProtocolGroupXmlParsedResponse >> SettingsXmlMsg) (GenericError >> Dev) nextState, cmd | GetAllProtocolGroupXmlParsedResponse (protocolGroupXmls, annoTables) -> @@ -1674,7 +1654,7 @@ let handleSettingXmlMsg (msg:SettingXmlMsg) (currentState: SettingsXmlState) : S (GenericError >> Dev) currentState, cmd -let handleSettingDataStewardMsg (topLevelMsg:SettingDataStewardMsg) (currentState: SettingsDataStewardState) : SettingsDataStewardState * Cmd = +let handleSettingsDataStewardMsg (topLevelMsg:SettingsDataStewardMsg) (currentState: SettingsDataStewardState) : SettingsDataStewardState * Cmd = match topLevelMsg with // Client | UpdatePointerJson nextPointerJson -> @@ -1684,6 +1664,60 @@ let handleSettingDataStewardMsg (topLevelMsg:SettingDataStewardMsg) (currentStat } 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 @@ -1765,14 +1799,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 -> @@ -1898,10 +1927,10 @@ 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 @@ -1911,13 +1940,23 @@ let update (msg : Msg) (currentModel : Model) : Model * Cmd = | SettingDataStewardMsg msg -> let nextState, nextCmd = currentModel.SettingsDataStewardState - |> handleSettingDataStewardMsg msg + |> 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/AddBuildingBlockView.fs b/src/Client/Views/AddBuildingBlockView.fs index 06c345ee..430f2523 100644 --- a/src/Client/Views/AddBuildingBlockView.fs +++ b/src/Client/Views/AddBuildingBlockView.fs @@ -220,7 +220,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 ) ] [ diff --git a/src/Client/Views/ProtocolInsertView.fs b/src/Client/Views/ProtocolInsertView.fs index ba3447de..b54a26ce 100644 --- a/src/Client/Views/ProtocolInsertView.fs +++ b/src/Client/Views/ProtocolInsertView.fs @@ -305,13 +305,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" diff --git a/src/Client/Views/SettingsProtocolView.fs b/src/Client/Views/SettingsProtocolView.fs new file mode 100644 index 00000000..843d385f --- /dev/null +++ b/src/Client/Views/SettingsProtocolView.fs @@ -0,0 +1,152 @@ +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 -> + UpdateProtocolByNewVersion (protocol, dbProtocolTemplate) |> SettingsProtocolMsg |> 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 = + 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 4aa4cab4..af886e25 100644 --- a/src/Client/Views/SettingsView.fs +++ b/src/Client/Views/SettingsView.fs @@ -60,6 +60,22 @@ let dataStewardsSettings (model:Model) dispatch = ] ] +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"] @@ -73,4 +89,5 @@ let settingsViewComponent (model:Model) dispatch = Label.label [][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 5bced714..85471f30 100644 --- a/src/Client/Views/SettingsXmlView.fs +++ b/src/Client/Views/SettingsXmlView.fs @@ -76,7 +76,7 @@ let textAreaEle (model:Model) dispatch = Control.div [][ Textarea.textarea [ Textarea.OnChange (fun e -> - UpdateNextRawCustomXml e.Value |> SettingXmlMsg |> dispatch + UpdateNextRawCustomXml e.Value |> SettingsXmlMsg |> dispatch ) Textarea.DefaultValue model.SettingsXmlState.RawXml ][ ] @@ -154,7 +154,7 @@ let showRawCustomXmlEle (model:Model) dispatch = if model.SettingsXmlState.RawXml <> "" then Column.column [Column.Width (Screen.All,Column.IsNarrow)][ Button.a [ - Button.OnClick (fun e -> UpdateRawCustomXml "" |> SettingXmlMsg |> dispatch) + Button.OnClick (fun e -> UpdateRawCustomXml "" |> SettingsXmlMsg |> dispatch) Button.Color IsDanger Button.Props [Title "Remove custom xml from the text area"] ][ @@ -181,7 +181,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" @@ -191,7 +191,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][] @@ -221,7 +221,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"] @@ -231,7 +231,7 @@ let removeTableValidationButton (model:Model) dispatch (tableValidation:Validati Button.a [ Button.OnClick (fun e -> let xmlType = XmlTypes.ValidationType tableValidation - RemoveCustomXmlRequest xmlType |> SettingXmlMsg |> dispatch + RemoveCustomXmlRequest xmlType |> SettingsXmlMsg |> dispatch ) Button.Color IsDanger ][ @@ -270,7 +270,7 @@ let displaySingleTableValidationEle (model:Model) dispatch (tableValidation:Vali Class "validationTableEle" OnClick (fun e -> let next = if isActive then None else Some tableValidation - UpdateActiveSwateValidation next |> SettingXmlMsg |> dispatch + UpdateActiveSwateValidation next |> SettingsXmlMsg |> dispatch ) ][ th [ @@ -290,7 +290,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 @@ -312,7 +312,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 @@ -403,7 +403,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" @@ -413,7 +413,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][] @@ -434,7 +434,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"] @@ -444,7 +444,7 @@ let removeProtocolGroupButton (model:Model) dispatch (protGroup:GroupTypes.Proto Button.a [ Button.OnClick (fun e -> let xmlType = XmlTypes.GroupType protGroup - RemoveCustomXmlRequest xmlType |> SettingXmlMsg |> dispatch + RemoveCustomXmlRequest xmlType |> SettingsXmlMsg |> dispatch ) Button.Color IsDanger ][ @@ -475,7 +475,7 @@ let protocolChildList (protocol:GroupTypes.Protocol) isActive model dispatch = Button.Color IsDanger Button.OnClick (fun e -> let xml = XmlTypes.ProtocolType protocol - RemoveCustomXmlRequest xml |> SettingXmlMsg |> dispatch + RemoveCustomXmlRequest xml |> SettingsXmlMsg |> dispatch ) ][ str "Remove" @@ -520,7 +520,7 @@ let displaySingleProtocolGroupEle model dispatch (protocolGroup:GroupTypes.Proto Class "validationTableEle" OnClick (fun e -> let next = if isActive then None else Some protocolGroup - UpdateActiveProtocolGroup next |> SettingXmlMsg |> dispatch + UpdateActiveProtocolGroup next |> SettingsXmlMsg |> dispatch ) ][ th [ @@ -540,7 +540,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 @@ -562,7 +562,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 @@ -593,7 +593,7 @@ 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.Props [Style [BorderRadius "0"]] 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..17982b96 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 = "05/03/2021" diff --git a/src/Shared/Shared.fs b/src/Shared/Shared.fs index dabc2b4a..e3e0a572 100644 --- a/src/Shared/Shared.fs +++ b/src/Shared/Shared.fs @@ -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 From 510331390b671e0d2e0732e775d513478af262cf Mon Sep 17 00:00:00 2001 From: Kevin F Date: Sun, 7 Mar 2021 17:10:14 +0100 Subject: [PATCH 11/24] Add warning modal function. --- src/Client/Client.fs | 23 +----- src/Client/Client.fsproj | 1 + src/Client/CustomComponents/DwnButton.fs | 1 + src/Client/CustomComponents/WarningModal.fs | 41 ++++++++++ src/Client/Messages.fs | 83 ++++++++++++++++++++- src/Client/Model.fs | 74 +----------------- src/Client/Update.fs | 15 +++- src/Client/Views/ActivityLogView.fs | 11 +++ src/Client/Views/BaseView.fs | 3 + src/Client/Views/SettingsProtocolView.fs | 33 ++++---- 10 files changed, 173 insertions(+), 112 deletions(-) create mode 100644 src/Client/CustomComponents/WarningModal.fs diff --git a/src/Client/Client.fs b/src/Client/Client.fs index db2c1369..2c9c460c 100644 --- a/src/Client/Client.fs +++ b/src/Client/Client.fs @@ -147,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 96d106c0..384b7e22 100644 --- a/src/Client/Client.fsproj +++ b/src/Client/Client.fsproj @@ -30,6 +30,7 @@ + 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/WarningModal.fs b/src/Client/CustomComponents/WarningModal.fs new file mode 100644 index 00000000..a35796fa --- /dev/null +++ b/src/Client/CustomComponents/WarningModal.fs @@ -0,0 +1,41 @@ +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 msg + ][ + str "Continue" + ] + ] + ] + ] \ No newline at end of file diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index 2acddd0f..34fa608b 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -220,7 +220,63 @@ type SettingsProtocolMsg = 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 @@ -241,4 +297,29 @@ type Msg = | 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 7d29489c..b79ac753 100644 --- a/src/Client/Model.fs +++ b/src/Client/Model.fs @@ -473,76 +473,4 @@ type SettingsProtocolState = { ProtocolsFromDB = [||] } -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 -} with - member this.updateByExcelState (s:ExcelState) = - { this with ExcelState = s} - -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 () -} +/// The main MODEL was shifted to 'Messages.fs' to allow saving 'Msg' diff --git a/src/Client/Update.fs b/src/Client/Update.fs index ba2aa182..94736fae 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -332,7 +332,12 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentModel:Model Cmd.OfPromise.either OfficeInterop.updateSwateCustomXml newCustomXml - (GenericLog >> Dev) + (fun x -> + Msg.Batch [ + x |> (GenericLog >> Dev) + GetSwateCustomXml |> ExcelInterop + ] + ) (GenericError >> Dev) currentModel, cmd // @@ -1716,8 +1721,6 @@ let handleSettingsProtocolMsg (topLevelMsg:SettingsProtocolMsg) (currentState: S 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 @@ -1747,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 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/BaseView.fs b/src/Client/Views/BaseView.fs index 78403181..deebb2be 100644 --- a/src/Client/Views/BaseView.fs +++ b/src/Client/Views/BaseView.fs @@ -106,6 +106,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/SettingsProtocolView.fs b/src/Client/Views/SettingsProtocolView.fs index 843d385f..513aa50e 100644 --- a/src/Client/Views/SettingsProtocolView.fs +++ b/src/Client/Views/SettingsProtocolView.fs @@ -69,7 +69,10 @@ let applyNewestVersionButton (protocol:Protocol) (dbProtocolTemplate:Shared.Prot Button.Color IsWarning Button.IsFullWidth Button.OnClick (fun e -> - UpdateProtocolByNewVersion (protocol, dbProtocolTemplate) |> SettingsProtocolMsg |> dispatch + 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" @@ -91,18 +94,21 @@ let displayVersionControlEle (model:Model) dispatch = let dbProts = model.SettingsProtocolState.ProtocolsFromDB let relatedDBProt = dbProts |> Array.tryFind (fun x -> x.Name = prot.Id) let color = - 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 + 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 [][ @@ -112,7 +118,8 @@ let displayVersionControlEle (model:Model) dispatch = 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"] + else + Style [Color color.Value; FontWeight "bold"] ][ str prot.ProtocolVersion ] From d97399e16d740e35067e29437912414b04764943 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Sun, 7 Mar 2021 19:58:53 +0100 Subject: [PATCH 12/24] Update links. --- src/Client/CustomComponents/Navbar.fs | 8 ++++---- src/Shared/Shared.fs | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Client/CustomComponents/Navbar.fs b/src/Client/CustomComponents/Navbar.fs index 448397ad..bf65944a 100644 --- a/src/Client/CustomComponents/Navbar.fs +++ b/src/Client/CustomComponents/Navbar.fs @@ -245,11 +245,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/Shared/Shared.fs b/src/Shared/Shared.fs index e3e0a572..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" From 44a75d12c1583e138ed2cc328146922d14752d4f Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 07:44:35 +0100 Subject: [PATCH 13/24] Apply warning to advanced setting functions. --- src/Client/CustomComponents/WarningModal.fs | 5 +- src/Client/Views/SettingsDataStewardView.fs | 6 +- src/Client/Views/SettingsXmlView.fs | 79 +++++++++++++++------ 3 files changed, 66 insertions(+), 24 deletions(-) diff --git a/src/Client/CustomComponents/WarningModal.fs b/src/Client/CustomComponents/WarningModal.fs index a35796fa..bb765618 100644 --- a/src/Client/CustomComponents/WarningModal.fs +++ b/src/Client/CustomComponents/WarningModal.fs @@ -32,7 +32,10 @@ let warningModal (model:Model) dispatch = Button.a [ Button.Color IsWarning Button.Props [Style [Float FloatOptions.Right]] - Button.OnClick msg + Button.OnClick (fun e -> + UpdateWarningModal None |> dispatch + model.WarningModal.Value.NextMsg |> dispatch + ) ][ str "Continue" ] diff --git a/src/Client/Views/SettingsDataStewardView.fs b/src/Client/Views/SettingsDataStewardView.fs index 215ed3fd..962a534b 100644 --- a/src/Client/Views/SettingsDataStewardView.fs +++ b/src/Client/Views/SettingsDataStewardView.fs @@ -108,10 +108,10 @@ let createPointerJsonEle (model:Model) dispatch = createPointerJsonButton model dispatch ] - Field.div [][ - if model.SettingsDataStewardState.PointerJson.IsSome then + if model.SettingsDataStewardState.PointerJson.IsSome then + Field.div [][ textFieldEle model dispatch - ] + ] ] let settingsDataStewardViewComponent (model:Model) dispatch = diff --git a/src/Client/Views/SettingsXmlView.fs b/src/Client/Views/SettingsXmlView.fs index 85471f30..4756cef0 100644 --- a/src/Client/Views/SettingsXmlView.fs +++ b/src/Client/Views/SettingsXmlView.fs @@ -127,8 +127,10 @@ let textAreaEle (model:Model) dispatch = let xmlEle = model.SettingsXmlState.NextRawXml |> Fable.SimpleXml.SimpleXml.parseElementNonStrict xmlEle |> OfficeInterop.HelperFunctions.xmlElementToXmlString - printfn "%A" rmvWhiteSpace - ExcelInteropMsg.UpdateSwateCustomXml rmvWhiteSpace |> ExcelInterop |> dispatch + 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 [ @@ -147,25 +149,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 "" |> SettingsXmlMsg |> 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 + ] ] @@ -231,7 +242,10 @@ let removeTableValidationButton (model:Model) dispatch (tableValidation:Validati Button.a [ Button.OnClick (fun e -> let xmlType = XmlTypes.ValidationType tableValidation - RemoveCustomXmlRequest xmlType |> SettingsXmlMsg |> 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 ][ @@ -372,6 +386,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 [][ @@ -444,7 +466,10 @@ let removeProtocolGroupButton (model:Model) dispatch (protGroup:GroupTypes.Proto Button.a [ Button.OnClick (fun e -> let xmlType = XmlTypes.GroupType protGroup - RemoveCustomXmlRequest xmlType |> SettingsXmlMsg |> 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 ][ @@ -475,7 +500,10 @@ let protocolChildList (protocol:GroupTypes.Protocol) isActive model dispatch = Button.Color IsDanger Button.OnClick (fun e -> let xml = XmlTypes.ProtocolType protocol - RemoveCustomXmlRequest xml |> SettingsXmlMsg |> 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" @@ -596,10 +624,11 @@ let displaySingleProtocolGroupEle model dispatch (protocolGroup:GroupTypes.Proto 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 ][] @@ -639,6 +668,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 [][ @@ -667,6 +704,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 From bd13cbf39f013277381b04bb9f30577d2a929f42 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 08:33:06 +0100 Subject: [PATCH 14/24] Fix drag n drop problems in filepicker. --- src/Client/CustomComponents/AdvancedSearch.fs | 29 ++++------ .../CustomComponents/AutocompleteSearch.fs | 5 -- src/Client/CustomComponents/PaginatedTable.fs | 11 +++- src/Client/Views/AddBuildingBlockView.fs | 11 ++-- src/Client/Views/FilePickerView.fs | 56 ++++--------------- 5 files changed, 39 insertions(+), 73 deletions(-) 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..5157d34a 100644 --- a/src/Client/CustomComponents/AutocompleteSearch.fs +++ b/src/Client/CustomComponents/AutocompleteSearch.fs @@ -267,9 +267,6 @@ let autocompleteTermSearchComponent match inputSize with | Some size -> Input.Size size | _ -> () - Input.Props [ - ExcelColors.colorControl colorMode - ] Input.OnChange ( fun e -> e.Value |> autocompleteParams.OnInputChangeMsg |> dispatch ) @@ -317,8 +314,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/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/Views/AddBuildingBlockView.fs b/src/Client/Views/AddBuildingBlockView.fs index 430f2523..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 @@ -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/FilePickerView.fs b/src/Client/Views/FilePickerView.fs index 27df5d81..06609333 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 @@ -242,6 +215,7 @@ let dragAndDropElement (model:Model) (dispatch: Msg -> unit) id = 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 <- ExcelColors.colorfullMode.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 [ @@ -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 From 83105b997e583514549d97a301a010c640652ec2 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 08:44:16 +0100 Subject: [PATCH 15/24] minor fix for protocol update --- src/Client/OfficeInterop/OfficeInterop.fs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index fd7710ed..ab29e4fc 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -605,7 +605,12 @@ 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 + else + false + ) let isComplete = if existsAlready.IsSome then (tryFindSpannedBuildingBlocks existsAlready.Value buildingBlocks).IsSome From 05a69b323db6325d1309b7fbd5cf5b7f4279308e Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 09:15:34 +0100 Subject: [PATCH 16/24] Increase responsiveness for copy to clipboard. --- src/Client/Client.fsproj | 1 + src/Client/CustomComponents/Navbar.fs | 13 -- src/Client/CustomComponents/ResponsiveFA.fs | 125 ++++++++++++++++++++ src/Client/Views/BaseView.fs | 1 + src/Client/Views/FilePickerView.fs | 10 +- src/Client/Views/SettingsDataStewardView.fs | 3 +- src/Client/Views/SettingsXmlView.fs | 3 +- src/Client/Views/TermSearchView.fs | 5 +- 8 files changed, 140 insertions(+), 21 deletions(-) create mode 100644 src/Client/CustomComponents/ResponsiveFA.fs diff --git a/src/Client/Client.fsproj b/src/Client/Client.fsproj index 384b7e22..02cd520b 100644 --- a/src/Client/Client.fsproj +++ b/src/Client/Client.fsproj @@ -23,6 +23,7 @@ + diff --git a/src/Client/CustomComponents/Navbar.fs b/src/Client/CustomComponents/Navbar.fs index bf65944a..23f55c73 100644 --- a/src/Client/CustomComponents/Navbar.fs +++ b/src/Client/CustomComponents/Navbar.fs @@ -120,18 +120,6 @@ 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 [ OnClick (fun e -> ToggleQuickAcessIconsShown |> StyleChange |> dispatch) @@ -143,7 +131,6 @@ let quickAccessDropdownElement model dispatch = 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 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/Views/BaseView.fs b/src/Client/Views/BaseView.fs index deebb2be..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) = diff --git a/src/Client/Views/FilePickerView.fs b/src/Client/Views/FilePickerView.fs index 06609333..a18ce54e 100644 --- a/src/Client/Views/FilePickerView.fs +++ b/src/Client/Views/FilePickerView.fs @@ -466,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 ] [ ] @@ -476,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 @@ -497,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 [ diff --git a/src/Client/Views/SettingsDataStewardView.fs b/src/Client/Views/SettingsDataStewardView.fs index 962a534b..77ad4c7b 100644 --- a/src/Client/Views/SettingsDataStewardView.fs +++ b/src/Client/Views/SettingsDataStewardView.fs @@ -72,6 +72,7 @@ let textFieldEle (model:Model) dispatch = ] 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 @@ -90,7 +91,7 @@ let textFieldEle (model:Model) dispatch = () ) ][ - Fa.i [Fa.Regular.Clipboard ] [] + CustomComponents.ResponsiveFA.responsiveReturnEle "clipboard_settingsDataSteward" Fa.Regular.Clipboard Fa.Solid.Check ] ] ] diff --git a/src/Client/Views/SettingsXmlView.fs b/src/Client/Views/SettingsXmlView.fs index 4756cef0..33529f6f 100644 --- a/src/Client/Views/SettingsXmlView.fs +++ b/src/Client/Views/SettingsXmlView.fs @@ -93,6 +93,7 @@ let textAreaEle (model:Model) dispatch = ] 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 @@ -111,7 +112,7 @@ let textAreaEle (model:Model) dispatch = () ) ][ - Fa.i [Fa.Regular.Clipboard ] [] + CustomComponents.ResponsiveFA.responsiveReturnEle "clipboard_customxmlSettings_rawXml" Fa.Regular.Clipboard Fa.Solid.Check ] ] Field.div [][ 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 ] ] ] From 96fa6b19c4196b6728eb4a1e8c6e8ad3a937649c Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 10:33:36 +0100 Subject: [PATCH 17/24] Update checksum option for checklist editor (Issue #131). --- src/Client/OfficeInterop/Types.fs | 34 ++++++---- src/Client/Views/ValidationView.fs | 103 ++++++++++++++++++++++------- 2 files changed, 100 insertions(+), 37 deletions(-) diff --git a/src/Client/OfficeInterop/Types.fs b/src/Client/OfficeInterop/Types.fs index 36e3fdce..6069964a 100644 --- a/src/Client/OfficeInterop/Types.fs +++ b/src/Client/OfficeInterop/Types.fs @@ -180,21 +180,23 @@ module Xml = [] let ValidationXmlRoot = "TableValidation" - type Checksum = - | MD5 - | Sha256 - - static member ofString str = - match str with - | "MD5" -> MD5 - | "Sha256" -> Sha256 - | anyElse -> failwith (sprintf "Cannot convert '%s' into known Checksum type" anyElse) + //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 - | Checksum of Checksum + | Checksum of string * string | Text | Url | Boolean @@ -207,8 +209,8 @@ module Xml = sprintf "Ontology [%s]" po | UnitTerm ut -> sprintf "Unit [%s]" ut - | Checksum checksum -> - sprintf "Checksum %A" checksum + | Checksum (checksum,col) -> + sprintf "Checksum [%A%s]" checksum (if col <> "" then "," + col else "") | _ -> string this @@ -221,8 +223,12 @@ module Xml = let s = unit.Replace("UnitTerm ", "").Replace("\"","") UnitTerm s | checksum when str.StartsWith "Checksum " -> - let s = checksum.Replace("Checksum ","").Replace("\"","") |> Checksum.ofString - Checksum s + 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 diff --git a/src/Client/Views/ValidationView.fs b/src/Client/Views/ValidationView.fs index 9aa14755..4b1b9694 100644 --- a/src/Client/Views/ValidationView.fs +++ b/src/Client/Views/ValidationView.fs @@ -79,25 +79,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 +109,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 +194,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 @@ -150,12 +209,10 @@ let checkradioList (ind:int) colVal model dispatch = checkradioElement ind (Some ContentType.Text) colVal model dispatch checkradioElement ind (Some ContentType.Url) colVal model dispatch - checkradioElement ind (Some <| ContentType.Checksum Checksum.MD5) colVal model dispatch - checkradioElement ind (Some <| ContentType.Checksum Checksum.Sha256) colVal model dispatch - checkradioElement ind ontologyContent colVal model dispatch checkradioElement ind unitContent colVal model dispatch + checkradioCheckssumElement ind checksumContent colVal model dispatch ] From 37503a50786536ba88a72d591e2cf51fdfd113dc Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 11:02:31 +0100 Subject: [PATCH 18/24] Enable term search without present annotation table (Issue #132). --- src/Client/OfficeInterop/OfficeInterop.fs | 107 +++++++++++----------- src/Client/Views/ValidationView.fs | 80 +++++++++------- 2 files changed, 101 insertions(+), 86 deletions(-) diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index ab29e4fc..e705038f 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -869,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 } ) diff --git a/src/Client/Views/ValidationView.fs b/src/Client/Views/ValidationView.fs index 4b1b9694..abe92fae 100644 --- a/src/Client/Views/ValidationView.fs +++ b/src/Client/Views/ValidationView.fs @@ -37,7 +37,10 @@ let columnListElement ind (columnValidation:ColumnValidation) (model:Model) disp UserSelect UserSelectOptions.None if isActive then BackgroundColor model.SiteStyleState.ColorMode.ElementBackground + if isActive then Color "white" + else + Color model.SiteStyleState.ColorMode.Text ] OnClick (fun e -> e.preventDefault() @@ -251,16 +254,42 @@ 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.Props [Style [Padding "0rem"]] + 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.Color IsDanger Button.IsLight Button.OnClick (fun e -> let nextColumnValidation = { columnValidation with - Importance = i |> Some + Importance = None } let nextTableValidation = updateTableValidationByColValidation model nextColumnValidation @@ -269,30 +298,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 - ][] ] ] @@ -335,7 +343,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" model.SiteStyleState.ColorMode.Accent) ] ][ Box.box' [ @@ -343,6 +351,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 ] ] ][ @@ -361,8 +372,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 ] ] ] @@ -405,13 +414,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 [ ] [ From ce494ad44185be1aa9f3dd4ad57d7507de379fb1 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 14:49:05 +0100 Subject: [PATCH 19/24] Improve darkmode. --- src/Client/Views/FilePickerView.fs | 6 ++-- src/Client/Views/ProtocolInsertView.fs | 29 +++++++++++-------- src/Client/Views/ProtocolSearchView.fs | 39 +++++++++++++------------- src/Client/Views/SettingsView.fs | 4 +-- src/Client/Views/ValidationView.fs | 14 +++++---- src/Client/style.scss | 3 +- 6 files changed, 53 insertions(+), 42 deletions(-) diff --git a/src/Client/Views/FilePickerView.fs b/src/Client/Views/FilePickerView.fs index a18ce54e..d8b3b278 100644 --- a/src/Client/Views/FilePickerView.fs +++ b/src/Client/Views/FilePickerView.fs @@ -202,14 +202,14 @@ 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 -> @@ -236,7 +236,7 @@ let dragAndDropElement (model:Model) (dispatch: Msg -> unit) id = eve.preventDefault() dropped <- true UpdateDNDDropped true |> FilePicker |> dispatch - parent()?style?backgroundColor <- ExcelColors.colorfullMode.BodyBackground + parent()?style?backgroundColor <- model.SiteStyleState.ColorMode.BodyBackground parent()?style?borderBottom <- "0px solid darkgrey" let prevId = eve.dataTransfer.getData("text") diff --git a/src/Client/Views/ProtocolInsertView.fs b/src/Client/Views/ProtocolInsertView.fs index b54a26ce..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" ] @@ -343,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..dfb7e943 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; @@ -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 [][ @@ -260,20 +264,17 @@ let protocolElementContainer (model:Model) dispatch = ] [ 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 +293,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/SettingsView.fs b/src/Client/Views/SettingsView.fs index af886e25..2ccb40df 100644 --- a/src/Client/Views/SettingsView.fs +++ b/src/Client/Views/SettingsView.fs @@ -82,11 +82,11 @@ let settingsViewComponent (model:Model) dispatch = ][ 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 diff --git a/src/Client/Views/ValidationView.fs b/src/Client/Views/ValidationView.fs index abe92fae..a2ac5f2c 100644 --- a/src/Client/Views/ValidationView.fs +++ b/src/Client/Views/ValidationView.fs @@ -36,7 +36,7 @@ let columnListElement ind (columnValidation:ColumnValidation) (model:Model) disp Cursor "pointer" UserSelect UserSelectOptions.None if isActive then - BackgroundColor model.SiteStyleState.ColorMode.ElementBackground + BackgroundColor NFDIColors.Mint.Darker10 if isActive then Color "white" else @@ -260,8 +260,9 @@ let sliderElements id columnValidation model dispatch = Control.div [][ Button.a [ Button.Color IsWarning - Button.IsLight - Button.Props [Style [Padding "0rem"]] + //Button.IsLight + Button.IsOutlined + Button.Props [Style [Padding "0rem"; BorderColor model.SiteStyleState.ColorMode.BodyForeground]] Button.OnClick (fun e -> let nextColumnValidation = { columnValidation with @@ -278,14 +279,15 @@ let sliderElements id columnValidation model dispatch = Fa.Solid.Star else Fa.Regular.Star - Fa.Props [Style [Color NFDIColors.Yellow.Base]] + //Fa.Props [Style [Color NFDIColors.Yellow.Base]] ][] ] ] yield Button.a [ Button.Color IsDanger - Button.IsLight + Button.Props [Style [BorderColor model.SiteStyleState.ColorMode.BodyForeground]] + Button.IsOutlined Button.OnClick (fun e -> let nextColumnValidation = { columnValidation with @@ -343,7 +345,7 @@ let optionsElement ind (columnValidation:ColumnValidation) (model:Model) dispatc ColSpan 4 Style [ Padding "0"; - if isVisible then BorderBottom (sprintf "2px solid %s" model.SiteStyleState.ColorMode.Accent) + if isVisible then BorderBottom (sprintf "2px solid %s" NFDIColors.Mint.Base) ] ][ Box.box' [ diff --git a/src/Client/style.scss b/src/Client/style.scss index 1d87b4f7..8479a03c 100644 --- a/src/Client/style.scss +++ b/src/Client/style.scss @@ -90,7 +90,8 @@ a:hover { } .validationTableEle:hover { - background-color: #E8E8E8 !important + /*background-color: #E8E8E8 !important*/ + background: linear-gradient(rgba(0, 0, 0, 0.4), rgba(0, 0, 0, 0.4)); } .clickableTag { From 6b5a56f5786eb356703438ecffcb768a6444abcb Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 14:49:05 +0100 Subject: [PATCH 20/24] Improve darkmode. --- src/Client/CustomComponents/Navbar.fs | 2 +- src/Client/Views/FilePickerView.fs | 6 ++-- src/Client/Views/ProtocolInsertView.fs | 29 +++++++++++------- src/Client/Views/ProtocolSearchView.fs | 41 +++++++++++++------------- src/Client/Views/SettingsView.fs | 4 +-- src/Client/Views/SettingsXmlView.fs | 4 +-- src/Client/Views/ValidationView.fs | 16 +++++----- src/Client/style.scss | 11 +++++-- 8 files changed, 64 insertions(+), 49 deletions(-) diff --git a/src/Client/CustomComponents/Navbar.fs b/src/Client/CustomComponents/Navbar.fs index 23f55c73..3bdeeb85 100644 --- a/src/Client/CustomComponents/Navbar.fs +++ b/src/Client/CustomComponents/Navbar.fs @@ -232,7 +232,7 @@ 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 [Href Shared.URLs.DocsFeatureUrl ; Target "_Blank"; Style [ Color model.SiteStyleState.ColorMode.Text]]] [ + 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 [Href @"https://github.com/nfdi4plants/Swate/issues/new/choose"; Target "_Blank"; Style [ Color model.SiteStyleState.ColorMode.Text]]] [ diff --git a/src/Client/Views/FilePickerView.fs b/src/Client/Views/FilePickerView.fs index a18ce54e..d8b3b278 100644 --- a/src/Client/Views/FilePickerView.fs +++ b/src/Client/Views/FilePickerView.fs @@ -202,14 +202,14 @@ 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 -> @@ -236,7 +236,7 @@ let dragAndDropElement (model:Model) (dispatch: Msg -> unit) id = eve.preventDefault() dropped <- true UpdateDNDDropped true |> FilePicker |> dispatch - parent()?style?backgroundColor <- ExcelColors.colorfullMode.BodyBackground + parent()?style?backgroundColor <- model.SiteStyleState.ColorMode.BodyBackground parent()?style?borderBottom <- "0px solid darkgrey" let prevId = eve.dataTransfer.getData("text") diff --git a/src/Client/Views/ProtocolInsertView.fs b/src/Client/Views/ProtocolInsertView.fs index b54a26ce..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" ] @@ -343,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..dcec166d 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 [][ @@ -260,20 +264,17 @@ let protocolElementContainer (model:Model) dispatch = ] [ 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 +293,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/SettingsView.fs b/src/Client/Views/SettingsView.fs index af886e25..2ccb40df 100644 --- a/src/Client/Views/SettingsView.fs +++ b/src/Client/Views/SettingsView.fs @@ -82,11 +82,11 @@ let settingsViewComponent (model:Model) dispatch = ][ 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 diff --git a/src/Client/Views/SettingsXmlView.fs b/src/Client/Views/SettingsXmlView.fs index 33529f6f..7f7729fe 100644 --- a/src/Client/Views/SettingsXmlView.fs +++ b/src/Client/Views/SettingsXmlView.fs @@ -282,7 +282,7 @@ 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 |> SettingsXmlMsg |> dispatch @@ -546,7 +546,7 @@ 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 |> SettingsXmlMsg |> dispatch diff --git a/src/Client/Views/ValidationView.fs b/src/Client/Views/ValidationView.fs index abe92fae..681112a2 100644 --- a/src/Client/Views/ValidationView.fs +++ b/src/Client/Views/ValidationView.fs @@ -31,12 +31,12 @@ 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 @@ -260,8 +260,9 @@ let sliderElements id columnValidation model dispatch = Control.div [][ Button.a [ Button.Color IsWarning - Button.IsLight - Button.Props [Style [Padding "0rem"]] + //Button.IsLight + Button.IsOutlined + Button.Props [Style [Padding "0rem"; BorderColor model.SiteStyleState.ColorMode.BodyForeground]] Button.OnClick (fun e -> let nextColumnValidation = { columnValidation with @@ -278,14 +279,15 @@ let sliderElements id columnValidation model dispatch = Fa.Solid.Star else Fa.Regular.Star - Fa.Props [Style [Color NFDIColors.Yellow.Base]] + //Fa.Props [Style [Color NFDIColors.Yellow.Base]] ][] ] ] yield Button.a [ Button.Color IsDanger - Button.IsLight + Button.Props [Style [BorderColor model.SiteStyleState.ColorMode.BodyForeground]] + Button.IsOutlined Button.OnClick (fun e -> let nextColumnValidation = { columnValidation with @@ -343,7 +345,7 @@ let optionsElement ind (columnValidation:ColumnValidation) (model:Model) dispatc ColSpan 4 Style [ Padding "0"; - if isVisible then BorderBottom (sprintf "2px solid %s" model.SiteStyleState.ColorMode.Accent) + if isVisible then BorderBottom (sprintf "2px solid %s" NFDIColors.Mint.Base) ] ][ Box.box' [ 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 { From 0d9c94558052d7f13e9707da6202e3a3f34440b9 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 16:33:34 +0100 Subject: [PATCH 21/24] Add links to template repository. --- src/Client/Views/ProtocolSearchView.fs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/Client/Views/ProtocolSearchView.fs b/src/Client/Views/ProtocolSearchView.fs index dcec166d..804b108f 100644 --- a/src/Client/Views/ProtocolSearchView.fs +++ b/src/Client/Views/ProtocolSearchView.fs @@ -262,6 +262,16 @@ 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.IsFullWidth From e44cd6e76f18ce4b307a6ec06d4b1ef30bbf2801 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 16:34:05 +0100 Subject: [PATCH 22/24] Update RELEASE_NOTES.md --- RELEASE_NOTES.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 9c3f3112..84ccd16c 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,6 +1,7 @@ -### 0.4.1+6b5a56f (Released 2021-3-8) +### 0.4.1+0d9c945 (Released 2021-3-8) * Additions: - * latest commit #6b5a56f + * latest commit #0d9c945 + * [[#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. From d75743cc4597ab9ba557ea9522e6beea091db209 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 17:22:51 +0100 Subject: [PATCH 23/24] Add minor fixes --- src/Client/CustomComponents/AutocompleteSearch.fs | 1 + src/Client/OfficeInterop/OfficeInterop.fs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Client/CustomComponents/AutocompleteSearch.fs b/src/Client/CustomComponents/AutocompleteSearch.fs index 5157d34a..c7366d3a 100644 --- a/src/Client/CustomComponents/AutocompleteSearch.fs +++ b/src/Client/CustomComponents/AutocompleteSearch.fs @@ -261,6 +261,7 @@ 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 diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index e705038f..31ac697a 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -607,7 +607,7 @@ let addAnnotationBlocksAsProtocol (buildingBlockInfoList:MinimalBuildingBlock li currentProtocolGroup.Value.Protocols |> List.tryFind ( fun existingProtocol -> if buildingBlockInfoList |> List.exists (fun x -> x.IsAlreadyExisting = true) then - existingProtocol.Id = protocol.Id + existingProtocol.Id = protocol.Id && existingProtocol.ProtocolVersion = protocol.ProtocolVersion else false ) From 2e2a46b738892232b4d3f6afad4fadd23dae277b Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 8 Mar 2021 17:23:12 +0100 Subject: [PATCH 24/24] Update RELEASE_NOTES.md --- RELEASE_NOTES.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 84ccd16c..6d006142 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,6 +1,6 @@ -### 0.4.1+0d9c945 (Released 2021-3-8) +### 0.4.1+d75743c (Released 2021-3-8) * Additions: - * latest commit #0d9c945 + * 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). @@ -15,6 +15,7 @@ * 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.