From 088335f811d41026269e2489337986331534c4a6 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Wed, 3 Mar 2021 17:05:37 +0100 Subject: [PATCH] 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 + ] [] + ] + ] ] ]