Add option to update raw custom xml (Issue #123).

nfdi4plants · Mar 3, 2021 · 088335f · 088335f
1 parent 84d71ee
commit 088335f
Show file tree

Hide file tree

Showing 5 changed files with 89 additions and 18 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
+                    ] [] 
+                ]
+            ]
         ]
     ]