Skip to content

Commit

Permalink
Add Advanced custom xml settings (Issue #111).
Browse files Browse the repository at this point in the history
  • Loading branch information
@Freymaurer
Freymaurer committed Feb 28, 2021
1 parent 6db5949 commit 4b818db
Show file tree
Hide file tree
Showing 10 changed files with 1,025 additions and 86 deletions.
20 changes: 20 additions & 0 deletions src/Client/Messages.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -176,7 +176,27 @@ type BuildingBlockDetailsMsg =
| UpdateCurrentRequestState of RequestBuildingBlockInfoStates

type SettingXmlMsg =
// // Client // //
// Validation Xml
| UpdateActiveSwateValidation of OfficeInterop.Types.Xml.ValidationTypes.TableValidation option
| UpdateNextAnnotationTableForActiveValidation of AnnotationTable option
| UpdateValidationXmls of OfficeInterop.Types.Xml.ValidationTypes.TableValidation []
// Protocol Group Xml
| UpdateProtocolGroupXmls of OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup []
| UpdateActiveProtocolGroup of OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup option
| UpdateNextAnnotationTableForActiveProtGroup of AnnotationTable option
// Protocol Xml
| UpdateActiveProtocol of OfficeInterop.Types.Xml.GroupTypes.Protocol option
| UpdateNextAnnotationTableForActiveProtocol of AnnotationTable option
//
| UpdateRawCustomXml of string
// Excel Interop
| GetAllValidationXmlParsedRequest
| 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

type TopLevelMsg =
| CloseSuggestions
Expand Down
36 changes: 28 additions & 8 deletions src/Client/Model.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -420,16 +420,36 @@ type BuildingBlockDetailsState = {
}

type SettingsXmlState = {
RawXml : string
FoundTables : Shared.AnnotationTable []
ProtocolGroupXmls : OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup []
ValidationXmls : OfficeInterop.Types.Xml.ValidationTypes.TableValidation []
// // Client // //
// Validation xml
ActiveSwateValidation : OfficeInterop.Types.Xml.ValidationTypes.TableValidation option
NextAnnotationTableForActiveValidation : AnnotationTable option
// Protocol group xml
ActiveProtocolGroup : OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup option
NextAnnotationTableForActiveProtGroup : AnnotationTable option
// Protocol
ActiveProtocol : OfficeInterop.Types.Xml.GroupTypes.Protocol option
NextAnnotationTableForActiveProtocol : AnnotationTable option
//
RawXml : string
FoundTables : Shared.AnnotationTable []
ProtocolGroupXmls : OfficeInterop.Types.Xml.GroupTypes.ProtocolGroup []
ValidationXmls : OfficeInterop.Types.Xml.ValidationTypes.TableValidation []
} with
static member init () = {
RawXml = ""
FoundTables = [||]
ProtocolGroupXmls = [||]
ValidationXmls = [||]
// Client
ActiveSwateValidation = None
NextAnnotationTableForActiveValidation = None
ActiveProtocolGroup = None
NextAnnotationTableForActiveProtGroup = None
ActiveProtocol = None
/// Unused
NextAnnotationTableForActiveProtocol = None
//
RawXml = ""
FoundTables = [||]
ProtocolGroupXmls = [||]
ValidationXmls = [||]
}

type Model = {
Expand Down
86 changes: 75 additions & 11 deletions src/Client/OfficeInterop/HelperFunctions.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -624,7 +624,7 @@ let getCustomXml (customXmlParts:CustomXmlPartCollection) (context:RequestContex
failwith "Swate could not parse Workbook Custom Xml Parts. Had neither one root nor many root elements. Please contact the developer."
if xmlParsed.Name <> "customXml" then failwith (sprintf "Swate found unexpected root xml element: %s" xmlParsed.Name)

return xmlParsed, xml
return xmlParsed
}

let getActiveTableXml (tableName:string) (worksheetName:string) (completeCustomXmlParsed:XmlElement) =
Expand All @@ -640,6 +640,15 @@ let getActiveTableXml (tableName:string) (worksheetName:string) (completeCustomX
else
None


let getAllSwateTableValidation (xmlParsed:XmlElement) =
let protocolGroups = SimpleXml.findElementsByName Xml.ValidationTypes.ValidationXmlRoot xmlParsed

protocolGroups
|> List.map (
xmlElementToXmlString >> Xml.ValidationTypes.TableValidation.ofXml
)

let getSwateValidationForCurrentTable tableName worksheetName (xmlParsed:XmlElement) =
let activeTableXml = getActiveTableXml tableName worksheetName xmlParsed
if activeTableXml.IsNone then
Expand All @@ -653,7 +662,8 @@ let getSwateValidationForCurrentTable tableName worksheetName (xmlParsed:XmlElem
let tableXmlAsString = activeTableXml.Value |> xmlElementToXmlString
Xml.ValidationTypes.TableValidation.ofXml tableXmlAsString |> Some

let updateSwateValidation (tableValidation:Xml.ValidationTypes.TableValidation) (previousCompleteCustomXml:XmlElement) =
/// Use the 'remove' parameter to remove any Swate table validation xml for the worksheet annotation table name combination in 'tableValidation'
let private updateRemoveSwateValidation (tableValidation:Xml.ValidationTypes.TableValidation) (previousCompleteCustomXml:XmlElement) (remove:bool) =

let currentTableXml = getActiveTableXml tableValidation.AnnotationTable.Name tableValidation.AnnotationTable.Worksheet previousCompleteCustomXml

Expand All @@ -664,7 +674,11 @@ let updateSwateValidation (tableValidation:Xml.ValidationTypes.TableValidation)
currentTableXml.Value.Children
|> List.filter (fun x -> x.Name <> Xml.ValidationTypes.ValidationXmlRoot )
{currentTableXml.Value with
Children = newValidationXml::filteredChildren
Children =
if remove then
filteredChildren
else
newValidationXml::filteredChildren
}
else
let initNewSwateTableXml =
Expand All @@ -686,6 +700,25 @@ let updateSwateValidation (tableValidation:Xml.ValidationTypes.TableValidation)
Children = nextTableXml::filterPrevTableFromRootChildren
}

let removeSwateValidation (tableValidation:Xml.ValidationTypes.TableValidation) (previousCompleteCustomXml:XmlElement) =
updateRemoveSwateValidation tableValidation previousCompleteCustomXml true

let updateSwateValidation (tableValidation:Xml.ValidationTypes.TableValidation) (previousCompleteCustomXml:XmlElement) =
updateRemoveSwateValidation tableValidation previousCompleteCustomXml false

let replaceValidationByValidation tableVal1 tableVal2 previousCompleteCustomXml =
let removeTableVal1 = removeSwateValidation tableVal1 previousCompleteCustomXml
let addTableVal2 = updateSwateValidation tableVal2 removeTableVal1
addTableVal2

let getAllSwateProtocolGroups (xmlParsed:XmlElement) =
let protocolGroups = SimpleXml.findElementsByName Xml.GroupTypes.ProtocolGroupXmlRoot xmlParsed

protocolGroups
|> List.map (
xmlElementToXmlString >> Xml.GroupTypes.ProtocolGroup.ofXml
)

let getSwateProtocolGroupForCurrentTable tableName worksheetName (xmlParsed:XmlElement) =
let activeTableXml = getActiveTableXml tableName worksheetName xmlParsed
if activeTableXml.IsNone then
Expand All @@ -699,7 +732,8 @@ let getSwateProtocolGroupForCurrentTable tableName worksheetName (xmlParsed:XmlE
let tableXmlAsString = activeTableXml.Value |> xmlElementToXmlString
Xml.GroupTypes.ProtocolGroup.ofXml tableXmlAsString |> Some

let updateSwateProtocolGroup (protocolGroup:Xml.GroupTypes.ProtocolGroup) (previousCompleteCustomXml:XmlElement) =
/// 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) =

let currentTableXml = getActiveTableXml protocolGroup.AnnotationTable.Name protocolGroup.AnnotationTable.Worksheet previousCompleteCustomXml

Expand All @@ -710,7 +744,11 @@ let updateSwateProtocolGroup (protocolGroup:Xml.GroupTypes.ProtocolGroup) (previ
currentTableXml.Value.Children
|> List.filter (fun x -> x.Name <> Xml.GroupTypes.ProtocolGroupXmlRoot )
{currentTableXml.Value with
Children = newProtocolGroupXml::filteredChildren
Children =
if remove then
filteredChildren
else
newProtocolGroupXml::filteredChildren
}
else
let initNewSwateTableXml =
Expand All @@ -732,12 +770,24 @@ let updateSwateProtocolGroup (protocolGroup:Xml.GroupTypes.ProtocolGroup) (previ
Children = nextTableXml::filterPrevTableFromRootChildren
}

let updateSwateProtocolGroupByProtocol tableName worksheetName (protocol:Xml.GroupTypes.Protocol) (previousCompleteCustomXml:XmlElement) =
let removeSwateProtocolGroup (protocolGroup:Xml.GroupTypes.ProtocolGroup) (previousCompleteCustomXml:XmlElement) =
updateRemoveSwateProtocolGroup protocolGroup previousCompleteCustomXml true

let updateSwateProtocolGroup (protocolGroup:Xml.GroupTypes.ProtocolGroup) (previousCompleteCustomXml:XmlElement) =
updateRemoveSwateProtocolGroup protocolGroup previousCompleteCustomXml false

let replaceProtGroupByProtGroup protGroup1 protGroup2 (previousCompleteCustomXml:XmlElement) =
let removeProtGroup1 = removeSwateProtocolGroup protGroup1 previousCompleteCustomXml
let addProtGroup2 = updateSwateProtocolGroup protGroup2 removeProtGroup1
addProtGroup2

/// Use the 'remove' parameter to remove any Swate protocol xml for the worksheet annotation table name combination in 'protocolGroup'
let updateRemoveSwateProtocol (protocol:Xml.GroupTypes.Protocol) (previousCompleteCustomXml:XmlElement) (remove:bool)=

let currentSwateProtocolGroup =
let isExisting = getSwateProtocolGroupForCurrentTable tableName worksheetName previousCompleteCustomXml
let isExisting = getSwateProtocolGroupForCurrentTable protocol.AnnotationTable.Name protocol.AnnotationTable.Worksheet previousCompleteCustomXml
if isExisting.IsNone then
Xml.GroupTypes.ProtocolGroup.create protocol.SwateVersion tableName worksheetName []
Xml.GroupTypes.ProtocolGroup.create protocol.SwateVersion protocol.AnnotationTable.Name protocol.AnnotationTable.Worksheet []
else
isExisting.Value

Expand All @@ -747,11 +797,21 @@ let updateSwateProtocolGroupByProtocol tableName worksheetName (protocol:Xml.Gro

let nextProtocolGroup =
{currentSwateProtocolGroup with
Protocols = protocol::filteredProtocolChildren
Protocols =
if remove then
filteredProtocolChildren
else
protocol::filteredProtocolChildren
}

updateSwateProtocolGroup nextProtocolGroup previousCompleteCustomXml

let removeSwateProtocol (protocol:Xml.GroupTypes.Protocol) (previousCompleteCustomXml:XmlElement) =
updateRemoveSwateProtocol protocol previousCompleteCustomXml true

let updateSwateProtocol (protocol:Xml.GroupTypes.Protocol) (previousCompleteCustomXml:XmlElement) =
updateRemoveSwateProtocol protocol previousCompleteCustomXml false

let updateProtocolFromXml (protocol:Xml.GroupTypes.Protocol) (remove:bool) =
Excel.run(fun context ->

Expand All @@ -764,9 +824,13 @@ let updateProtocolFromXml (protocol:Xml.GroupTypes.Protocol) (remove:bool) =
promise {
let! annotationTable = getActiveAnnotationTableName()

let! xmlParsed, xml = getCustomXml customXmlParts context
let! xmlParsed = getCustomXml customXmlParts context

// Not sure if this is necessary. Previously table and worksheet name were accessed at this point.
// 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 = updateSwateProtocolGroupByProtocol annotationTable activeSheet.name protocol xmlParsed
let nextCustomXml = updateSwateProtocol securityUpdateForProtocol xmlParsed

let nextCustomXmlString = nextCustomXml |> xmlElementToXmlString

Expand Down
Loading

0 comments on commit 4b818db

Please sign in to comment.