From bdba3ae061d4c0aa473eef19ab2c55586582c462 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Wed, 16 Dec 2020 09:50:50 +0100 Subject: [PATCH 01/10] Properly Document Office interop functions (Issue #75). --- src/Client/Messages.fs | 6 +- src/Client/OfficeInterop/EventHandlers.fs | 55 +- src/Client/OfficeInterop/HelperFunctions.fs | 18 +- src/Client/OfficeInterop/OfficeInterop.fs | 752 ++++++++++---------- src/Client/OfficeInterop/Types.fs | 41 +- src/Client/Update.fs | 4 +- src/Shared/Shared.fs | 4 +- 7 files changed, 475 insertions(+), 405 deletions(-) diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index 0d08b008..e1c1794c 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -33,7 +33,7 @@ type ExcelInteropMsg = | UpdateTablesHaveAutoEditHandler // | FillHiddenColsRequest of activeAnnotationTable:TryFindAnnoTableResult - | FillHiddenColumns of tableName:string*InsertTerm [] + | FillHiddenColumns of tableName:string*SearchTermI [] | UpdateFillHiddenColsState of FillHiddenColsState // | InsertFileNames of activeAnnotationTable:TryFindAnnoTableResult*fileNameList:string list @@ -80,7 +80,7 @@ type ApiRequestMsg = | FetchAllOntologies /// This function is used to search for all values found in the table main columns. /// InsertTerm [] is created by officeInterop and passed to server for db search. - | SearchForInsertTermsRequest of tableName:string*InsertTerm [] + | SearchForInsertTermsRequest of tableName:string*SearchTermI [] // | GetAppVersion @@ -90,7 +90,7 @@ type ApiResponseMsg = | BuildingBlockNameSuggestionsResponse of DbDomain.Term [] | UnitTermSuggestionResponse of DbDomain.Term [] | FetchAllOntologiesResponse of DbDomain.Ontology [] - | SearchForInsertTermsResponse of tableName:string*InsertTerm [] + | SearchForInsertTermsResponse of tableName:string*SearchTermI [] // | GetAppVersionResponse of string diff --git a/src/Client/OfficeInterop/EventHandlers.fs b/src/Client/OfficeInterop/EventHandlers.fs index 9a8d6243..a4e99cf4 100644 --- a/src/Client/OfficeInterop/EventHandlers.fs +++ b/src/Client/OfficeInterop/EventHandlers.fs @@ -12,7 +12,7 @@ open System.Text.RegularExpressions open OfficeInterop.Regex open OfficeInterop.Types open OfficeInterop.HelperFunctions -open AutoFillTypes +open BuildingBlockTypes //open Elmish //open Browser @@ -23,16 +23,27 @@ open AutoFillTypes // Subscription.TestSubscription m |> dispatch // Cmd.ofSub sub +/// This module is loaded client side and is meant to work as a storage for office information. +/// This could possible be refractured into a model type design. module EventHandlerStates = + /// This mutable variable contains the information of which table currently has an existing eventhandler for assisted deleting from hidden columns. + /// In addition the 'OfficeExtension.EventHandlerResult' object is needed to access the specific handler again and to individually remove it. let mutable adaptHiddenColsHandlerList: Map> = Map.empty - +/// This functions works as event handler that can be added to tables and triggers on OnChanged event. +/// It is used to delete anything written in the hidden columns (referenced by '#h' in the column header tag array). let adaptHiddenColsHandler (tableChangeArgs:TableChangedEventArgs, tableName) = Excel.run(fun context -> + /// get active worksheet to execute function on let worksheet = context.workbook.worksheets.getActiveWorksheet() + /// As we found out the getItem() function does not only operate on the sheet it is executed on therefore we need the annotationTable-name of the active sheet. + /// The table name is passed by a previous function and allows us to access a specific annotation table on any worksheet in the excel workbook let table = worksheet.tables.getItem(tableName) + + // The next part loads relevant information from the excel objects and allows us to access them after 'context.sync()' + let tableHeader = table.getHeaderRowRange() let _ = tableHeader.load(U2.Case2 (ResizeArray[|"values"; "columnIndex"|])) @@ -41,59 +52,85 @@ let adaptHiddenColsHandler (tableChangeArgs:TableChangedEventArgs, tableName) = let changedRange = tableChangeArgs.getRange(context) let _ = changedRange.load(U2.Case2 (ResizeArray[|"columnIndex"; "rowIndex"; "rowCount"|])) - let r = context.runtime.load(U2.Case1 "enableEvents") - //let _ = Types.Subscription.TestSubscription ("Test") |> dispatch + let r = context.runtime.load(U2.Case1 "enableEvents") context.sync() .``then``(fun t -> + /// during our function we want all eventHandlers to be deactivated to prevent any cross reactions. r.enableEvents <- false - /// This is necessary to place find the correct table index for changed cell + + // This is necessary to find the correct table index for changed cell + // As the Range in which the change occured is always referenced from the worksheet and not from the table we need to calculate the table index + // e.g. If a table starts at cell 'C5' then the table index is 0 but the worksheet index is 2.# + + /// Calculate the table column index for the changed range let recalcChangedTableColIndex = let tableHeaderRangeColIndex = tableHeader.columnIndex let selectColIndex = changedRange.columnIndex selectColIndex - tableHeaderRangeColIndex + /// Calculate the table row index for the changed range let recalcChangedTableRowIndex = let tableRangedRowIndex = tableRange.rowIndex let selectRowIndex = changedRange.rowIndex selectRowIndex - tableRangedRowIndex + /// Get an array of all headers. We have a lot of information in our headers, e.g. tag array let headerVals = tableHeader.values.[0] |> Array.ofSeq + /// find the index of the next non hidden column. We assume, that all columns in between are part of the building block that got changed. let nextNonHiddenColForward = findIndexNextNotHiddenCol headerVals (recalcChangedTableColIndex+1.) //printfn "Try access fields at row: %.0f for column: %.0f - %.0f" recalcChangedTableRowIndex (recalcChangedTableColIndex+1.) (nextNonHiddenColForward-1.) + /// This gives us the header of the column in which something was changed. let header = tableHeader.values.[0].[int recalcChangedTableColIndex] - let parsedHeader = - let h = string header.Value - parseColHeader h + /// Parse header to allow for easy access on any relevant information in form of the 'ColHeader' record type. + let parsedHeader = parseColHeader (string header.Value) + /// This function will change the value of all cells of the same row and the same building block as the cells changed. + /// E.g. changed cells C5 to C8, which have 5 hidden columns as part of the building block. Then it will delete D6:H8. let changeHidden () = // We cannot work with the tableChangeArgs.details.valueAfter to see if we delete the hidden cols or adapt to user specific. // tableChangeArgs.details.valueAfter works only on single cell changes + + /// This creates a one cell range with an empty input. We use this as insert to simulate a delete. let input = ResizeArray([ ResizeArray([ "" |> box |> Some ]) ]) + + /// Iterate over all rows starting from our table index of the rows changed (this will always be the index of the first row changed) + /// and ending with the same index plus the number of rows changed. + /// tl;dr iterate over all rows with a changed cell for rowInd in recalcChangedTableRowIndex .. 1. .. (recalcChangedTableRowIndex + changedRange.rowCount - 1.) do - + + /// Iterate over all columns starting from our table index of the columns changed (this will always be the index of the first col changed) + 1 + /// and ending with the index of the next non-hidden col - 1, so with the last hidden col. + /// tl;dr iterate over all hidden cols for colInd in recalcChangedTableColIndex+1. .. 1. .. nextNonHiddenColForward-1. do + + /// for all these combinations get the cell object for these indices and insert our empty input. + /// Effectively deleting their previous value. let c = tableRange.getCell(rowInd, colInd) c.values <- input + /// This is a failsafe to prevent firing the event when a reference (hidden) column is changed. match parsedHeader.TagArr with | Some tagArr -> if tagArr |> Array.contains ColumnTags.HiddenTag then () else changeHidden() | None -> changeHidden() + /// activate events again r.enableEvents <- true + + /// This is not accessed and could very well be anything t ) ) \ No newline at end of file diff --git a/src/Client/OfficeInterop/HelperFunctions.fs b/src/Client/OfficeInterop/HelperFunctions.fs index ca0467c9..981acc51 100644 --- a/src/Client/OfficeInterop/HelperFunctions.fs +++ b/src/Client/OfficeInterop/HelperFunctions.fs @@ -9,8 +9,9 @@ open System.Text.RegularExpressions open OfficeInterop.Regex open OfficeInterop.Types -open AutoFillTypes +open BuildingBlockTypes +/// Swaps 'Rows with column values' to 'Columns with row values'. let viewRowsByColumns (rows:ResizeArray>) = rows |> Seq.collect (fun x -> Seq.indexed x) @@ -18,7 +19,7 @@ let viewRowsByColumns (rows:ResizeArray>) = |> Seq.map (snd >> Seq.map snd >> Seq.toArray) |> Seq.toArray -/// This function needs an array of the column headers as input. takes as such: +/// This function needs an array of the column headers as input. Takes as such: /// `let annoHeaderRange = annotationTable.getHeaderRowRange()` /// `annoHeaderRange.load(U2.Case2 (ResizeArray[|"values";"columnIndex"|])) |> ignore` /// `let headerVals = annoHeaderRange.values.[0] |> Array.ofSeq` @@ -56,6 +57,13 @@ let createEmptyMatrixForTables (colCount:int) (rowCount:int) value = |] :> IList> |] :> IList>> +let createValueMatrix (colCount:int) (rowCount:int) value = + ResizeArray([ + for outer in 0 .. rowCount-1 do + let tmp = Array.zeroCreate colCount |> Seq.map (fun _ -> Some (value |> box)) + ResizeArray(tmp) + ]) + /// Not used currently let createEmptyAnnotationMatrixForTables (rowCount:int) value (header:string) = [| @@ -75,9 +83,3 @@ let createEmptyAnnotationMatrixForTables (rowCount:int) value (header:string) = |] :> IList> |] :> IList>> -let createValueMatrix (colCount:int) (rowCount:int) value = - ResizeArray([ - for outer in 0 .. rowCount-1 do - let tmp = Array.zeroCreate colCount |> Seq.map (fun _ -> Some (value |> box)) - ResizeArray(tmp) - ]) \ No newline at end of file diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index 2e7963e5..fa74e6aa 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -14,243 +14,84 @@ open OfficeInterop.Types open SwateInteropTypes open OfficeInterop.HelperFunctions open OfficeInterop.EventHandlers -open AutoFillTypes +open BuildingBlockTypes -[] -let consoleLog (message: string): unit = jsNative - //ranges.format.fill.color <- "red" - //let ranges = context.workbook.getSelectedRanges() - //let x = ranges.load(U2.Case1 "address") +/// Reoccuring Comment Defitinitions -open System -open Fable.Core +/// 'annotationTables' -> For a workbook (NOT! worksheet) all tables must have unique names. Therefore not all our tables can be called 'annotationTable'. +/// Instead we add numbers to keep them unique. 'annotationTables' references all of those tables. -let exampleExcelFunction () = - Excel.run(fun context -> - let sheet = context.workbook.worksheets.getActiveWorksheet() - let annotationTable = sheet.tables.getItem("annotationTable") - let tables = annotationTable.columns.load(propertyNames = U2.Case2 (ResizeArray[|"items";"count"|])) - let annoHeaderRange = annotationTable.getHeaderRowRange() - let _ = annoHeaderRange.load(U2.Case2 (ResizeArray [|"columnIndex"; "values"|])) |> ignore - let annoBodyRange = annotationTable.getDataBodyRange() - let _ = annoBodyRange.load(U2.Case2 (ResizeArray [|"values"|])) |> ignore - context.sync() - .``then``( fun _ -> - let columnBodies = - annoBodyRange.values - |> viewRowsByColumns - let columns = - [| - for i = 0 to (int tables.count - 1) do - yield ( - let ind = i - let header = - annoHeaderRange.values.[0].[ind] - |> fun x -> if x.IsSome then parseColHeader (string annoHeaderRange.values.[0].[ind].Value) |> Some else None - let cells = - columnBodies.[ind] - |> Array.mapi (fun i cellVal -> - let cellValue = if cellVal.IsSome then Some (string cellVal.Value) else None - Cell.create i cellValue - ) - Column.create ind header cells - ) - |] +/// 'active annotationTable' -> The annotationTable present on the active worksheet. This is not trivial to access an is most of the time passed to a function by +/// running 'tryFindActiveAnnotationTable()' in another message before. - /// Failsafe (1): it should never happen, that the nextColumn is a hidden column without an existing building block. - let errorMsg1 (nextCol:Column) (buildingBlock:BuildingBlock option) = - failwith ( - sprintf - "Swate encountered an error while processing the active annotation table. - Swate found a hidden column (%s) without a prior main column (not hidden)." - nextCol.Header.Value.Header - ) +/// 'TSR'/'TAN' -> Term Source Ref - column / Term Accession Number - column - /// Hidden columns do only come with certain core names. The acceptable names can be found in OfficeInterop.ColumnCoreNames. - let errorMsg2 (nextCol:Column) (buildingBlock:BuildingBlock option) = - failwith ( - sprintf - "Swate encountered an error while processing the active annotation table. - Swate found a hidden column (%s) with an unknown core name: %A" - nextCol.Header.Value.Header - nextCol.Header.Value.CoreName - ) +/// 'Reference Columns' -> Meant are the hidden columns including TSR, TAN and Unit columns - /// If a columns core name already exists for the current building block, then the block is faulty and needs userinput to be corrected. - let errorMsg3 (nextCol:Column) (buildingBlock:BuildingBlock option) assignedCol = - failwith ( - sprintf - "Swate encountered an error while processing the active annotation table. - Swate found a hidden column (%s) with a core name (%A) that is already assigned to the previous building block. - Building block main column: %s, already assigned column: %s" - nextCol.Header.Value.Header - nextCol.Header.Value.CoreName - buildingBlock.Value.MainColumn.Header.Value.Header - assignedCol - ) +/// 'Main Column' -> Non hidden column of a building block. Each building block only contains one main column - let checkForHiddenColType (currentBlock:BuildingBlock option) (nextCol:Column) = - // Then we need to check if the nextCol is either a TSR or a TAN column - match nextCol.Header.Value.CoreName.Value with - | ColumnCoreNames.Hidden.TermAccessionNumber -> - // Build in fail safes. - if currentBlock.IsNone then errorMsg1 nextCol currentBlock - if currentBlock.Value.TAN.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.TAN.Value.Header.Value.Header - let updateCurrentBlock = - { currentBlock.Value with - TAN = Some nextCol } |> Some - updateCurrentBlock - | ColumnCoreNames.Hidden.TermSourceREF -> - // Build in fail safe. - if currentBlock.IsNone then errorMsg1 nextCol currentBlock - if currentBlock.Value.TSR.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.TSR.Value.Header.Value.Header - let updateCurrentBlock = - { currentBlock.Value with - TSR = Some nextCol } |> Some - updateCurrentBlock - | ColumnCoreNames.Hidden.Unit -> - // Build in fail safe. - if currentBlock.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.MainColumn.Header.Value.Header - let newBlock = BuildingBlock.create nextCol None None None |> Some - newBlock - | _ -> - // Build in fail safe. - errorMsg2 nextCol currentBlock +/// 'Tag Array' -> Column headers can come with additional information. This info is currently saved +/// in a list of tags starting with '#' in brackets. E.g. '(#id, #h)' - // building block are defined by one visuable column and an undefined number of hidden columns. - // Therefore we iterate through the columns array and use every column without an `#h` tag as the start of a new building block. - let rec sortColsIntoBuildingBlocks (index:int) (currentBlock:BuildingBlock option) (buildingBlockList:BuildingBlock list) = - if index > (int tables.count - 1) then - if currentBlock.IsSome then - currentBlock.Value::buildingBlockList - else - buildingBlockList - else - let nextCol = columns.[index] - // If the nextCol does not have an header it is empty and therefore skipped. - if - nextCol.Header.IsNone - then - sortColsIntoBuildingBlocks (index+1) currentBlock buildingBlockList - // if the nextCol.Header has a tag array and it does NOT contain a hidden tag then it starts a new building block - elif - (nextCol.Header.Value.TagArr.IsSome && nextCol.Header.Value.TagArr.Value |> Array.contains ColumnTags.HiddenTag |> not) - || (nextCol.Header.IsSome && nextCol.Header.Value.TagArr.IsNone) - then - let newBuildingBlock = BuildingBlock.create nextCol None None None |> Some - // If there is a currentBlock we add it to the list of building blocks. - if currentBlock.IsSome then - sortColsIntoBuildingBlocks (index+1) newBuildingBlock (currentBlock.Value::buildingBlockList) - // If there is no currentBuildingBlock, e.g. at the start of this function we replace the None with the first building block. - else - sortColsIntoBuildingBlocks (index+1) newBuildingBlock buildingBlockList - // if the nextCol.Header has a tag array and it does contain a hidden tag then it is added to the currentBlock - elif - nextCol.Header.Value.TagArr.IsSome && nextCol.Header.Value.TagArr.Value |> Array.contains ColumnTags.HiddenTag - then - // There are multiple possibilities which column this is: TSR; TAN; Unit; Unit TSR; Unit TAN are the currently existing ones. - // We first check if there is NO unit tag in the header tag array - if nextCol.Header.Value.TagArr.Value |> Array.exists (fun x -> x.StartsWith ColumnTags.UnitTagStart) |> not then - let updateCurrentBlock = checkForHiddenColType currentBlock nextCol - sortColsIntoBuildingBlocks (index+1) updateCurrentBlock buildingBlockList - /// Next we check for unit columns in the scheme of `Unit [Term] (#h; #u...) | TSR [Term] (#h; #u...) | TAN [Term] (#h; #u...)` - elif nextCol.Header.Value.TagArr.Value |> Array.exists (fun x -> x.StartsWith ColumnTags.UnitTagStart) then - let updatedUnitBlock = checkForHiddenColType currentBlock.Value.Unit nextCol - let updateCurrentBlock = {currentBlock.Value with Unit = updatedUnitBlock} |> Some - sortColsIntoBuildingBlocks (index+1) updateCurrentBlock buildingBlockList - else - failwith "The tag array of the next column to process in 'sortColsIntoBuildingBlocks' can only contain a '#u' tag or not." - else - failwith (sprintf "The tag array of the next column to process in 'sortColsIntoBuildingBlocks' was not recognized as hidden or main column: %A." nextCol.Header) +/// 'Unit col block'/ -> This references the unit block of a building block. It is a optional addition and not every +/// 'Unit cols' building block must contain it. It consists of a unit main column with the unit term +/// and it's own TSR and TAN. - // sort all columns into building blocks - let buildingBlocks = - sortColsIntoBuildingBlocks 0 None [] - |> List.rev - |> Array.ofList +/// REFERENCES (often used functions with the same comment) - let buildingBlocksWithOntology = - buildingBlocks |> Array.filter (fun x -> x.TSR.IsSome && x.TAN.IsSome) +/// Ref. 1 -> Deactivate all events to prevent any crossreactions during our functions. - /// We need an array of all distinct cell.values and where they occur in col- and row-index - let terms = - buildingBlocksWithOntology - |> Array.collect (fun bBlock -> - // get current col index - let tsrTanColIndices = [|bBlock.TSR.Value.Index; bBlock.TAN.Value.Index|] - let fillTermConstructsNoUnit bBlock= - // group cells by value so we don't get doubles - bBlock.MainColumn.Cells - |> Array.groupBy (fun cell -> - cell.Value.IsSome, cell.Value.Value - ) - // only keep cells with value and create InsertTerm types that will be passed to the server to get filled with a term option. - |> Array.choose (fun ((isSome,searchStr),cellArr) -> - if isSome && searchStr <> "" then - let rowIndices = cellArr |> Array.map (fun cell -> cell.Index) - Shared.InsertTerm.create tsrTanColIndices searchStr rowIndices - |> Some - else - None - ) - let fillTermConstructsWithUnit (bBlock:BuildingBlock) = - let searchStr = bBlock.MainColumn.Header.Value.Ontology.Value - let rowIndices = - bBlock.MainColumn.Cells - |> Array.map (fun x -> - x.Index - ) - [|Shared.InsertTerm.create tsrTanColIndices searchStr rowIndices|] - if bBlock.Unit.IsSome then - fillTermConstructsWithUnit bBlock - else - fillTermConstructsNoUnit bBlock - ) +/// Ref. 2 -> The next part loads relevant information from the excel objects and allows us to access them after 'context.sync()' - let units = - buildingBlocksWithOntology - |> Array.filter (fun bBlock -> bBlock.Unit.IsSome) - |> Array.map ( - fun bBlock -> - let unit = bBlock.Unit.Value - let searchString = unit.MainColumn.Header.Value.Ontology.Value - let colIndices = [|unit.MainColumn.Index; unit.TSR.Value.Index; unit.TAN.Value.Index|] - let rowIndices = unit.MainColumn.Cells |> Array.map (fun x -> x.Index) - Shared.InsertTerm.create colIndices searchString rowIndices - ) +/// Ref. 3 -> Indices from a SelectedRange will return them on a worksheet perspective. E.g. C3 wll have col index 2. +/// Indices from a table.getRange()/table.getHeaderRowRange() will be from a table perspective. +/// The first col will have index 0 no matter at which worksheet column it is placed. +/// Therefore we need to recalculate indices when working with selected range on the table. This is done multiple times throughout the office interop functions. - let allSearches = [| - yield! terms - yield! units - |] - sprintf "%A" terms +[] +let consoleLog (message: string): unit = jsNative + //ranges.format.fill.color <- "red" + //let ranges = context.workbook.getSelectedRanges() + //let x = ranges.load(U2.Case1 "address") + +open System +open Fable.Core + + +/// This is not used in production and only here for development. Its content is always changing to test functions for new features. +let exampleExcelFunction () = + Excel.run(fun context -> + + context.sync() + .``then``( fun _ -> + + sprintf "Test output" ) ) +/// This is not used in production and only here for development. Its content is always changing to test functions for new features. let exampleExcelFunction2 () = Excel.run(fun context -> context.sync() .``then``( fun _ -> - sprintf "Test output" + sprintf "Test output 2" ) ) +/// This function is used to create a new annotation table. +/// 'allTableNames' is a array of all currently existing annotationTables. +/// 'isDark' refers to the current styling of excel (darkmode, or not). let createAnnotationTable ((allTableNames:String []),isDark:bool) = Excel.run(fun context -> - let sheet = context.workbook.worksheets.getActiveWorksheet() - - let tableRange = context.workbook.getSelectedRange() - let _ = tableRange.load(U2.Case2 (ResizeArray(["rowIndex"; "columnIndex"; "rowCount";"address"; ]))) - - let style = - if isDark then - "TableStyleMedium15" - else - "TableStyleMedium7" + /// This function is used to create the "next" annotationTable name. + /// 'allTableNames' is passed from a previous function and contains a list of all annotationTables. + /// The function then tests if the freshly created name already exists and if it does it rec executes itself againn with (ind+1) + /// Due to how this function is written, the tables will not always count up. E.g. annotationTable2 gets deleted then the next table will not be + /// annotationTable3 or higher but annotationTable2 again. This could in the future lead to problems if information is saved with the table name as identifier. let rec findNewTableName ind = let newTestName = if ind = 0 then "annotationTable" else sprintf "annotationTable%i" ind @@ -260,7 +101,20 @@ let createAnnotationTable ((allTableNames:String []),isDark:bool) = else newTestName - let newName = findNewTableName 0 + /// decide table style by input parameter + let style = + if isDark then + "TableStyleMedium15" + else + "TableStyleMedium7" + + // The next part loads relevant information from the excel objects and allows us to access them after 'context.sync()' + let activeSheet = context.workbook.worksheets.getActiveWorksheet() + let _ = activeSheet.load(U2.Case2 (ResizeArray[|"tables"|])) + let activeTables = activeSheet.tables.load(propertyNames=U2.Case1 "items") + + let tableRange = context.workbook.getSelectedRange() + let _ = tableRange.load(U2.Case2 (ResizeArray(["rowIndex"; "columnIndex"; "rowCount";"address"; ]))) let r = context.runtime.load(U2.Case1 "enableEvents") @@ -268,21 +122,53 @@ let createAnnotationTable ((allTableNames:String []),isDark:bool) = context.sync() .``then``( fun _ -> + /// Filter all names of tables on the active worksheet for names starting with "annotationTable". + let annoTables = + activeTables.items + |> Seq.toArray + |> Array.map (fun x -> x.name) + |> Array.filter (fun x -> x.StartsWith "annotationTable") + + // Fail the function if there are not exactly 0 annotation tables in the active worksheet. + // This check is done, to only have one annotationTable per workSheet. + let _ = + match annoTables.Length with + | x when x > 0 -> + failwith "The active worksheet contains more than zero annotationTables. Please move to a new worksheet." + | 0 -> + () + | _ -> + failwith "The active worksheet contains a negative number of annotation tables. Obviously this cannot happen. Please report this as a bug to the developers." + + // Ref. 1 r.enableEvents <- false - let adaptedRange = sheet.getRangeByIndexes(tableRange.rowIndex,tableRange.columnIndex,tableRange.rowCount,2.) - let annotationTable = sheet.tables.add(U2.Case1 adaptedRange,true) + /// We do not want to create annotation tables of any size. The recommended workflow is to use the addBuildingBlock functionality. + /// Therefore we recreate the tableRange but with a columncount of 2. The 2 Basic columns in any annotation table. + /// "Source Name" | "Sample Name" + let adaptedRange = activeSheet.getRangeByIndexes(tableRange.rowIndex,tableRange.columnIndex,tableRange.rowCount,2.) + /// Create table in current worksheet + let annotationTable = activeSheet.tables.add(U2.Case1 adaptedRange,true) + + /// Update annotationTable column headers (annotationTable.columns.getItemAt 0.).name <- "Source Name" (annotationTable.columns.getItemAt 1.).name <- "Sample Name" + /// Create new annotationTable name + let newName = findNewTableName 0 + /// Update annotationTable name annotationTable.name <- newName + /// Update annotationTable style annotationTable.style <- style - sheet.getUsedRange().format.autofitColumns() - sheet.getUsedRange().format.autofitRows() + /// Fit widths and heights of cols and rows to value size. (In this case the new column headers). + activeSheet.getUsedRange().format.autofitColumns() + activeSheet.getUsedRange().format.autofitRows() + /// Should event handlers be active, then add them to the new table, otherwise don't. + /// If the storage map is empty then eventhanderls should be deactivated. if EventHandlerStates.adaptHiddenColsHandlerList.IsEmpty then () else @@ -290,83 +176,75 @@ let createAnnotationTable ((allTableNames:String []),isDark:bool) = EventHandlerStates.adaptHiddenColsHandlerList.Add (newName, annotationTable.onChanged.add(fun eventArgs -> adaptHiddenColsHandler (eventArgs,newName)) ) r.enableEvents <- true + + /// Return info message SwateInteropTypes.Success newName, sprintf "Annotation Table created in [%s] with dimensions 2c x (%.0f + 1h)r" tableRange.address (tableRange.rowCount - 1.) ) //.catch (fun e -> e |> unbox |> fun x -> x.Message) ) + +/// This function is used before most excel interop messages to get the active annotationTable. let tryFindActiveAnnotationTable() = Excel.run(fun context -> + + // Ref. 2 + let sheet = context.workbook.worksheets.getActiveWorksheet() let t = sheet.load(U2.Case2 (ResizeArray[|"tables"|])) let tableItems = t.tables.load(propertyNames=U2.Case1 "items") + context.sync() .``then``( fun _ -> + /// access names of all tables in the active worksheet. let tables = tableItems.items |> Seq.toArray |> Array.map (fun x -> x.name) + /// filter all table names for tables starting with "annotationTable" let annoTables = tables |> Array.filter (fun x -> x.StartsWith "annotationTable") + /// Get the correct error message if we have <> 1 annotation table. Only returns success and the table name if annoTables.Length = 1 let res = SwateInteropTypes.TryFindAnnoTableResult.exactlyOneAnnotationTable annoTables - // add event to active table + + // return result res ) ) -/// This function returns the names of all tables in all worksheets. +/// This function returns the names of all annotationTables in all worksheets. +/// This function is used to pass a list of all table names to e.g. the 'createAnnotationTable()' function. let getTableInfoForAnnoTableCreation() = Excel.run(fun context -> - let tableCol = context.workbook.tables.load(propertyNames=U2.Case2 (ResizeArray[|"tables"|])) - let tables = tableCol.load(propertyNames = U2.Case1 "name") - let activeSheet = context.workbook.worksheets.getActiveWorksheet() - let t = activeSheet.load(U2.Case2 (ResizeArray[|"tables"|])) - let activeTables = t.tables.load(propertyNames=U2.Case1 "items") - let r = context.runtime.load(U2.Case1 "enableEvents") + // Ref. 2 + + let tables = context.workbook.tables.load(propertyNames=U2.Case2 (ResizeArray[|"tables"|])) + let _ = tables.load(propertyNames = U2.Case1 "name") context.sync() .``then``( fun _ -> - r.enableEvents <- false - + /// Get all names of all tables in the whole workbook. let tableNames = tables.items |> Seq.toArray |> Array.map (fun x -> x.name) - let annoTables = - activeTables.items - |> Seq.toArray - |> Array.map (fun x -> x.name) - |> Array.filter (fun x -> x.StartsWith "annotationTable") - - // fail the function if there are not exactly 0 annotation tables in the active worksheet - let _ = - match annoTables.Length with - | x when x > 0 -> - r.enableEvents <- true - failwith "The active worksheet contains more than zero annotationTables. Please move them to other worksheets." - | 0 -> - annoTables - | _ -> - r.enableEvents <- true - failwith "The active worksheet contains a negative number of annotation tables. Obviously this cannot happen. Please report this as a bug to the developers." - - r.enableEvents <- true - tableNames ) ) +/// This function is used to either add eventHandlers to all annotationTables or to remove all eventHanderls. let toggleAdaptHiddenColsEventHandler () = + /// Check if storage for eventHandlers is empty let isEmpty = EventHandlerStates.adaptHiddenColsHandlerList.IsEmpty + /// If it is empty when the function is called then we want to add event handlers. if isEmpty then Excel.run(fun context -> - let tableCollection = context.workbook.tables.load(propertyNames = U2.Case1 "items") - + /// This function recursevly adds eventHandlers to all elements of the 'tables' [] and stores the reference to the event handler in 'map' let rec addEventToTable (map:Map>) ind (tables: Table []) = if ind > tables.Length-1 then map @@ -374,31 +252,44 @@ let toggleAdaptHiddenColsEventHandler () = let newMap = map.Add (tables.[ind].name, tables.[ind].onChanged.add(fun eventArgs -> adaptHiddenColsHandler (eventArgs,tables.[ind].name))) addEventToTable newMap (ind+1) tables + // Ref. 2 + + let tableCollection = context.workbook.tables.load(propertyNames = U2.Case1 "items") + context.sync() - .``then``(fun t -> + .``then``(fun _ -> + /// Get all annotationTables let annoTables = tableCollection.items |> Seq.filter (fun x -> x.name.StartsWith "annotationTable") |> Array.ofSeq + /// Add eventHandlers to all of them ... let newHandlers = annoTables |> addEventToTable EventHandlerStates.adaptHiddenColsHandlerList 0 - + /// ... and store reference in event handler storage. + /// This is necessary as we need these objects to remove them (see 'removeHandler' below) EventHandlerStates.adaptHiddenColsHandlerList <- newHandlers + /// Create message let tableMessageStr = annoTables |> Seq.map (fun x -> x.name) |> String.concat ", " + /// Return message in array due to how removing the handlers is structured. + /// (if .. then .. else needs same output.) [|sprintf "Event handler added to tables: %s" tableMessageStr|] ) ) else + /// creates a list of "Promises", which each remove one eventHandler and the reference from the event handler storage. let rec removeHandler ind promises (handlerArr:(string*OfficeExtension.EventHandlerResult) []) = if ind > handlerArr.Length-1 then promises else + /// get current handler from event handler storage let (name,handler):string*OfficeExtension.EventHandlerResult = handlerArr.[ind] + /// Give handler.context as input for 'Excel.run' and remove it from the table and the event handler storage. let promise = Excel.run(handler.context, fun context -> @@ -410,21 +301,32 @@ let toggleAdaptHiddenColsEventHandler () = context.sync() .``then``(fun t -> + // As we will 'String.concat' these messages later we want the first message to give more context ... if ind = 0 then sprintf "Event handler removed from tables: %s" name + // ... and every other message to just contain the table name. else name ) ) + // iterate through the whole event handler storage removeHandler (ind+1) (promise::promises) handlerArr + // create all promises to remove event handlers removeHandler 0 [] (Map.toArray EventHandlerStates.adaptHiddenColsHandlerList) + // this is done to create readable output. |> List.rev + // execute all promises |> Promise.Parallel +/// This function is used to hide all '#h' tagged columns and to fit rows and columns to their values. +/// The main goal is to improve readability of the table with this function. let autoFitTable (annotationTable) = Excel.run(fun context -> + + // Ref. 2 + let sheet = context.workbook.worksheets.getActiveWorksheet() let annotationTable = sheet.tables.getItem(annotationTable) let allCols = annotationTable.columns.load(propertyNames = U2.Case1 "items") @@ -434,37 +336,49 @@ let autoFitTable (annotationTable) = let r = context.runtime.load(U2.Case1 "enableEvents") - context.sync().``then``( - fun _ -> - r.enableEvents <- false - let allCols = allCols.items |> Array.ofSeq - let _ = - allCols - |> Array.map (fun col -> col.getRange()) - |> Array.map (fun x -> - x.columnHidden <- false - x.format.autofitColumns() - x.format.autofitRows() - ) - // get all column headers - let headerVals = annoHeaderRange.values.[0] |> Array.ofSeq - // get only column headers with values inside and map object to string - let headerArr = headerVals |> Array.choose id |> Array.map string - // parse header elements into record type - let parsedHeaderArr = headerArr |> Array.map parseColHeader - // find all columns to hide - let colsToHide = - parsedHeaderArr - |> Array.filter (fun header -> header.TagArr.IsSome && Array.contains ColumnTags.HiddenTag header.TagArr.Value) - let ranges = - colsToHide - |> Array.map (fun header -> (annotationTable.columns.getItem (U2.Case2 header.Header)).getRange()) - let hideCols = ranges |> Array.map (fun x -> x.columnHidden <- true) - r.enableEvents <- true - "Autoformat Table" - ) + context.sync().``then``(fun _ -> + + // Ref. 1 + r.enableEvents <- false + + // Auto fit on all columns to fit cols and rows to their values. + let allCols = allCols.items |> Array.ofSeq + let _ = + allCols + |> Array.map (fun col -> col.getRange()) + |> Array.map (fun x -> + // make all columns visible, we will later selectively hide all with '#h' tag + x.columnHidden <- false + x.format.autofitColumns() + x.format.autofitRows() + ) + // Get all column headers + let headerVals = annoHeaderRange.values.[0] |> Array.ofSeq + // Get only column headers with values inside and map object to string + let headerArr = headerVals |> Array.choose id |> Array.map string + // Parse header elements into record type + let parsedHeaderArr = headerArr |> Array.map parseColHeader + // Find all columns to hide (with '#h' tag) + let colsToHide = + parsedHeaderArr + |> Array.filter (fun header -> header.TagArr.IsSome && Array.contains ColumnTags.HiddenTag header.TagArr.Value) + // Get all column ranges (necessary to change 'columnHidden' attribute) for all headers with '#h' tag. + let ranges = + colsToHide + |> Array.map (fun header -> (annotationTable.columns.getItem (U2.Case2 header.Header)).getRange()) + // Hide columns + let _ = ranges |> Array.map (fun x -> x.columnHidden <- true) + + r.enableEvents <- true + + // return message + "Autoformat Table" + ) ) +/// This is currently used to get information about the table for the table validation feature. +/// Might be necessary to redesign this to use the newer 'BuildingBlock' or get completly replaced by parts of 'getInsertTermsToFillHiddenCols' +/// As this function creates a complete representation of the table and then searches on it. Should we decide to keep the function then i will add more inline comments. let getTableRepresentation(annotationTable) = Excel.run(fun context -> let sheet = context.workbook.worksheets.getActiveWorksheet() @@ -499,20 +413,26 @@ let getTableRepresentation(annotationTable) = ) ) +/// This function is used to add a new building block to the active annotationTable. let addAnnotationBlock (annotationTable,colName:string,format:(string*(string option)) option) = - // The following cols are useful with TSR and TAN hidden cols and cannot have unit cols + /// The following cols are currently always singles (cannot have TSR, TAN, unit cols). For easier refactoring these names are saved in OfficeInterop.Types. let isSingleCol = match colName with - | "Sample Name" | "Source Name" | "Data File Name" -> true + | ColumnCoreNames.Shown.Sample | ColumnCoreNames.Shown.Source | ColumnCoreNames.Shown.Data -> true | _ -> false + /// This function will create the mainColumn name from the base name (e.g. 'Parameter [instrument model]' -> Parameter [instrument model] (#1)). + /// The possible addition of an id tag is needed, because column headers need to be unique in excel. let mainColName (colName:string) (id:int) = match id with | 1 -> colName | _ -> sprintf "%s (#%i)" colName id + + /// This is used to create the bracket information for reference (hidden) columns. Again this has two modi, one with id tag and one without. + /// This time no core name is needed as this will always be TSR or TAN. let hiddenColAttributes (parsedColHeader:ColHeader) (id:int) = let coreName = match parsedColHeader.Ontology, parsedColHeader.CoreName with @@ -524,8 +444,10 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op (sprintf "[%s] (#h)" coreName) | _ -> (sprintf "[%s] (#%i; #h)" coreName id) - // as unit always has to be a term and cannot be for example "Source" or "Sample", both of which have a differen format than for exmaple "Parameter [TermName]", - // we only need one function to generate id and attributes and bring the unit term in the right format. + + /// This will create the column header attributes for a unit block. + /// as unit always has to be a term and cannot be for example "Source" or "Sample", both of which have a differen format than for exmaple "Parameter [TermName]", + /// we only need one function to generate id and attributes and bring the unit term in the right format. let unitColAttributes (unitTermInfo:string*string option) (id:int) = let unitTermName = fst unitTermInfo let unitAccession = if (snd unitTermInfo).IsNone then "" else (snd unitTermInfo).Value @@ -539,16 +461,18 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op let sheet = context.workbook.worksheets.getActiveWorksheet() let annotationTable = sheet.tables.getItem(annotationTable) - /// This is necessary to place new columns next to selected col + // Ref. 2 + + // This is necessary to place new columns next to selected col let tables = annotationTable.columns.load(propertyNames = U2.Case1 "items") let annoHeaderRange = annotationTable.getHeaderRowRange() + let _ = annoHeaderRange.load(U2.Case2 (ResizeArray[|"values";"columnIndex"|])) + let tableRange = annotationTable.getRange() + let _ = tableRange.load(U2.Case2 (ResizeArray(["columnCount";"rowCount"]))) let range = context.workbook.getSelectedRange() - annoHeaderRange.load(U2.Case2 (ResizeArray[|"values";"columnIndex"|])) |> ignore - range.load(U2.Case1 "columnIndex") |> ignore + let _ = range.load(U2.Case1 "columnIndex") - /// - let tableRange = annotationTable.getRange() - tableRange.load(U2.Case2 (ResizeArray(["columnCount";"rowCount"]))) |> ignore + // Ref. 1 let r = context.runtime.load(U2.Case1 "enableEvents") @@ -556,14 +480,15 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op r.enableEvents <- false - /// This is necessary to place new columns next to selected col - let tableHeaderRangeColIndex = annoHeaderRange.columnIndex - let selectColIndex = range.columnIndex - let diff = selectColIndex - tableHeaderRangeColIndex |> int - let vals = - tables.items - let maxLength = vals.Count-1 + // Ref. 3 + /// This is necessary to place new columns next to selected col. + /// selected ranged returns indices always from a worksheet perspective but we need the related table index. This is calculated here. let newBaseColIndex = + let tableHeaderRangeColIndex = annoHeaderRange.columnIndex + let selectColIndex = range.columnIndex + let diff = selectColIndex - tableHeaderRangeColIndex |> int + let vals = tables.items + let maxLength = vals.Count-1 if diff < 0 then maxLength+1 elif diff > maxLength then @@ -583,8 +508,10 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op headerVals |> Array.choose id |> Array.map string - // This is necessary to prevent trying to create a column with an already existing name + + /// This is necessary to check if the would be created col name already exists, to then tick up the id tag. let parsedBaseHeader = parseColHeader colName + /// This function checks if the would be col names already exist. If they do it ticks up the id tag to keep col names unique. let findNewIdForName() = let rec loopingCheck int = let isExisting = @@ -595,10 +522,10 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op existingHeader = mainColName colName int else existingHeader = mainColName colName int - // i think it is necessary to also check for "T S REF" and "T A N" because of the following possibilities + // i think it is necessary to also check for "TSR" and "TAN" because of the following possibilities // Parameter [instrument model] | "Term Source REF [instrument model] (#h) | ... // Factor [instrument model] | "Term Source REF [instrument model] (#h) | ... - // in the example above the coreColName is different but "T S REF" and "T A N" would be the same. + // in the example above the mainColumn name is different but "TSR" and "TAN" would be the same. || existingHeader = sprintf "Term Source REF %s" (hiddenColAttributes parsedBaseHeader int) || existingHeader = sprintf "Term Accession Number %s" (hiddenColAttributes parsedBaseHeader int) ) @@ -607,13 +534,16 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op else int loopingCheck 1 + + // The new id, which does not exist yet with the column name let newId = findNewIdForName() let rowCount = tableRange.rowCount |> int //create an empty column to insert - let col = - createEmptyMatrixForTables 1 rowCount "" + let col = createEmptyMatrixForTables 1 rowCount "" + + // create main column let createdCol1() = annotationTable.columns.add( index = newBaseColIndex', @@ -621,12 +551,15 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op name = mainColName colName newId ) + // create TSR let createdCol2() = annotationTable.columns.add( index = newBaseColIndex'+1., values = U4.Case1 col, name = sprintf "Term Source REF %s" (hiddenColAttributes parsedBaseHeader newId) ) + + // create TAN let createdCol3() = annotationTable.columns.add( index = newBaseColIndex'+2., @@ -634,6 +567,7 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op name = sprintf "Term Accession Number %s" (hiddenColAttributes parsedBaseHeader newId) ) + // Should the column be Data, Source or Sample then we do not add TSR and TAN let createCols = if isSingleCol then [|createdCol1()|] @@ -665,6 +599,7 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op let newUnitId = findNewIdForUnit() + /// create unit main column let createdUnitCol1 = annotationTable.columns.add( index = newBaseColIndex'+3., @@ -672,12 +607,15 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op name = sprintf "Unit %s" (unitColAttributes format.Value newUnitId) ) + /// create unit TSR let createdUnitCol2 = annotationTable.columns.add( index = newBaseColIndex'+4., values = U4.Case1 col, name = sprintf "Term Source REF %s" (unitColAttributes format.Value newUnitId) ) + + /// create unit TAN let createdUnitCol3 = annotationTable.columns.add( index = newBaseColIndex'+5., @@ -692,22 +630,29 @@ let addAnnotationBlock (annotationTable,colName:string,format:(string*(string op else None + /// If unit block was added then return some msg information let unitColCreationMsg = if createUnitColsIfNeeded.IsSome then fst createUnitColsIfNeeded.Value else "" let unitColFormat = if createUnitColsIfNeeded.IsSome then snd createUnitColsIfNeeded.Value else "0.00" r.enableEvents <- true + /// return main col names, unit column format and a message. The first two params are used in a follow up message (executing 'changeTableColumnFormat') mainColName colName newId, unitColFormat, sprintf "%s column was added.%s" colName unitColCreationMsg ) ) let changeTableColumnFormat annotationTable (colName:string) (format:string) = Excel.run(fun context -> + + // Ref. 2 let sheet = context.workbook.worksheets.getActiveWorksheet() let annotationTable = sheet.tables.getItem(annotationTable) + // get ranged of main column that was previously created let colBodyRange = (annotationTable.columns.getItem (U2.Case2 colName)).getDataBodyRange() - colBodyRange.load(U2.Case2 (ResizeArray(["columnCount";"rowCount"]))) |> ignore + let _ = colBodyRange.load(U2.Case2 (ResizeArray(["columnCount";"rowCount"]))) + + // Ref. 1 let r = context.runtime.load(U2.Case1 "enableEvents") context.sync().``then``( fun _ -> @@ -715,76 +660,115 @@ let changeTableColumnFormat annotationTable (colName:string) (format:string) = r.enableEvents <- false let rowCount = colBodyRange.rowCount |> int - //create an empty column to insert + // create a format column to insert let formats = createValueMatrix 1 rowCount format + // add unit format to previously created main column colBodyRange.numberFormat <- formats r.enableEvents <- true + + // return msg sprintf "format of %s was changed to %s" colName format ) ) -// Reform this to onSelectionChanged +// Reform this to onSelectionChanged (Even though we now know how to add eventHandlers we do not know how to pass info from handler to Swate app). +/// This function will parse the header of a selected column to check for a parent ontology, which will then be used for a isA-directed term search. +/// Any found parent ontology will also be displayed in a static field before the term search input field. let getParentTerm (annotationTable) = Excel.run (fun context -> + + // Ref. 2 let sheet = context.workbook.worksheets.getActiveWorksheet() let annotationTable = sheet.tables.getItem(annotationTable) - let tables = annotationTable.columns.load(propertyNames = U2.Case1 "items") - let annoHeaderRange = annotationTable.getHeaderRowRange() + let tableRange = annotationTable.getRange() + let _ = tableRange.load(U2.Case2 (ResizeArray[|"columnIndex"; "rowIndex"; "values"|])) let range = context.workbook.getSelectedRange() - annoHeaderRange.load(U2.Case1 "columnIndex") |> ignore - range.load(U2.Case1 "columnIndex") |> ignore + let _ = range.load(U2.Case2 (ResizeArray[|"columnIndex"; "rowIndex"|])) + context.sync() .``then``( fun _ -> - let tableHeaderRangeColIndex = annoHeaderRange.columnIndex - let selectColIndex = range.columnIndex - let diff = selectColIndex - tableHeaderRangeColIndex |> int - let vals = - tables.items - let maxLength = vals.Count-1 + + // 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 = - if diff < 0 || diff > maxLength then + // check if selected range is inside table + if + newColIndex < 0 + || newColIndex > lastColInd + || newRowIndex < 0 + || newRowIndex > lastRowInd + then None else - let value1 = (vals.[diff].values.Item 0) - value1.Item 0 - //sprintf "%A::> %A : %A : %A" value diff tableHeaderRangeColIndex selectColIndex + // is selected range is in table then take header value from selected column + tableRange.values.[0].[newColIndex] + // return header of selected col value ) ) -let fillValue (annotationTable,v,fillTerm:Shared.DbDomain.Term option) = +/// This is used to insert terms into. +/// 'term' is the value that will be written into the main column. +/// 'termBackground' needs to be spearate from 'term' in case the user uses the fill function for a custom term. +/// Should the user write a real term with this function 'termBackground'.isSome and can be used to fill TSR and TAN. +let fillValue (annotationTable,term,termBackground:Shared.DbDomain.Term option) = Excel.run(fun context -> + + // Ref. 2 let sheet = context.workbook.worksheets.getActiveWorksheet() - let annotationTable = sheet.tables.getItem(annotationTable) - //let annoRange = annotationTable.getDataBodyRange() - //let _ = annoRange.load(U2.Case2 (ResizeArray(["address";"values";"columnIndex"; "columnCount"]))) let range = context.workbook.getSelectedRange() - let _ = range.load(U2.Case2 (ResizeArray(["address";"values";"columnIndex"; "columnCount"]))) + let _ = range.load(U2.Case2 (ResizeArray(["values";"columnIndex"; "columnCount"]))) + /// This is for TSR and TAN let nextColsRange = range.getColumnsAfter 2. - let _ = nextColsRange.load(U2.Case2 (ResizeArray(["address";"values";"columnIndex";"columnCount"]))) + let _ = nextColsRange.load(U2.Case2 (ResizeArray(["values";"columnIndex";"columnCount"]))) + // Ref. 1 let r = context.runtime.load(U2.Case1 "enableEvents") //sync with proxy objects after loading values from excel context.sync().``then``( fun _ -> + + /// failwith if the number of selected columns is > 1. This is done due to hidden columns + /// and an overlapping reaction as we add values to the columns next to the selected one if range.columnCount > 1. then failwith "Cannot insert Terms in more than one column at a time." r.enableEvents <- false + // create new values for selected range let newVals = ResizeArray([ for arr in range.values do - let tmp = arr |> Seq.map (fun _ -> Some (v |> box)) + let tmp = arr |> Seq.map (fun _ -> Some (term |> box)) ResizeArray(tmp) ]) + // create values for TSR and TAN let nextNewVals = ResizeArray([ + // iterate over rows for ind in 0 .. nextColsRange.values.Count-1 do let tmp = nextColsRange.values.[ind] + // iterate over cols |> Seq.mapi (fun i _ -> - match i, fillTerm with + match i, termBackground with | 0, None | 1, None -> Some ("user-specific" |> box) | 1, Some term -> @@ -800,43 +784,54 @@ let fillValue (annotationTable,v,fillTerm:Shared.DbDomain.Term option) = ) ResizeArray(tmp) ]) - + // fill selected range with new values range.values <- newVals + // fill TSR and TAN with new values nextColsRange.values <- nextNewVals r.enableEvents <- true - //sprintf "%s filled with %s; ExtraCols: %s" range.address v nextColsRange.address + // return print msg sprintf "%A, %A" nextColsRange.values.Count nextNewVals ) ) - -let getInsertTermsToFillHiddenCols (annotationTable') = + +/// This is used to create a full representation of all building blocks in the table and return it to the app. +/// 'annotationTable'' gets passed by 'tryFindActiveAnnotationTable'. +let createSearchTermsFromTable (annotationTable') = Excel.run(fun context -> + + // Ref. 2 let sheet = context.workbook.worksheets.getActiveWorksheet() let annotationTable = sheet.tables.getItem(annotationTable') - let tables = annotationTable.columns.load(propertyNames = U2.Case2 (ResizeArray[|"items";"count"|])) let annoHeaderRange = annotationTable.getHeaderRowRange() - let _ = annoHeaderRange.load(U2.Case2 (ResizeArray [|"columnIndex"; "values"|])) |> ignore + let _ = annoHeaderRange.load(U2.Case2 (ResizeArray [|"columnIndex"; "values"; "columnCount"|])) |> ignore let annoBodyRange = annotationTable.getDataBodyRange() let _ = annoBodyRange.load(U2.Case2 (ResizeArray [|"values"|])) |> ignore + context.sync() .``then``( fun _ -> + /// Get the table by 'Columns [| Rows [|Values|] |]' let columnBodies = annoBodyRange.values |> viewRowsByColumns + + /// Write columns into 'BuildingBlockTypes.Column' let columns = [| - for i = 0 to (int tables.count - 1) do + // iterate over n of columns + for ind = 0 to (int annoHeaderRange.columnCount - 1) do yield ( - let ind = i + // Get column header and parse it let header = annoHeaderRange.values.[0].[ind] |> fun x -> if x.IsSome then parseColHeader (string annoHeaderRange.values.[0].[ind].Value) |> Some else None + // Get column values and write them to 'BuildingBlockTypes.Cell' let cells = columnBodies.[ind] |> Array.mapi (fun i cellVal -> let cellValue = if cellVal.IsSome then Some (string cellVal.Value) else None Cell.create i cellValue ) + // Create column Column.create ind header cells ) |] @@ -850,7 +845,7 @@ let getInsertTermsToFillHiddenCols (annotationTable') = nextCol.Header.Value.Header ) - /// Hidden columns do only come with certain core names. The acceptable names can be found in OfficeInterop.ColumnCoreNames. + /// Hidden columns do only come with certain core names. The acceptable names can be found in OfficeInterop.Types.ColumnCoreNames. let errorMsg2 (nextCol:Column) (buildingBlock:BuildingBlock option) = failwith ( sprintf @@ -873,13 +868,15 @@ let getInsertTermsToFillHiddenCols (annotationTable') = assignedCol ) + /// Update current building block with new reference column. A ref col can be TSR, TAN and unit cols. let checkForHiddenColType (currentBlock:BuildingBlock option) (nextCol:Column) = - // Then we need to check if the nextCol is either a TSR or a TAN column + // Then we need to check if the nextCol is either a TSR, TAN or a unit column match nextCol.Header.Value.CoreName.Value with | ColumnCoreNames.Hidden.TermAccessionNumber -> // Build in fail safes. if currentBlock.IsNone then errorMsg1 nextCol currentBlock if currentBlock.Value.TAN.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.TAN.Value.Header.Value.Header + // Update building block let updateCurrentBlock = { currentBlock.Value with TAN = Some nextCol } |> Some @@ -888,6 +885,7 @@ let getInsertTermsToFillHiddenCols (annotationTable') = // Build in fail safe. if currentBlock.IsNone then errorMsg1 nextCol currentBlock if currentBlock.Value.TSR.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.TSR.Value.Header.Value.Header + // Update building block let updateCurrentBlock = { currentBlock.Value with TSR = Some nextCol } |> Some @@ -895,16 +893,19 @@ let getInsertTermsToFillHiddenCols (annotationTable') = | ColumnCoreNames.Hidden.Unit -> // Build in fail safe. if currentBlock.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.MainColumn.Header.Value.Header + // Create unit building block let newBlock = BuildingBlock.create nextCol None None None |> Some newBlock | _ -> // Build in fail safe. errorMsg2 nextCol currentBlock - // building block are defined by one visuable column and an undefined number of hidden columns. + // Building blocks are defined by one visuable column and an undefined number of hidden columns. // Therefore we iterate through the columns array and use every column without an `#h` tag as the start of a new building block. let rec sortColsIntoBuildingBlocks (index:int) (currentBlock:BuildingBlock option) (buildingBlockList:BuildingBlock list) = - if index > (int tables.count - 1) then + // Exit case if we iterated through all columns + if index > (int annoHeaderRange.columnCount - 1) then + // Should we have a 'currentBuildingBlock' add it to the 'buildingBlockList' before returning it. if currentBlock.IsSome then currentBlock.Value::buildingBlockList else @@ -916,13 +917,13 @@ let getInsertTermsToFillHiddenCols (annotationTable') = nextCol.Header.IsNone then sortColsIntoBuildingBlocks (index+1) currentBlock buildingBlockList - // if the nextCol.Header has a tag array and it does NOT contain a hidden tag then it starts a new building block + // If the nextCol.Header has no tag array or its tag array does NOT contain a hidden tag then it starts a new building block elif (nextCol.Header.Value.TagArr.IsSome && nextCol.Header.Value.TagArr.Value |> Array.contains ColumnTags.HiddenTag |> not) || (nextCol.Header.IsSome && nextCol.Header.Value.TagArr.IsNone) then let newBuildingBlock = BuildingBlock.create nextCol None None None |> Some - // If there is a currentBlock we add it to the list of building blocks. + // If there is a 'currentBlock' we add it to the list of building blocks ('buildingBlockList'). if currentBlock.IsSome then sortColsIntoBuildingBlocks (index+1) newBuildingBlock (currentBlock.Value::buildingBlockList) // If there is no currentBuildingBlock, e.g. at the start of this function we replace the None with the first building block. @@ -939,7 +940,9 @@ let getInsertTermsToFillHiddenCols (annotationTable') = sortColsIntoBuildingBlocks (index+1) updateCurrentBlock buildingBlockList /// Next we check for unit columns in the scheme of `Unit [Term] (#h; #u...) | TSR [Term] (#h; #u...) | TAN [Term] (#h; #u...)` elif nextCol.Header.Value.TagArr.Value |> Array.exists (fun x -> x.StartsWith ColumnTags.UnitTagStart) then + /// Please notice that we update the unit building block in the following function and not the core building block. let updatedUnitBlock = checkForHiddenColType currentBlock.Value.Unit nextCol + /// Update the core building block with the updated unit building block. let updateCurrentBlock = {currentBlock.Value with Unit = updatedUnitBlock} |> Some sortColsIntoBuildingBlocks (index+1) updateCurrentBlock buildingBlockList else @@ -947,12 +950,13 @@ let getInsertTermsToFillHiddenCols (annotationTable') = else failwith (sprintf "The tag array of the next column to process in 'sortColsIntoBuildingBlocks' was not recognized as hidden or main column: %A." nextCol.Header) - // sort all columns into building blocks + /// Sort all columns into building blocks. let buildingBlocks = sortColsIntoBuildingBlocks 0 None [] |> List.rev |> Array.ofList + /// Filter for only building blocks with ontology (indicated by having a TSR and TAN). let buildingBlocksWithOntology = buildingBlocks |> Array.filter (fun x -> x.TSR.IsSome && x.TAN.IsSome) @@ -962,8 +966,8 @@ let getInsertTermsToFillHiddenCols (annotationTable') = |> Array.collect (fun bBlock -> // get current col index let tsrTanColIndices = [|bBlock.TSR.Value.Index; bBlock.TAN.Value.Index|] - let fillTermConstructsNoUnit bBlock= - // group cells by value so we don't get doubles + let fillTermConstructsNoUnit bBlock = + // group cells by value so we don't get doubles. bBlock.MainColumn.Cells |> Array.groupBy (fun cell -> cell.Value.IsSome, cell.Value.Value @@ -972,11 +976,14 @@ let getInsertTermsToFillHiddenCols (annotationTable') = |> Array.choose (fun ((isSome,searchStr),cellArr) -> if isSome && searchStr <> "" then let rowIndices = cellArr |> Array.map (fun cell -> cell.Index) - Shared.InsertTerm.create tsrTanColIndices searchStr rowIndices + Shared.SearchTermI.create tsrTanColIndices searchStr rowIndices |> Some else None ) + /// We differentiate between building blocks with and without unit as unit building blocks will not contain terms as values but e.g. numbers. + /// In this case we do not want to search the database for the cell values but the parent ontology in the header. + /// This will then be used for TSR and TAN. let fillTermConstructsWithUnit (bBlock:BuildingBlock) = let searchStr = bBlock.MainColumn.Header.Value.Ontology.Value let rowIndices = @@ -984,13 +991,14 @@ let getInsertTermsToFillHiddenCols (annotationTable') = |> Array.map (fun x -> x.Index ) - [|Shared.InsertTerm.create tsrTanColIndices searchStr rowIndices|] + [|Shared.SearchTermI.create tsrTanColIndices searchStr rowIndices|] if bBlock.Unit.IsSome then fillTermConstructsWithUnit bBlock else fillTermConstructsNoUnit bBlock ) + /// Create search types for the unit building blocks. let units = buildingBlocksWithOntology |> Array.filter (fun bBlock -> bBlock.Unit.IsSome) @@ -1000,55 +1008,70 @@ let getInsertTermsToFillHiddenCols (annotationTable') = let searchString = unit.MainColumn.Header.Value.Ontology.Value let colIndices = [|unit.MainColumn.Index; unit.TSR.Value.Index; unit.TAN.Value.Index|] let rowIndices = unit.MainColumn.Cells |> Array.map (fun x -> x.Index) - Shared.InsertTerm.create colIndices searchString rowIndices + Shared.SearchTermI.create colIndices searchString rowIndices ) + /// Combine search types let allSearches = [| yield! terms yield! units |] + /// Return the name of the table and all search types annotationTable',allSearches ) ) - -let fillHiddenColsByInsertTerm (annotationTable,insertTerms:InsertTerm []) = +/// This function will be executed after the SearchTerm types from 'createSearchTermsFromTable' where send to the server to search the database for them. +/// Here the results will be written into the table by the stored col and row indices. +let UpdateTableBySearchTerms (annotationTable,insertTerms:SearchTermI []) = Excel.run(fun context -> - let createCellValueInput str= + /// This will create a single cell value arr + let createCellValueInput str = ResizeArray([ ResizeArray([ str |> box |> Some ]) ]) + + // Ref. 2 let sheet = context.workbook.worksheets.getActiveWorksheet() let annotationTable = sheet.tables.getItem(annotationTable) let annoBodyRange = annotationTable.getDataBodyRange() let _ = annoBodyRange.load(U2.Case2 (ResizeArray [|"values"|])) |> ignore + + // Ref. 1 let r = context.runtime.load(U2.Case1 "enableEvents") context.sync(). ``then``(fun _ -> r.enableEvents <- false - + /// Filter for only terms which returned a result and therefore were not custom user input. let foundTerms = insertTerms |> Array.filter (fun x -> x.TermOpt.IsSome) + /// Insert terms into related cells for all stored row-/ col-indices let insert() = foundTerms + // iterate over all found terms |> Array.map ( fun insertTerm -> + /// Term search result from database let t = insertTerm.TermOpt.Value + /// Get ontology and accession from Term.Accession let ont, accession = let a = t.Accession let splitA = a.Split":" let accession = Shared.URLs.TermAccessionBaseUrl + a.Replace(":","_") splitA.[0], accession + /// Distinguish between core building blocks and unit buildingblocks. let inputVals = [| + /// if the n of cols is 2 then it is a core building block. if insertTerm.ColIndices.Length = 2 then createCellValueInput ont createCellValueInput accession + /// if the n of cols is 3 then it is a unit building block. elif insertTerm.ColIndices.Length = 3 then createCellValueInput t.Name createCellValueInput ont @@ -1074,34 +1097,42 @@ let fillHiddenColsByInsertTerm (annotationTable,insertTerms:InsertTerm []) = let _ = insert() r.enableEvents <- true + + // return print msg sprintf "Filled information for terms: %s" (foundTerms |> Array.map (fun x -> x.TermOpt.Value.Name) |> String.concat ", ") ) ) +/// This function is used to insert file names into the selected range. let insertFileNamesFromFilePicker (annotationTable, fileNameList:string list) = Excel.run(fun context -> - let sheet = context.workbook.worksheets.getActiveWorksheet() - //let annotationTable = sheet.tables.getItem(annotationTable) - //let annoRange = annotationTable.getDataBodyRange() - //let _ = annoRange.load(U2.Case2 (ResizeArray(["address";"values";"columnIndex"; "columnCount"]))) + + // Ref. 2 let range = context.workbook.getSelectedRange() - let _ = range.load(U2.Case2 (ResizeArray(["address";"values";"columnIndex"; "columnCount"]))) - //let nextColsRange = range.getColumnsAfter 2. - //let _ = nextColsRange.load(U2.Case2 (ResizeArray(["address";"values";"columnIndex";"columnCount"]))) + let _ = range.load(U2.Case2 (ResizeArray(["values";"columnIndex"; "columnCount"]))) + // Ref. 1 let r = context.runtime.load(U2.Case1 "enableEvents") //sync with proxy objects after loading values from excel context.sync().``then``( fun _ -> + if range.columnCount > 1. then failwith "Cannot insert Terms in more than one column at a time." r.enableEvents <- false + /// create new values for selected Range. let newVals = ResizeArray([ + // iterate over the rows of the selected range (there can only be one column as we fail if more are selected) for rowInd in 0 .. range.values.Count-1 do let tmp = + // Iterate over col values (1). range.values.[rowInd] |> Seq.map ( - fun col -> + // Ignore prevValue as it will be replaced anyways. + fun prevValue -> + /// This part is a design choice. + /// Should the user select less cells than we have items in the 'fileNameList' then we only fill the selected cells. + /// Should the user select more cells than we have items in the 'fileNameList' then we fill the leftover cells with none. let fileName = if fileNameList.Length-1 < rowInd then None else List.item rowInd fileNameList |> box |> Some fileName ) @@ -1111,11 +1142,12 @@ let insertFileNamesFromFilePicker (annotationTable, fileNameList:string list) = range.values <- newVals r.enableEvents <- true //sprintf "%s filled with %s; ExtraCols: %s" range.address v nextColsRange.address + + // return print msg sprintf "%A, %A" range.values.Count newVals ) ) - let getTableMetaData (annotationTable) = Excel.run (fun context -> let sheet = context.workbook.worksheets.getActiveWorksheet() @@ -1144,13 +1176,5 @@ let getTableMetaData (annotationTable) = ) ) -//let autoGetSelectedHeader () = -// Excel.run (fun context -> -// let sheet = context.workbook.worksheets.getActiveWorksheet() -// let annotationTable = sheet.tables.getItem("annotationTable") -// annotationTable.onSelectionChanged.add(fun e -> getParentOntology()) -// context.sync() -// ) - let syncContext (passthroughMessage : string) = Excel.run (fun context -> context.sync(passthroughMessage)) \ No newline at end of file diff --git a/src/Client/OfficeInterop/Types.fs b/src/Client/OfficeInterop/Types.fs index 67462443..e68c5bae 100644 --- a/src/Client/OfficeInterop/Types.fs +++ b/src/Client/OfficeInterop/Types.fs @@ -21,25 +21,29 @@ let Excel : Excel.IExports = jsNative [] let RangeLoadOptions : Interfaces.RangeLoadOptions = jsNative -module Subscription = - type Msg = - | TestSubscription of string + +// Testing Subscription +// https://elmish.github.io/elmish/subscriptions.html // elmish subscriptions +// https://docs.microsoft.com/de-de/office/dev/add-ins/develop/dialog-api-in-office-add-ins // office excel dialog +//module Subscription = +// type Msg = +// | TestSubscription of string - type Model = { - TestString : string - } +// type Model = { +// TestString : string +// } - let init () = { - TestString = "" - } +// let init () = { +// TestString = "" +// } - let update msg currentModel = - match msg with - | TestSubscription str -> - let nextModel = { - currentModel with TestString = str - } - nextModel, Cmd.none +// let update msg currentModel = +// match msg with +// | TestSubscription str -> +// let nextModel = { +// currentModel with TestString = str +// } +// nextModel, Cmd.none module ColumnCoreNames = @@ -85,6 +89,7 @@ module ColumnTags = module SwateInteropTypes = + /// Maybe this can be replaced with AutoFillTypes/ColUnit type ColumnRepresentation = { Header : string /// TODO: this is meant for future application and should be implemented together with separate unit columns @@ -105,6 +110,8 @@ module SwateInteropTypes = with static member + /// This function is used on an array of table names (string []). If the length of the array is <> 1 it will trough the correct error. + /// Only returns success if annoTables.Length = 1. Does not check if the existing table names are correct/okay. exactlyOneAnnotationTable (annoTables:string [])= match annoTables.Length with | x when x < 1 -> @@ -128,7 +135,7 @@ type ColHeader = { /// The types help to summarize and collect needed information about the column partitions (~ building block, e.g. 1 col for `Source Name`, /// 3 cols for standard `Parameter`, 6 cols for `Parameter` with unit). As excel allows to drag 'n drop values down for a column we need these types /// to find such occurrences and fill in the missing TSR, TAN and unit cols. -module AutoFillTypes = +module BuildingBlockTypes = type Cell = { Index: int diff --git a/src/Client/Update.fs b/src/Client/Update.fs index ccdc7551..689ed8ae 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -240,7 +240,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel | FillHiddenColsRequest activeTableNameRes -> let cmd name = Cmd.OfPromise.either - OfficeInterop.getInsertTermsToFillHiddenCols + OfficeInterop.createSearchTermsFromTable (name) (SearchForInsertTermsRequest >> Request >> Api) (fun e -> @@ -256,7 +256,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel | FillHiddenColumns (tableName,insertTerms) -> let cmd = Cmd.OfPromise.either - OfficeInterop.fillHiddenColsByInsertTerm + OfficeInterop.UpdateTableBySearchTerms (tableName,insertTerms) (fun msg -> Msg.Batch [ diff --git a/src/Shared/Shared.fs b/src/Shared/Shared.fs index aa9dfe21..52ac36d3 100644 --- a/src/Shared/Shared.fs +++ b/src/Shared/Shared.fs @@ -106,7 +106,7 @@ module DbDomain = } /// used in OfficeInterop to effectively find possible Term names and search for them in db -type InsertTerm = { +type SearchTermI = { ColIndices : int [] SearchString : string RowIndices : int [] @@ -146,7 +146,7 @@ type IAnnotatorAPIv1 = { getUnitTermSuggestions : (int*string) -> Async - getTermsByNames : InsertTerm [] -> Async + getTermsByNames : SearchTermI [] -> Async } \ No newline at end of file From f6564d65c9985c82cbad3b482792e94379a7b34b Mon Sep 17 00:00:00 2001 From: Kevin F Date: Wed, 16 Dec 2020 11:50:15 +0100 Subject: [PATCH 02/10] Add search term search by accession number (Issue #71). --- src/Client/AuxFunctions.fs | 9 -- src/Client/Client.fsproj | 1 - src/Client/OfficeInterop/Regex.fs | 8 +- src/Server/Docs/DocsAnnotationAPIvs1.fs | 21 +++-- src/Server/Docs/DocsFunctions.fs | 4 +- src/Server/OntologyDB.fs | 46 +++++++--- src/Server/Server.fs | 106 +++++++++++------------- src/Shared/Shared.fs | 12 ++- 8 files changed, 115 insertions(+), 92 deletions(-) delete mode 100644 src/Client/AuxFunctions.fs diff --git a/src/Client/AuxFunctions.fs b/src/Client/AuxFunctions.fs deleted file mode 100644 index d34561c2..00000000 --- a/src/Client/AuxFunctions.fs +++ /dev/null @@ -1,9 +0,0 @@ -module AuxFunctions - -open System.Text.RegularExpressions - -/// (|Regex|_|) pattern input -let (|Regex|_|) pattern input = - let m = Regex.Match(input, pattern) - if m.Success then Some(m.Value) - else None diff --git a/src/Client/Client.fsproj b/src/Client/Client.fsproj index f2d72334..aed59c40 100644 --- a/src/Client/Client.fsproj +++ b/src/Client/Client.fsproj @@ -9,7 +9,6 @@ - diff --git a/src/Client/OfficeInterop/Regex.fs b/src/Client/OfficeInterop/Regex.fs index 16bc59be..297ed941 100644 --- a/src/Client/OfficeInterop/Regex.fs +++ b/src/Client/OfficeInterop/Regex.fs @@ -21,7 +21,7 @@ let UnitAccessionPattern = "#u.+?:\d+" let parseSquaredBrackets (headerStr:string) = match headerStr with - | AuxFunctions.Regex SquaredBracketsPattern value -> + | Shared.HelperFunctions.Regex SquaredBracketsPattern value -> // remove brackets value.[1..value.Length-2] |> Some @@ -30,7 +30,7 @@ let parseSquaredBrackets (headerStr:string) = let parseBrackets (headerStr:string) = match headerStr with - | AuxFunctions.Regex BracketsPattern value -> + | Shared.HelperFunctions.Regex BracketsPattern value -> value // remove brackets .[1..value.Length-2] @@ -43,7 +43,7 @@ let parseBrackets (headerStr:string) = let parseCoreName (headerStr:string) = match headerStr with - | AuxFunctions.Regex CoreNamePattern value -> + | Shared.HelperFunctions.Regex CoreNamePattern value -> value.Trim() |> Some | _ -> @@ -51,7 +51,7 @@ let parseCoreName (headerStr:string) = let parseUnitAccession (tag:string) = match tag with - | AuxFunctions.Regex UnitAccessionPattern value -> + | Shared.HelperFunctions.Regex UnitAccessionPattern value -> value.Trim() |> Some | _ -> diff --git a/src/Server/Docs/DocsAnnotationAPIvs1.fs b/src/Server/Docs/DocsAnnotationAPIvs1.fs index d23e47b5..64917594 100644 --- a/src/Server/Docs/DocsAnnotationAPIvs1.fs +++ b/src/Server/Docs/DocsAnnotationAPIvs1.fs @@ -94,7 +94,9 @@ let annotatorApiDocsv1 = |> ParamArray createDocumentationDescription "This function is used to search the Database for Terms by querystring'. It returns n results." - "getTermSuggestions is used to search Terms without parent ontology, unit terms and AddBuildingBlock terms." + "getTermSuggestions is used to search Terms without parent ontology and AddBuildingBlock terms. + From release 0.1.4 onwards this function will try to parse the querystring to a Term.Accession value. + If successful it will search the database for Term.Accession = querystring, allowing a search by accession number." (Some [| (Parameter.create "n" ParamInteger "This parameter sets the number of returned results." ) (Parameter.create "queryString" ParamString "This parameter is used to search the Term.Name Column for hits." ) @@ -127,7 +129,7 @@ let annotatorApiDocsv1 = |> annotatorDocsv1.description ( createDocumentationDescription - "This is a getTermSuggestions advanced search variant, which can be used to search for specific Terms that might not show up in the top 5 results of the normal term search." + "getTermsForAdvancedSearch) can be used to search for specific Terms that might not show up in the top 5 results of the normal term search." "Should a user not be able to find his term of interest, the term suggestions dropdown below the searchfield allows the user to switch to advanced term search." (Some [| Parameter.create "OntologyOption" (ParamOption PredefinedParams.OntologyType) "This parameter can be used to search only in a specific ontology." @@ -170,16 +172,17 @@ let annotatorApiDocsv1 = |> annotatorDocsv1.alias "Get Unit Terms (getTermsByNames)" |> annotatorDocsv1.description ( createDocumentationDescription - "This function uses the given InsertTerm [] to try and find one search result for each member of InsertTerm [] for the InsertTerm.SearchString on Term.Name in the database. - The search result is then passed into the same InsertTerm type as InsertTerm.TermOpt and returned to the client." + "This function uses the given SearchTermI [] to try and find one search result for each member of SearchTermI [] for the + SearchTermI.SearchString on Term.Name in the database. + The search result is then passed into the same SearchTerm type as SearchTermI.TermOpt and returned to the client." "getTermsByNames is used to find Terms in the database that fit the entries in the excel annotation table. The necessary information (col-, row-index - is stored in the InsertTerm type. One array element for each distinct value found in the table." + is stored in the SearchTermI type. One array element for each distinct value found in the table." (Some [| - Parameter.create "InsertTerm []" (PredefinedParams.InsertTermType |> ParameterType.ParamArray) "" + Parameter.create "SearchTermI []" (PredefinedParams.SearchTermType |> ParameterType.ParamArray) "" |]) - "Returns the parameter array posted to it with the search result in InsertTerm.TermOpt." - (Parameter.create "InsertTerm []" (PredefinedParams.InsertTermType |> ParameterType.ParamArray) "") + "Returns the parameter array posted to it with the search result in SearchTerm.TermOpt." + (Parameter.create "SearchTermI []" (PredefinedParams.SearchTermType |> ParameterType.ParamArray) "") ) - |> annotatorDocsv1.example <@ fun api -> api.getTermsByNames ([|PredefinedParams.Examples.insertTermExmp|]) @> + |> annotatorDocsv1.example <@ fun api -> api.getTermsByNames ([|PredefinedParams.Examples.searchTermExmp|]) @> ] diff --git a/src/Server/Docs/DocsFunctions.fs b/src/Server/Docs/DocsFunctions.fs index d1dfe91e..c6105825 100644 --- a/src/Server/Docs/DocsFunctions.fs +++ b/src/Server/Docs/DocsFunctions.fs @@ -108,7 +108,7 @@ module PredefinedParams = dbdomaniOntologyParamArr |> ParamRecordType - let InsertTermType = + let SearchTermType = let insertTermParamArr = [| Parameter.create "ColIndices" (ParamArray ParamInteger) "" Parameter.create "SearchString" (ParamString) "" @@ -129,7 +129,7 @@ module PredefinedParams = UserID = "gkoutos" } - let insertTermExmp:InsertTerm = { + let searchTermExmp:SearchTermI = { ColIndices = [|2; 3|] SearchString = "Bruker Daltonics HCT Series" RowIndices = [|0 .. 10|] diff --git a/src/Server/OntologyDB.fs b/src/Server/OntologyDB.fs index 950d2779..e63bc4fb 100644 --- a/src/Server/OntologyDB.fs +++ b/src/Server/OntologyDB.fs @@ -177,12 +177,12 @@ let getUnitTermSuggestions cString (query:string) = (reader.GetBoolean(6)) |] -let getTermByName cString (query:InsertTerm) = +let getTermByName cString (queryStr:string) = use connection = establishConnection cString connection.Open() - use getTermByNameCmd = new MySqlCommand("getUnitTermSuggestions",connection) + use getTermByNameCmd = connection.CreateCommand() getTermByNameCmd .CommandText <- """ SELECT * FROM Term WHERE Term.Name = @name @@ -190,12 +190,11 @@ let getTermByName cString (query:InsertTerm) = let queryParam = getTermByNameCmd.Parameters.Add("name",MySqlDbType.VarChar) - queryParam.Value <- query.SearchString + queryParam.Value <- queryStr use reader = getTermByNameCmd.ExecuteReader() - let termOpt = - match reader.Read() with - | true -> + [| + while reader.Read() do DbDomain.createTerm (reader.GetInt64(0)) (reader.GetString(1)) @@ -207,12 +206,39 @@ let getTermByName cString (query:InsertTerm) = else Some (reader.GetString(5))) (reader.GetBoolean(6)) - |> Some - | false -> - None - {query with TermOpt = termOpt} + |] +let getTermByAccession cString (queryStr:string) = + + use connection = establishConnection cString + connection.Open() + use cmd = connection.CreateCommand() + cmd + .CommandText <- """ + SELECT * FROM Term WHERE Term.Accession = @accession + """ + + let queryParam = cmd.Parameters.Add("accession",MySqlDbType.VarChar) + + queryParam.Value <- queryStr + + use reader = cmd.ExecuteReader() + [| + while reader.Read() do + yield + DbDomain.createTerm + (reader.GetInt64(0)) + (reader.GetString(1)) + (reader.GetInt64(2)) + (reader.GetString(3)) + (reader.GetString(4)) + (if (reader.IsDBNull(5)) then + None + else + Some (reader.GetString(5))) + (reader.GetBoolean(6)) + |] let getAllOntologies cString () = diff --git a/src/Server/Server.fs b/src/Server/Server.fs index f99362b0..ace1f9f3 100644 --- a/src/Server/Server.fs +++ b/src/Server/Server.fs @@ -16,17 +16,10 @@ open Microsoft.Extensions.Configuration.Json open Microsoft.Extensions.Configuration.UserSecrets open Microsoft.AspNetCore.Hosting -//let connectionString = System.Environment.GetEnvironmentVariable("AnnotatorTestDbCS") +/// Was transferred into dev.json //[] //let DevLocalConnectionString = "server=127.0.0.1;user id=root;password=example; port=42333;database=SwateDB;allowuservariables=True;persistsecurityinfo=True" - -/// Showcase of how versioning could work -let testApi = { - //Development - getTestNumber = fun () -> async { return 42 } - } - let serviceApi = { getAppVersion = fun () -> async {return System.AssemblyVersionInformation.AssemblyVersion} } @@ -63,30 +56,40 @@ let annotatorApi cString = { // Term related requests getTermSuggestions = fun (max:int,typedSoFar:string) -> async { - let like = OntologyDB.getTermSuggestions cString typedSoFar - let searchSet = typedSoFar |> Suggestion.createBigrams - - return - like - |> Array.sortByDescending (fun sugg -> - Suggestion.sorensenDice (Suggestion.createBigrams sugg.Name) searchSet - ) + let searchRes = + match typedSoFar with + | HelperFunctions.Regex HelperFunctions.isAccessionPattern foundAccession -> + OntologyDB.getTermByAccession cString foundAccession + | _ -> + let like = OntologyDB.getTermSuggestions cString typedSoFar + let searchSet = typedSoFar |> Suggestion.createBigrams + like + |> Array.sortByDescending (fun sugg -> + Suggestion.sorensenDice (Suggestion.createBigrams sugg.Name) searchSet + ) - |> fun x -> x |> Array.take (if x.Length > max then max else x.Length) + |> fun x -> x |> Array.take (if x.Length > max then max else x.Length) + return searchRes } getTermSuggestionsByParentTerm = fun (max:int,typedSoFar:string,parentTerm:string) -> async { - let like = OntologyDB.getTermSuggestionsByParentTerm cString (typedSoFar,parentTerm) - let searchSet = typedSoFar |> Suggestion.createBigrams - return - like - |> Array.sortByDescending (fun sugg -> - Suggestion.sorensenDice (Suggestion.createBigrams sugg.Name) searchSet - ) - - |> fun x -> x |> Array.take (if x.Length > max then max else x.Length) + let searchRes = + match typedSoFar with + | HelperFunctions.Regex HelperFunctions.isAccessionPattern foundAccession -> + OntologyDB.getTermByAccession cString foundAccession + | _ -> + let like = OntologyDB.getTermSuggestionsByParentTerm cString (typedSoFar,parentTerm) + let searchSet = typedSoFar |> Suggestion.createBigrams + like + |> Array.sortByDescending (fun sugg -> + Suggestion.sorensenDice (Suggestion.createBigrams sugg.Name) searchSet + ) + + |> fun x -> x |> Array.take (if x.Length > max then max else x.Length) + + return searchRes } getTermsForAdvancedSearch = fun (ontOpt,searchName,mustContainName,searchDefinition,mustContainDefinition,keepObsolete) -> @@ -98,35 +101,34 @@ let annotatorApi cString = { getUnitTermSuggestions = fun (max:int,typedSoFar:string) -> async { - let like = OntologyDB.getUnitTermSuggestions cString typedSoFar - let searchSet = typedSoFar |> Suggestion.createBigrams - - return - like - |> Array.sortByDescending (fun sugg -> - Suggestion.sorensenDice (Suggestion.createBigrams sugg.Name) searchSet - ) + let searchRes = + match typedSoFar with + | HelperFunctions.Regex HelperFunctions.isAccessionPattern foundAccession -> + OntologyDB.getTermByAccession cString foundAccession + | _ -> + let like = OntologyDB.getUnitTermSuggestions cString typedSoFar + let searchSet = typedSoFar |> Suggestion.createBigrams + like + |> Array.sortByDescending (fun sugg -> + Suggestion.sorensenDice (Suggestion.createBigrams sugg.Name) searchSet + ) - |> fun x -> x |> Array.take (if x.Length > max then max else x.Length) + |> fun x -> x |> Array.take (if x.Length > max then max else x.Length) + + return searchRes } getTermsByNames = fun (queryArr) -> async { - let result = queryArr |> Array.map (OntologyDB.getTermByName cString) + let result = + queryArr |> Array.map (fun searchTerm -> + let searchRes = OntologyDB.getTermByName cString searchTerm.SearchString + {searchTerm with TermOpt = if Array.isEmpty searchRes then None else searchRes |> Array.head |> Some } + ) return result } } -let testWebApp = - Remoting.createApi() - |> Remoting.withRouteBuilder Route.builder - |> Remoting.fromValue testApi - |> Remoting.withDiagnosticsLogger(printfn "%A") - |> Remoting.withErrorHandler( - (fun x y -> Propagate (sprintf "[SERVER SIDE ERROR]: %A @ %A" x y)) - ) - |> Remoting.buildHttpHandler - let createIServiceAPIv1 = Remoting.createApi() |> Remoting.withRouteBuilder Route.builder @@ -149,6 +151,8 @@ let createIAnnotatorApiv1 cString = ) |> Remoting.buildHttpHandler + +/// due to a bug in Fable.Remoting this does currently not work as inteded and is ignored. (https://github.com/Zaid-Ajaj/Fable.Remoting/issues/198) let mainApiController = router { // @@ -159,11 +163,6 @@ let mainApiController = router { createIAnnotatorApiv1 cString next ctx ) - // - forward @"/ITestAPI" (fun next ctx -> - testWebApp next ctx - ) - // forward @"/IServiceAPIv1" (fun next ctx -> createIServiceAPIv1 next ctx @@ -180,11 +179,6 @@ let topLevelRouter = router { createIAnnotatorApiv1 cString next ctx ) - // - forward @"" (fun next ctx -> - testWebApp next ctx - ) - // forward @"" (fun next ctx -> createIServiceAPIv1 next ctx diff --git a/src/Shared/Shared.fs b/src/Shared/Shared.fs index 52ac36d3..6438f869 100644 --- a/src/Shared/Shared.fs +++ b/src/Shared/Shared.fs @@ -32,7 +32,17 @@ module URLs = [] let CSBWebsiteUrl = @"https://csb.bio.uni-kl.de/" -type Counter = { Value : int } +module HelperFunctions = + + open System.Text.RegularExpressions + + /// (|Regex|_|) pattern input + let (|Regex|_|) pattern input = + let m = Regex.Match(input, pattern) + if m.Success then Some(m.Value) + else None + + let isAccessionPattern = "^[a-zA-Z]+:[0-9]+$" module Route = /// Defines how routes are generated on server and mapped from client From 889b86c466c454e736daf950ac0df4f77dcb6355 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Wed, 16 Dec 2020 12:17:36 +0100 Subject: [PATCH 03/10] Fix file picker not uploading reoccuring file names (Issue #80). --- src/Client/Views/FilePickerView.fs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Client/Views/FilePickerView.fs b/src/Client/Views/FilePickerView.fs index edba1ed1..b425b20c 100644 --- a/src/Client/Views/FilePickerView.fs +++ b/src/Client/Views/FilePickerView.fs @@ -42,14 +42,17 @@ let createFileList (model:Model) (dispatch: Msg -> unit) = ] let filePickerComponent (model:Model) (dispatch:Msg -> unit) = + let inputId = "filePicker_OnFilePickerMainFunc" Content.content [ Content.Props [colorControl model.SiteStyleState.ColorMode ]] [ Label.label [Label.Size Size.IsLarge; Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]][ str "File Picker"] File.file [] [ File.label [] [ File.input [ Props [ + Id inputId Multiple true OnChange (fun ev -> + let files : FileList = ev.target?files let fileNames = @@ -57,6 +60,10 @@ let filePickerComponent (model:Model) (dispatch:Msg -> unit) = |> List.map (fun f -> f.name) fileNames |> NewFilesLoaded |> FilePicker |> dispatch + + let picker = Browser.Dom.document.getElementById(inputId) + // https://stackoverflow.com/questions/3528359/html-input-type-file-file-selection-event/3528376 + picker?value <- null ) ] ] From f3a11f0257f5d7d25a67dfdb85700903573d9ec1 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Fri, 18 Dec 2020 10:20:21 +0100 Subject: [PATCH 04/10] Update FilePicker with reordering functionality (Issue #13). --- src/Client/Messages.fs | 5 +- src/Client/Model.fs | 7 +- src/Client/OfficeInterop/OfficeInterop.fs | 1 + src/Client/Update.fs | 20 +- src/Client/Views/FilePickerView.fs | 435 ++++++++++++++++++++-- src/Client/style.scss | 5 + 6 files changed, 433 insertions(+), 40 deletions(-) diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index e1c1794c..93cb6828 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -109,8 +109,9 @@ type PersistentStorageMsg = | UpdateAppVersion of string type FilePickerMsg = - | NewFilesLoaded of string list - | RemoveFileFromFileList of string + | LoadNewFiles of string list + | UpdateFileNames of newFileNames:(int*string) list + | UpdateDNDDropped of isDropped:bool type AddBuildingBlockMsg = | NewBuildingBlockSelected of AnnotationBuildingBlock diff --git a/src/Client/Model.fs b/src/Client/Model.fs index df5ff3a6..cc9d6636 100644 --- a/src/Client/Model.fs +++ b/src/Client/Model.fs @@ -210,10 +210,15 @@ type PageState = { } type FilePickerState = { - FileNames : string list + FileNames : (int*string) list + /// Used for drag and drop, to determine if something is currently dragged or not. + /// Necessary to deactivate pointer events on children during drag. + DNDDropped : bool } with static member init () = { FileNames = [] + /// This is used to deactivate pointerevents of drag and drop childs during drag and drop + DNDDropped = true } diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index fa74e6aa..de73715a 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -1140,6 +1140,7 @@ let insertFileNamesFromFilePicker (annotationTable, fileNameList:string list) = ]) range.values <- newVals + range.format.autofitColumns() r.enableEvents <- true //sprintf "%s filled with %s; ExtraCols: %s" range.address v nextColsRange.address diff --git a/src/Client/Update.fs b/src/Client/Update.fs index 689ed8ae..445448b0 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -923,22 +923,24 @@ let handleStyleChangeMsg (styleChangeMsg:StyleChangeMsg) (currentState:SiteStyle let handleFilePickerMsg (filePickerMsg:FilePickerMsg) (currentState: FilePickerState) : FilePickerState * Cmd = match filePickerMsg with - | NewFilesLoaded fileNames -> + | LoadNewFiles fileNames -> + let nextState = { + FilePickerState.init() with + FileNames = fileNames |> List.mapi (fun i x -> i+1,x) + } + let nextCmd = UpdatePageState (Some Routing.Route.FilePicker) |> Cmd.ofMsg + nextState, nextCmd + | UpdateFileNames newFileNames -> let nextState = { currentState with - FileNames = fileNames + FileNames = newFileNames } - nextState, Cmd.none - - | RemoveFileFromFileList fileName -> + | UpdateDNDDropped isDropped -> let nextState = { currentState with - FileNames = - currentState.FileNames - |> List.filter (fun fn -> not (fn = fileName)) + DNDDropped = isDropped } - nextState, Cmd.none let handleAddBuildingBlockMsg (addBuildingBlockMsg:AddBuildingBlockMsg) (currentState: AddBuildingBlockState) : AddBuildingBlockState * Cmd = diff --git a/src/Client/Views/FilePickerView.fs b/src/Client/Views/FilePickerView.fs index b425b20c..4e16106e 100644 --- a/src/Client/Views/FilePickerView.fs +++ b/src/Client/Views/FilePickerView.fs @@ -16,30 +16,403 @@ 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] - ] +//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" + +[] +let fileTileHeightHalfed = "25px" - ]) +[] +let fileElementContainerId = "File_Element_Container_DragAndDrop" + +let getNewOrder dragDown dragUp dragEleOrder droppedOnEleOrder changeEleOrder = + if dragDown then + if changeEleOrder < dragEleOrder + then + changeEleOrder + elif changeEleOrder > droppedOnEleOrder + then + changeEleOrder + elif changeEleOrder = dragEleOrder + then + droppedOnEleOrder + elif changeEleOrder > dragEleOrder && changeEleOrder <= droppedOnEleOrder + then + changeEleOrder - 1 + else + failwith ( + sprintf + "Found unknown combination for reordering list elements: + dragEleOrder: %i + droppedOnEleOrder: %i" + dragEleOrder droppedOnEleOrder + ) + elif dragUp then + if changeEleOrder < droppedOnEleOrder + then + changeEleOrder + elif changeEleOrder > dragEleOrder + then + changeEleOrder + elif changeEleOrder >= droppedOnEleOrder && changeEleOrder < dragEleOrder + then + changeEleOrder + 1 + elif changeEleOrder = dragEleOrder + then + droppedOnEleOrder + else + failwith ( + sprintf + "Found unknown combination for reordering list elements: + dragEleOrder: %i + droppedOnEleOrder: %i" + dragEleOrder droppedOnEleOrder + ) else - [ - tr [] [ - td [] [str "No Files selected."] - ] + failwith "Unknown pattern 0.2" + +let createEleId id = sprintf "draggable_filePickerEle_%s" id +let createWrapperId id = sprintf "wrapper_filerPickerEle_%s" id +let createCloneId id = sprintf "draggable_filePickerEle_%s_Clone" id + +let mutable coordinates : {|x:float; y:float|} option = None +let mutable dropped: bool = true +let mutable mustUpdateModel: bool = false + +let dragAndDropClone (model:Model) dispatch id = + let cloneId = createCloneId id + let eleId = createEleId id + let clone() = Browser.Dom.document.getElementById(cloneId) + let child() = Browser.Dom.document.getElementById(eleId) + div [ + Id cloneId + Style [ + Cursor "pointer"; + Padding "1rem 1.5rem"; + Position PositionOptions.Absolute + Opacity "0" + Visibility "hidden" + PointerEvents "none" + ZIndex 2 + ] + Class "clone" + + OnTransitionEnd (fun eve -> + if eve.propertyName = "top" + then + let clone = clone() + if mustUpdateModel then + //printfn "trigger model reorder" + printfn "prev list: %A" model.FilePickerState.FileNames + // Update model list + let newList = + [ + for ind,name in model.FilePickerState.FileNames do + yield ( + let wrapperId = createWrapperId name + let wrapper = Browser.Dom.document.getElementById(wrapperId) + let wrapperOrder = wrapper?style?order + //printfn "trigger reorder model %i -> %i,%s" ind (int wrapperOrder) name + wrapper?style?order <- 0 + int wrapperOrder,name + + ) + ] |> fun updatedOrderList -> + let sortedList = List.sortBy fst updatedOrderList + printfn "next list: %A" sortedList + UpdateFileNames ( sortedList ) |> FilePicker |> dispatch + mustUpdateModel <- false + clone?style?opacity <- 0 + //clone?style?visibility <- "hidden" + clone?style?transition <- "all 0s ease 0s" + child()?style?display <- "block" + else + clone?style?opacity <- 0 + //clone?style?visibility <- "hidden" + clone?style?transition <- "all 0s ease 0s" + child()?style?display <- "block" + + ) + ][ + Delete.delete [ + Delete.Props [ Style [ + MarginRight "2rem" + ]] + ][] + let fileName = model.FilePickerState.FileNames |> List.find (fun (ind,name) -> id = name) |> snd + str (sprintf "%s" fileName) + ] + +let findIndByFileName (model:Model) id= + model.FilePickerState.FileNames |> List.find (fun (ind,name) -> name = id) |> fst + +let dragAndDropElement (model:Model) (dispatch: Msg -> unit) id = + let eleId = createEleId id + let wrapperId = createWrapperId id + let cloneId = createCloneId id + let parent() = Browser.Dom.document.getElementById(wrapperId) + let child() = Browser.Dom.document.getElementById(eleId) + let clone() = Browser.Dom.document.getElementById(cloneId) + // tile + div [ + Id eleId + Style [ + Cursor "pointer"; + Padding "1rem 1.5rem"; + Position PositionOptions.Relative ] + Draggable true + OnDragStart (fun eve -> + dropped <- false + UpdateDNDDropped false |> FilePicker |> dispatch + + eve.stopPropagation() + let offset = child().getBoundingClientRect() + let windowScrollY = Browser.Dom.window.scrollY + parent()?style?height <- "0px" + // Display none child + child()?style?display <- "none" + let clone = clone() + let x = offset.left + let y = offset.top + windowScrollY - offset.height + clone?style?left <- sprintf "%.0fpx" x + clone?style?top <- sprintf "%.0fpx" y + coordinates <- Some {|x = x; y = y|} + clone?style?opacity <- 1 + clone?style?visibility <- "unset" + // https://www.digitalocean.com/community/tutorials/js-drag-and-drop-vanilla-js + let set = + eve + .dataTransfer + .setData("text/plain", id) + () + ) + OnDragOver(fun e -> e.preventDefault()) + OnDrag (fun eve -> + let clone = clone() + let offset = clone.getBoundingClientRect() + let x = eve.pageX - (offset.width * 0.5) + let y = eve.pageY - (1.5 * offset.height) + clone?style?left <- sprintf "%.0fpx" x + clone?style?top <- sprintf "%.0fpx" y + ) + OnDragEnter (fun eve -> + eve.stopPropagation() + eve.preventDefault() + eve.target?style?backgroundColor <- "lightgrey" + eve.target?style?borderBottom <- "0.5px solid darkgrey") + OnDragLeave (fun eve -> + eve.preventDefault() + eve.target?style?backgroundColor <- "white" + eve.target?style?borderBottom <- "0px solid darkgrey") + OnDragEnd (fun eve -> + // restore wrapper + parent()?style?height <- fileTileHeight + let slideClone = + if coordinates.IsNone then failwith "Unknown Drag and Drop pattern 0.2" + if dropped then + () + else + let clone = clone() + clone?style?transition <- "0.5s ease" + clone?style?left <- sprintf "%.0fpx" coordinates.Value.x + clone?style?top <- sprintf "%.0fpx" coordinates.Value.y + coordinates <- None + dropped <- true + UpdateDNDDropped true |> FilePicker |> dispatch + () + ) + OnDrop (fun eve -> + //eve.stopPropagation() + eve.preventDefault() + dropped <- true + UpdateDNDDropped true |> FilePicker |> dispatch + eve.target?style?backgroundColor <- "white" + eve.target?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 + //parent()?style?order + findIndByFileName model id + elif dragUp then + let pOrder = findIndByFileName model id //parent()?style?order + (int pOrder) + 1 + else failwith "Unknown Pattern 0.1" + + let updateOrder = + for ind,fileName in model.FilePickerState.FileNames do + let w = Browser.Dom.document.getElementById(createWrapperId fileName) + w?style?order <- ind + let changeEleOrder = ind //w?style?order + let newOrder = + getNewOrder dragDown dragUp dragEleOrder droppenOnEleOrder changeEleOrder + //printfn "dragEleOrder %i, droppedOnEleOrder %i, changeEleOrder %i, newOrder: %i" dragEleOrder droppenOnEleOrder changeEleOrder newOrder + w?style?order <- newOrder + //printfn "trigger reorderList for: %i -> %i,%s" ind newOrder fileName + + mustUpdateModel <- true + prevWrapper?style?height <- fileTileHeight + + let cloneSlide = + let offset = prevWrapper.getBoundingClientRect() + let windowScrollY = Browser.Dom.window.scrollY + let clone = prevClone + + let x = offset.left + let y = offset.top + windowScrollY - 50. + clone?style?transition <- "0.5s ease" + clone?style?left <- sprintf "%.0fpx" x + clone?style?top <- sprintf "%.0fpx" y + () + ) + ][ + Delete.delete [ + Delete.OnClick (fun _ -> + let newList = + model.FilePickerState.FileNames + |> List.sortBy fst + |> List.map snd + |> List.filter (fun name -> name <> id) + |> List.mapi (fun i name -> i+1,name) + newList |> UpdateFileNames |> FilePicker |> dispatch + ) + Delete.Props [ Style [ + if dropped = false then PointerEvents "none" + MarginRight "2rem" + ]] + ][] + str (sprintf "%s" id) + Icon.icon [Icon.Props [Style [Float FloatOptions.Right; Color "darkgrey"]]][ + Fa.i [ Fa.Solid.ArrowsAlt][] + ] + ] + + +let fileElement (model:Model) dispatch (id:string) = + let wrapperId = createWrapperId id + let order = model.FilePickerState.FileNames |> List.find (fun (ind,name) -> name = id) |> fst + // wrapper + // https://codepen.io/osublake/pen/XJQKVX + div [ + Id wrapperId + Style [ + Height fileTileHeight + Transition "0.5s ease" + Order 0 + ] + OnDragOver(fun e -> e.preventDefault()) + ][ + dragAndDropElement model dispatch id + ] + +let placeOnTopElement model dispatch = + div [ + OnDragOver(fun e -> e.preventDefault()) + OnDragEnter (fun eve -> + eve.stopPropagation() + eve.preventDefault() + eve.target?style?borderBottom <- "2px solid darkgrey") + OnDragLeave (fun eve -> + eve.preventDefault() + eve.target?style?borderBottom <- "2px solid white") + OnDrop (fun eve -> + eve.preventDefault() + eve.target?style?borderBottom <- "2px solid white" + dropped <- true + UpdateDNDDropped true |> FilePicker |> dispatch + let prevId = eve.dataTransfer.getData("text") + let prevWrapper = Browser.Dom.document.getElementById(createWrapperId prevId) + let prevClone = Browser.Dom.document.getElementById(createCloneId prevId) + //printfn "prev id: %i" prevId + + // always position at position 1 + let droppedOnEleOrder = 1 + let dragEleOrder = findIndByFileName model prevId + //printfn "up: %b, down: %b" dragUp dragDown + + let updateOrder = + for ind,fileName in model.FilePickerState.FileNames do + let w = Browser.Dom.document.getElementById(createWrapperId fileName) + w?style?order <- ind + let changeEleOrder = ind //w?style?order + let newOrder = + getNewOrder false true dragEleOrder droppedOnEleOrder changeEleOrder + //printfn "dragEleOrder %i, droppedOnEleOrder %i, changeEleOrder %i, newOrder: %i" dragEleOrder droppenOnEleOrder changeEleOrder newOrder + w?style?order <- newOrder + //printfn "trigger reorderList for: %i -> %i,%s" ind newOrder fileName + + mustUpdateModel <- true + prevWrapper?style?height <- fileTileHeight + + let cloneSlide = + let offset = prevWrapper.getBoundingClientRect() + let windowScrollY = Browser.Dom.window.scrollY + let clone = prevClone + + let x = offset.left + let y = offset.top + windowScrollY - 50. + clone?style?transition <- "0.5s ease" + clone?style?left <- sprintf "%.0fpx" x + clone?style?top <- sprintf "%.0fpx" y + () + ) + Style [ + Height fileTileHeightHalfed + Order "-1" + BorderBottom "2px solid white" + ] + ][ + ] + +let fileElementContainer (model:Model) dispatch = + div [ + Style [Display DisplayOptions.Flex; FlexDirection "column"] + Id fileElementContainerId + ][ + yield + placeOnTopElement model dispatch + for ind,ele in model.FilePickerState.FileNames do + yield + fileElement model dispatch (ele) + yield + dragAndDropClone model dispatch (ele) + ] let filePickerComponent (model:Model) (dispatch:Msg -> unit) = let inputId = "filePicker_OnFilePickerMainFunc" @@ -59,12 +432,12 @@ let filePickerComponent (model:Model) (dispatch:Msg -> unit) = [ for i=0 to (files.length - 1) do yield files.item i ] |> List.map (fun f -> f.name) - fileNames |> NewFilesLoaded |> FilePicker |> dispatch + fileNames |> LoadNewFiles |> FilePicker |> dispatch let picker = Browser.Dom.document.getElementById(inputId) // https://stackoverflow.com/questions/3528359/html-input-type-file-file-selection-event/3528376 picker?value <- null - ) + ) ] ] File.cta [] [ @@ -79,10 +452,17 @@ let filePickerComponent (model:Model) (dispatch:Msg -> unit) = ] ] ] - Table.table [Table.IsFullWidth] [ - tbody [] (createFileList model dispatch) + + div [ + Style [Margin "1rem auto"] + ][ + if model.FilePickerState.FileNames = [] then + str "Here you can select files from your computer to insert their names into a Swate column." + else + fileElementContainer model dispatch ] - Button.button [ + + Button.a [ Button.IsFullWidth if model.FilePickerState.FileNames |> List.isEmpty then yield! [ @@ -93,11 +473,10 @@ let filePickerComponent (model:Model) (dispatch:Msg -> unit) = else Button.Color Color.IsSuccess Button.OnClick (fun e -> - (fun tableName -> InsertFileNames (tableName, model.FilePickerState.FileNames)) |> PipeActiveAnnotationTable |> ExcelInterop |> dispatch + (fun tableName -> InsertFileNames (tableName, model.FilePickerState.FileNames |> List.map snd)) |> PipeActiveAnnotationTable |> ExcelInterop |> dispatch ) ][ str "Insert File Names" ] - ] \ No newline at end of file diff --git a/src/Client/style.scss b/src/Client/style.scss index 9a427cfc..0d10140d 100644 --- a/src/Client/style.scss +++ b/src/Client/style.scss @@ -28,6 +28,11 @@ html, body { font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, Oxygen-Sans, Ubuntu, Cantarell, "Helvetica Neue", sans-serif; } +.clone * { + pointer-events: none +} + + /////////// Custom simple checkbox, due to issue #54 /////////////////// .checkbox-label { display: inline-block; From d4a36f1e3417f5e49c184392e30d95d353f54a07 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Tue, 22 Dec 2020 22:25:07 +0100 Subject: [PATCH 05/10] Provide validation information via XML metadata (Issue #45). :christmas_tree: :fireworks: --- package-lock.json | 6 +- paket.dependencies | 4 +- paket.lock | 325 ++-------------- src/Client/Messages.fs | 14 +- src/Client/Model.fs | 41 +- src/Client/OfficeInterop/HelperFunctions.fs | 247 +++++++++++- src/Client/OfficeInterop/OfficeInterop.fs | 395 ++++++++++---------- src/Client/OfficeInterop/Types.fs | 227 +++++++++-- src/Client/Update.fs | 107 +++--- src/Client/Views/ActivityLogView.fs | 40 +- src/Client/Views/ValidationView.fs | 157 +++++--- src/Client/paket.references | 3 +- src/Server/paket.references | 1 - 13 files changed, 881 insertions(+), 686 deletions(-) diff --git a/package-lock.json b/package-lock.json index 3cb96bc0..e7a81cdc 100644 --- a/package-lock.json +++ b/package-lock.json @@ -4412,9 +4412,9 @@ "dev": true }, "ini": { - "version": "1.3.5", - "resolved": "https://registry.npmjs.org/ini/-/ini-1.3.5.tgz", - "integrity": "sha512-RZY5huIKCMRWDUqZlEi72f/lmXKMvuszcMBduliQ3nnWbx9X/ZBQO7DijMEYS9EhHBb2qacRUMtC7svLwe0lcw==", + "version": "1.3.8", + "resolved": "https://registry.npmjs.org/ini/-/ini-1.3.8.tgz", + "integrity": "sha512-JV/yugV2uzW5iMRSiZAyDtQd+nxtUnjeLt0acNdw98kKLrvuRVyB80tsREOE7yvGVgalhZ6RNXCmEHkUKBKxew==", "dev": true }, "internal-ip": { diff --git a/paket.dependencies b/paket.dependencies index 4dab44cd..6f5e1cf6 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -4,14 +4,14 @@ storage: none nuget Fable.Remoting.Giraffe nuget Fable.SimpleJson 3.11.0 +nuget Fable.SimpleXml nuget Fulma.Extensions.Wikiki.Checkradio nuget Fulma.Extensions.Wikiki.Slider nuget Saturn nuget Expecto nuget MySql.Data 8.0.21 nuget Microsoft.AspNetCore.Authentication.JwtBearer 3.1.10 -nuget Microsoft.Extensions.Configuration.UserSecrets -nuget Microsoft.Data.SqlClient +nuget Microsoft.Extensions.Configuration.UserSecrets nuget Fable.Core diff --git a/paket.lock b/paket.lock index d331a425..24769978 100644 --- a/paket.lock +++ b/paket.lock @@ -9,12 +9,12 @@ NUGET Fable.Browser.Blob (1.1) Fable.Core (>= 3.0) FSharp.Core (>= 4.6.2) - Fable.Browser.Dom (2.1.2) + Fable.Browser.Dom (2.2) Fable.Browser.Blob (>= 1.1) Fable.Browser.Event (>= 1.2.1) Fable.Browser.WebStorage (>= 1.0) Fable.Core (>= 3.0) - FSharp.Core (>= 4.7.1) + FSharp.Core (>= 4.7.2) Fable.Browser.Event (1.2.1) Fable.Core (>= 3.0) FSharp.Core (>= 4.7) @@ -32,8 +32,8 @@ NUGET Fable.Browser.Event (>= 1.2.1) Fable.Core (>= 3.0) FSharp.Core (>= 4.7) - Fable.Core (3.1.6) - FSharp.Core (>= 4.7.1) + Fable.Core (3.2.2) + FSharp.Core (>= 4.7) Fable.Elmish (3.1) Fable.Core (>= 3.0) FSharp.Core (>= 4.6.2) @@ -47,9 +47,9 @@ NUGET Fable.Elmish (>= 3.0) FSharp.Core (>= 4.7) Thoth.Json (>= 4.0) - Fable.Elmish.HMR (4.0.1) + Fable.Elmish.HMR (4.1) Fable.Core (>= 3.0) - Fable.Elmish.Browser (>= 3.0) + Fable.Elmish.Browser (>= 3.0.4) Fable.Elmish.React (>= 3.0.1) FSharp.Core (>= 4.6.2) Fable.Elmish.React (3.0.1) @@ -73,35 +73,39 @@ NUGET Fable.Promise (2.1) Fable.Core (>= 3.1.5) FSharp.Core (>= 4.7) - Fable.React (7.0.1) + Fable.React (7.2) Fable.Browser.Dom (>= 2.0.1) Fable.Core (>= 3.1.5) - FSharp.Core (>= 4.7.1) + FSharp.Core (>= 4.7.2) Fable.Remoting.Client (6.12) Fable.Browser.XMLHttpRequest (>= 1.0) Fable.Core (>= 3.1.5) Fable.Remoting.MsgPack (>= 1.5) Fable.SimpleJson (>= 3.11) FSharp.Core (>= 4.7) - Fable.Remoting.Giraffe (4.13) - Fable.Remoting.Server (>= 5.12) - FSharp.Core (>= 4.6.2) - Giraffe (>= 3.6) - Fable.Remoting.Json (2.12) - FSharp.Core (>= 4.6.2) + Fable.Remoting.Giraffe (4.15) + Fable.Remoting.Server (>= 5.13) + FSharp.Core (>= 4.7.2) + Giraffe (>= 4.1) + Fable.Remoting.Json (2.13) + FSharp.Core (>= 4.7.2) Newtonsoft.Json (>= 12.0.2) - Fable.Remoting.MsgPack (1.6.2) - FSharp.Core (>= 4.6.2) + Fable.Remoting.MsgPack (1.7) + FSharp.Core (>= 4.7.2) TypeShape (>= 8.0.1) - Fable.Remoting.Server (5.12) - Fable.Remoting.Json (>= 2.12) - Fable.Remoting.MsgPack (>= 1.6.2) - FSharp.Core (>= 4.6.2) + Fable.Remoting.Server (5.13) + Fable.Remoting.Json (>= 2.13) + Fable.Remoting.MsgPack (>= 1.7) + FSharp.Core (>= 4.7.2) TypeShape (>= 8.0.1) Fable.SimpleJson (3.11) Fable.Core (>= 3.1.5) Fable.Parsimmon (>= 4.0) FSharp.Core (>= 4.7) + Fable.SimpleXml (3.2) + Fable.Core (>= 3.0) + Fable.Parsimmon (>= 4.1) + FSharp.Core (>= 4.6.2) FSharp.Control.Websockets (0.2.2) FSharp.Core (>= 4.3.4) Microsoft.IO.RecyclableMemoryStream (>= 1.2.2) @@ -144,18 +148,6 @@ NUGET Microsoft.AspNetCore.Authentication.JwtBearer (3.1.10) Microsoft.IdentityModel.Protocols.OpenIdConnect (>= 5.5) Microsoft.CSharp (4.7) - Microsoft.Data.SqlClient (2.1) - Microsoft.Data.SqlClient.SNI.runtime (>= 2.1.1) - Microsoft.Identity.Client (>= 4.21.1) - Microsoft.IdentityModel.JsonWebTokens (>= 6.8) - Microsoft.IdentityModel.Protocols.OpenIdConnect (>= 6.8) - Microsoft.Win32.Registry (>= 4.7) - System.Configuration.ConfigurationManager (>= 4.7) - System.Diagnostics.DiagnosticSource (>= 4.7) - System.Runtime.Caching (>= 4.7) - System.Security.Principal.Windows (>= 4.7) - System.Text.Encoding.CodePages (>= 4.7) - Microsoft.Data.SqlClient.SNI.runtime (2.1.1) Microsoft.Extensions.Configuration (5.0) Microsoft.Extensions.Configuration.Abstractions (>= 5.0) Microsoft.Extensions.Primitives (>= 5.0) @@ -186,20 +178,6 @@ NUGET Microsoft.Extensions.Primitives (>= 5.0) Microsoft.Extensions.FileSystemGlobbing (5.0) Microsoft.Extensions.Primitives (5.0) - Microsoft.Identity.Client (4.23) - Microsoft.CSharp (>= 4.5) - NETStandard.Library (>= 1.6.1) - System.ComponentModel.TypeConverter (>= 4.3) - System.Diagnostics.Process (>= 4.3) - System.Dynamic.Runtime (>= 4.3) - System.Private.Uri (>= 4.3.2) - System.Runtime.Serialization.Formatters (>= 4.3) - System.Runtime.Serialization.Json (>= 4.3) - System.Runtime.Serialization.Primitives (>= 4.3) - System.Security.Cryptography.X509Certificates (>= 4.3) - System.Security.SecureString (>= 4.3) - System.Xml.XDocument (>= 4.3) - System.Xml.XmlDocument (>= 4.3) Microsoft.IdentityModel.JsonWebTokens (6.8) Microsoft.IdentityModel.Tokens (>= 6.8) Microsoft.IdentityModel.Logging (6.8) @@ -216,13 +194,6 @@ NUGET Microsoft.IO.RecyclableMemoryStream (1.3.6) Microsoft.NETCore.Platforms (5.0) Microsoft.NETCore.Targets (5.0) - Microsoft.Win32.Primitives (4.3) - Microsoft.NETCore.Platforms (>= 1.1) - Microsoft.NETCore.Targets (>= 1.1) - System.Runtime (>= 4.3) - Microsoft.Win32.Registry (5.0) - System.Security.AccessControl (>= 5.0) - System.Security.Principal.Windows (>= 5.0) Microsoft.Win32.SystemEvents (5.0) Microsoft.NETCore.Platforms (>= 5.0) Mono.Cecil (0.11.3) @@ -250,9 +221,6 @@ NUGET runtime.native.System (4.3.1) Microsoft.NETCore.Platforms (>= 1.1.1) Microsoft.NETCore.Targets (>= 1.1.3) - runtime.native.System.Net.Http (4.3.1) - Microsoft.NETCore.Platforms (>= 1.1.1) - Microsoft.NETCore.Targets (>= 1.1.3) runtime.native.System.Security.Cryptography.Apple (4.3.1) runtime.osx.10.10-x64.runtime.native.System.Security.Cryptography.Apple (>= 4.3.1) runtime.native.System.Security.Cryptography.OpenSsl (4.3.3) @@ -329,43 +297,6 @@ NUGET System.Runtime.Extensions (>= 4.3) System.Threading (>= 4.3) System.Threading.Tasks (>= 4.3) - System.Collections.NonGeneric (4.3) - System.Diagnostics.Debug (>= 4.3) - System.Globalization (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Threading (>= 4.3) - System.Collections.Specialized (4.3) - System.Collections.NonGeneric (>= 4.3) - System.Globalization (>= 4.3) - System.Globalization.Extensions (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Threading (>= 4.3) - System.ComponentModel (4.3) - System.Runtime (>= 4.3) - System.ComponentModel.Primitives (4.3) - System.ComponentModel (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.ComponentModel.TypeConverter (4.3) - System.Collections (>= 4.3) - System.Collections.NonGeneric (>= 4.3) - System.Collections.Specialized (>= 4.3) - System.ComponentModel (>= 4.3) - System.ComponentModel.Primitives (>= 4.3) - System.Globalization (>= 4.3) - System.Linq (>= 4.3) - System.Reflection (>= 4.3) - System.Reflection.Extensions (>= 4.3) - System.Reflection.Primitives (>= 4.3) - System.Reflection.TypeExtensions (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Threading (>= 4.3) System.Configuration.ConfigurationManager (5.0) System.Security.Cryptography.ProtectedData (>= 5.0) System.Security.Permissions (>= 5.0) @@ -373,29 +304,6 @@ NUGET Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) System.Runtime (>= 4.3) - System.Diagnostics.DiagnosticSource (5.0) - System.Diagnostics.Process (4.3) - Microsoft.NETCore.Platforms (>= 1.1) - Microsoft.Win32.Primitives (>= 4.3) - Microsoft.Win32.Registry (>= 4.3) - runtime.native.System (>= 4.3) - System.Collections (>= 4.3) - System.Diagnostics.Debug (>= 4.3) - System.Globalization (>= 4.3) - System.IO (>= 4.3) - System.IO.FileSystem (>= 4.3) - System.IO.FileSystem.Primitives (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Runtime.Handles (>= 4.3) - System.Runtime.InteropServices (>= 4.3) - System.Text.Encoding (>= 4.3) - System.Text.Encoding.Extensions (>= 4.3) - System.Threading (>= 4.3) - System.Threading.Tasks (>= 4.3) - System.Threading.Thread (>= 4.3) - System.Threading.ThreadPool (>= 4.3) System.Diagnostics.Tools (4.3) Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) @@ -416,38 +324,11 @@ NUGET System.Runtime (>= 4.3) System.Drawing.Common (5.0) Microsoft.Win32.SystemEvents (>= 5.0) - System.Dynamic.Runtime (4.3) - System.Collections (>= 4.3) - System.Diagnostics.Debug (>= 4.3) - System.Linq (>= 4.3) - System.Linq.Expressions (>= 4.3) - System.ObjectModel (>= 4.3) - System.Reflection (>= 4.3) - System.Reflection.Emit (>= 4.3) - System.Reflection.Emit.ILGeneration (>= 4.3) - System.Reflection.Primitives (>= 4.3) - System.Reflection.TypeExtensions (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Threading (>= 4.3) System.Formats.Asn1 (5.0) System.Globalization (4.3) Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) System.Runtime (>= 4.3) - System.Globalization.Calendars (4.3) - Microsoft.NETCore.Platforms (>= 1.1) - Microsoft.NETCore.Targets (>= 1.1) - System.Globalization (>= 4.3) - System.Runtime (>= 4.3) - System.Globalization.Extensions (4.3) - Microsoft.NETCore.Platforms (>= 1.1) - System.Globalization (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Runtime.InteropServices (>= 4.3) System.IdentityModel.Tokens.Jwt (6.8) Microsoft.IdentityModel.JsonWebTokens (>= 6.8) Microsoft.IdentityModel.Tokens (>= 6.8) @@ -474,24 +355,6 @@ NUGET System.Resources.ResourceManager (>= 4.3) System.Runtime (>= 4.3) System.Runtime.Extensions (>= 4.3) - System.Linq.Expressions (4.3) - System.Collections (>= 4.3) - System.Diagnostics.Debug (>= 4.3) - System.Globalization (>= 4.3) - System.IO (>= 4.3) - System.Linq (>= 4.3) - System.ObjectModel (>= 4.3) - System.Reflection (>= 4.3) - System.Reflection.Emit (>= 4.3) - System.Reflection.Emit.ILGeneration (>= 4.3) - System.Reflection.Emit.Lightweight (>= 4.3) - System.Reflection.Extensions (>= 4.3) - System.Reflection.Primitives (>= 4.3) - System.Reflection.TypeExtensions (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Threading (>= 4.3) System.Memory (4.5.4) System.Net.NameResolution (4.3) Microsoft.NETCore.Platforms (>= 1.1) @@ -520,41 +383,6 @@ NUGET System.Net.Primitives (>= 4.3) System.Runtime (>= 4.3) System.Threading.Tasks (>= 4.3) - System.ObjectModel (4.3) - System.Collections (>= 4.3) - System.Diagnostics.Debug (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Threading (>= 4.3) - System.Private.DataContractSerialization (4.3) - System.Collections (>= 4.3) - System.Collections.Concurrent (>= 4.3) - System.Diagnostics.Debug (>= 4.3) - System.Globalization (>= 4.3) - System.IO (>= 4.3) - System.Linq (>= 4.3) - System.Reflection (>= 4.3) - System.Reflection.Emit.ILGeneration (>= 4.3) - System.Reflection.Emit.Lightweight (>= 4.3) - System.Reflection.Extensions (>= 4.3) - System.Reflection.Primitives (>= 4.3) - System.Reflection.TypeExtensions (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Runtime.Serialization.Primitives (>= 4.3) - System.Text.Encoding (>= 4.3) - System.Text.Encoding.Extensions (>= 4.3) - System.Text.RegularExpressions (>= 4.3) - System.Threading (>= 4.3) - System.Threading.Tasks (>= 4.3) - System.Xml.ReaderWriter (>= 4.3) - System.Xml.XDocument (>= 4.3) - System.Xml.XmlDocument (>= 4.3) - System.Xml.XmlSerializer (>= 4.3) - System.Private.Uri (4.3.2) - Microsoft.NETCore.Platforms (>= 1.1.1) - Microsoft.NETCore.Targets (>= 1.1.3) System.Reflection (4.3) Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) @@ -562,7 +390,6 @@ NUGET System.Reflection.Primitives (>= 4.3) System.Runtime (>= 4.3) System.Reflection.Emit (4.7) - System.Reflection.Emit.ILGeneration (4.7) System.Reflection.Emit.Lightweight (4.7) System.Reflection.Extensions (4.3) Microsoft.NETCore.Platforms (>= 1.1) @@ -573,7 +400,6 @@ NUGET Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) System.Runtime (>= 4.3) - System.Reflection.TypeExtensions (4.7) System.Resources.ResourceManager (4.3) Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) @@ -583,8 +409,6 @@ NUGET System.Runtime (4.3.1) Microsoft.NETCore.Platforms (>= 1.1.1) Microsoft.NETCore.Targets (>= 1.1.3) - System.Runtime.Caching (5.0) - System.Configuration.ConfigurationManager (>= 5.0) System.Runtime.CompilerServices.Unsafe (5.0) System.Runtime.Extensions (4.3.1) Microsoft.NETCore.Platforms (>= 1.1.1) @@ -606,19 +430,6 @@ NUGET System.Resources.ResourceManager (>= 4.3) System.Runtime (>= 4.3) System.Runtime.Extensions (>= 4.3) - System.Runtime.Serialization.Formatters (4.3) - System.Collections (>= 4.3) - System.Reflection (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Serialization.Primitives (>= 4.3) - System.Runtime.Serialization.Json (4.3) - System.IO (>= 4.3) - System.Private.DataContractSerialization (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Serialization.Primitives (4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) System.Security.AccessControl (5.0) Microsoft.NETCore.Platforms (>= 5.0) System.Security.Principal.Windows (>= 5.0) @@ -639,20 +450,6 @@ NUGET System.Text.Encoding (>= 4.3) System.Security.Cryptography.Cng (5.0) System.Formats.Asn1 (>= 5.0) - System.Security.Cryptography.Csp (4.3) - Microsoft.NETCore.Platforms (>= 1.1) - System.IO (>= 4.3) - System.Reflection (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Runtime.Handles (>= 4.3) - System.Runtime.InteropServices (>= 4.3) - System.Security.Cryptography.Algorithms (>= 4.3) - System.Security.Cryptography.Encoding (>= 4.3) - System.Security.Cryptography.Primitives (>= 4.3) - System.Text.Encoding (>= 4.3) - System.Threading (>= 4.3) System.Security.Cryptography.Encoding (4.3) Microsoft.NETCore.Platforms (>= 1.1) runtime.native.System.Security.Cryptography.OpenSsl (>= 4.3) @@ -666,8 +463,6 @@ NUGET System.Runtime.InteropServices (>= 4.3) System.Security.Cryptography.Primitives (>= 4.3) System.Text.Encoding (>= 4.3) - System.Security.Cryptography.OpenSsl (5.0) - System.Formats.Asn1 (>= 5.0) System.Security.Cryptography.Primitives (4.3) System.Diagnostics.Debug (>= 4.3) System.Globalization (>= 4.3) @@ -677,45 +472,10 @@ NUGET System.Threading (>= 4.3) System.Threading.Tasks (>= 4.3) System.Security.Cryptography.ProtectedData (5.0) - System.Security.Cryptography.X509Certificates (4.3.2) - Microsoft.NETCore.Platforms (>= 1.1) - runtime.native.System (>= 4.3) - runtime.native.System.Net.Http (>= 4.3) - runtime.native.System.Security.Cryptography.OpenSsl (>= 4.3.2) - System.Collections (>= 4.3) - System.Diagnostics.Debug (>= 4.3) - System.Globalization (>= 4.3) - System.Globalization.Calendars (>= 4.3) - System.IO (>= 4.3) - System.IO.FileSystem (>= 4.3) - System.IO.FileSystem.Primitives (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Runtime.Handles (>= 4.3) - System.Runtime.InteropServices (>= 4.3) - System.Runtime.Numerics (>= 4.3) - System.Security.Cryptography.Algorithms (>= 4.3) - System.Security.Cryptography.Cng (>= 4.3) - System.Security.Cryptography.Csp (>= 4.3) - System.Security.Cryptography.Encoding (>= 4.3) - System.Security.Cryptography.OpenSsl (>= 4.3) - System.Security.Cryptography.Primitives (>= 4.3) - System.Text.Encoding (>= 4.3) - System.Threading (>= 4.3) System.Security.Permissions (5.0) System.Security.AccessControl (>= 5.0) System.Windows.Extensions (>= 5.0) System.Security.Principal.Windows (5.0) - System.Security.SecureString (4.3) - Microsoft.NETCore.Platforms (>= 1.1) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Handles (>= 4.3) - System.Runtime.InteropServices (>= 4.3) - System.Security.Cryptography.Primitives (>= 4.3) - System.Text.Encoding (>= 4.3) - System.Threading (>= 4.3) System.Text.Encoding (4.3) Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) @@ -768,19 +528,6 @@ NUGET System.Text.RegularExpressions (>= 4.3) System.Threading.Tasks (>= 4.3) System.Threading.Tasks.Extensions (>= 4.3) - System.Xml.XDocument (4.3) - System.Collections (>= 4.3) - System.Diagnostics.Debug (>= 4.3) - System.Diagnostics.Tools (>= 4.3) - System.Globalization (>= 4.3) - System.IO (>= 4.3) - System.Reflection (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Text.Encoding (>= 4.3) - System.Threading (>= 4.3) - System.Xml.ReaderWriter (>= 4.3) System.Xml.XmlDocument (4.3) System.Collections (>= 4.3) System.Diagnostics.Debug (>= 4.3) @@ -792,24 +539,6 @@ NUGET System.Text.Encoding (>= 4.3) System.Threading (>= 4.3) System.Xml.ReaderWriter (>= 4.3) - System.Xml.XmlSerializer (4.3) - System.Collections (>= 4.3) - System.Globalization (>= 4.3) - System.IO (>= 4.3) - System.Linq (>= 4.3) - System.Reflection (>= 4.3) - System.Reflection.Emit (>= 4.3) - System.Reflection.Emit.ILGeneration (>= 4.3) - System.Reflection.Extensions (>= 4.3) - System.Reflection.Primitives (>= 4.3) - System.Reflection.TypeExtensions (>= 4.3) - System.Resources.ResourceManager (>= 4.3) - System.Runtime (>= 4.3) - System.Runtime.Extensions (>= 4.3) - System.Text.RegularExpressions (>= 4.3) - System.Threading (>= 4.3) - System.Xml.ReaderWriter (>= 4.3) - System.Xml.XmlDocument (>= 4.3) System.Xml.XPath (4.3) System.Collections (>= 4.3) System.Diagnostics.Debug (>= 4.3) @@ -962,12 +691,12 @@ NUGET Fake.Core.Trace (>= 5.20.3) Fake.IO.FileSystem (>= 5.20.3) FSharp.Core (>= 4.7.2) - Farmer (1.2) + Farmer (1.3) FSharp.Core (>= 4.7.1) Newtonsoft.Json (>= 12.0.2) FParsec (1.1.1) FSharp.Core (>= 4.3.4) - FSharp.Control.Reactive (4.4.2) + FSharp.Control.Reactive (4.5) FSharp.Core (>= 4.7.2) System.Reactive (>= 4.4.1) FSharp.Core (4.7.2) @@ -1080,7 +809,7 @@ NUGET System.Security.AccessControl (5.0) System.Security.Principal.Windows (>= 5.0) System.Security.Cryptography.Cng (5.0) - System.Security.Cryptography.Pkcs (5.0) + System.Security.Cryptography.Pkcs (5.0.1) System.Buffers (>= 4.5.1) System.Formats.Asn1 (>= 5.0) System.Memory (>= 4.5.4) diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index 93cb6828..80bc2f45 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -7,7 +7,7 @@ open Shared open ExcelColors open OfficeInterop -open OfficeInterop.Types.SwateInteropTypes +open OfficeInterop.Types open Model type ExcelInteropMsg = @@ -27,7 +27,11 @@ type ExcelInteropMsg = | AnnotationTableExists of activeAnnotationTable:TryFindAnnoTableResult | GetParentTerm of activeAnnotationTable:TryFindAnnoTableResult | AutoFitTable of activeAnnotationTable:TryFindAnnoTableResult - | GetTableRepresentation of activeAnnotationTable:TryFindAnnoTableResult + // + | GetTableValidationXml of activeAnnotationTable:TryFindAnnoTableResult + | WriteTableValidationToXml of newTableValidation:XmlValidationTypes.TableValidation * currentSwateVersion:string + | DeleteAllCustomXml + | GetSwateValidationXml // | ToggleEventHandler | UpdateTablesHaveAutoEditHandler @@ -129,11 +133,9 @@ type AddBuildingBlockMsg = type ValidationMsg = // Client | UpdateDisplayedOptionsId of int option - /// UpdateValidationFormat of (oldValidationFormat * newValidationFormat) - | UpdateValidationFormat of (ValidationFormat*ValidationFormat) - + | UpdateTableValidationScheme of XmlValidationTypes.TableValidation // OfficeInterop - | StoreTableRepresentationFromOfficeInterop of msg:string * OfficeInterop.Types.SwateInteropTypes.ColumnRepresentation [] + | StoreTableRepresentationFromOfficeInterop of OfficeInterop.Types.XmlValidationTypes.TableValidation * buildingBlocks:OfficeInterop.Types.BuildingBlockTypes.BuildingBlock [] * msg:string type Msg = | Bounce of (System.TimeSpan*string*Msg) diff --git a/src/Client/Model.fs b/src/Client/Model.fs index cc9d6636..4d5a361c 100644 --- a/src/Client/Model.fs +++ b/src/Client/Model.fs @@ -7,8 +7,6 @@ open Shared open Thoth.Elmish open Routing -open OfficeInterop.Types.SwateInteropTypes - type LogItem = | Debug of (System.DateTime*string) | Info of (System.DateTime*string) @@ -328,46 +326,17 @@ type AddBuildingBlockState = { UnitTermSearchTextHasTermAccession = None } -/// User can define what kind of input a column should have -type ContentType = - | OntologyTerm of string - | Text - | Url - | Boolean - | Number - | Int - | Decimal - - member this.toString = - match this with - | OntologyTerm po -> - sprintf "Ontology [%s]" po - | _ -> - string this - -/// User can add a defined input to a column with header "ColumnHeader" and with a certain importance. -type ValidationFormat = { - ColumnHeader : string - Importance : int option - ContentType : ContentType option -} with - static member init (?header) = { - ColumnHeader = if header.IsSome then header.Value else "" - Importance = None - ContentType = None - } - /// Validation scheme for Table type ValidationState = { - TableRepresentation : OfficeInterop.Types.SwateInteropTypes.ColumnRepresentation [] - TableValidationScheme : ValidationFormat [] + ActiveTableBuildingBlocks : OfficeInterop.Types.BuildingBlockTypes.BuildingBlock [] + TableValidationScheme : OfficeInterop.Types.XmlValidationTypes.TableValidation // Client view related DisplayedOptionsId : int option } with static member init () = { - TableRepresentation = Array.empty - TableValidationScheme = Array.empty - DisplayedOptionsId = None + ActiveTableBuildingBlocks = [||] + TableValidationScheme = OfficeInterop.Types.XmlValidationTypes.TableValidation.init() + DisplayedOptionsId = None } type Model = { diff --git a/src/Client/OfficeInterop/HelperFunctions.fs b/src/Client/OfficeInterop/HelperFunctions.fs index 981acc51..5c658aa9 100644 --- a/src/Client/OfficeInterop/HelperFunctions.fs +++ b/src/Client/OfficeInterop/HelperFunctions.fs @@ -49,6 +49,252 @@ let findIndexNextNotHiddenCol (headerVals:obj option []) (startIndex:float) = newInd loopingCheckSkipHiddenCols startIndex +module BuildingBlockTypes = + + /// This function is part 1 to get a 'BuildingBlock []' representation of a Swate table. + /// It should be used as follows: 'let annoHeaderRange, annoBodyRange = BuildingBlockTypes.getBuildingBlocksPreSync context annotationTable' + /// This function will load all necessery excel properties. + let getBuildingBlocksPreSync (context:RequestContext) annotationTable = + let sheet = context.workbook.worksheets.getActiveWorksheet() + let annotationTable = sheet.tables.getItem(annotationTable) + let annoHeaderRange = annotationTable.getHeaderRowRange() + let _ = annoHeaderRange.load(U2.Case2 (ResizeArray [|"columnIndex"; "values"; "columnCount"|])) |> ignore + let annoBodyRange = annotationTable.getDataBodyRange() + let _ = annoBodyRange.load(U2.Case2 (ResizeArray [|"values"|])) |> ignore + annoHeaderRange, annoBodyRange + + /// This function is part 2 to get a 'BuildingBlock []' representation of a Swate table. + /// It's parameters are the output of 'getBuildingBlocksPreSync' and it will return a full 'BuildingBlock []'. + /// It MUST be used either in or after 'context.sync().``then``(fun e -> ..)' after 'getBuildingBlocksPreSync'. + let getBuildingBlocks (annoHeaderRange:OfficeJS.Excel.Range) (annoBodyRange:OfficeJS.Excel.Range) = + + /// Get the table by 'Columns [| Rows [|Values|] |]' + let columnBodies = + annoBodyRange.values + |> viewRowsByColumns + + /// Write columns into 'BuildingBlockTypes.Column' + let columns = + [| + // iterate over n of columns + for ind = 0 to (int annoHeaderRange.columnCount - 1) do + yield ( + // Get column header and parse it + let header = + annoHeaderRange.values.[0].[ind] + |> fun x -> if x.IsSome then parseColHeader (string annoHeaderRange.values.[0].[ind].Value) |> Some else None + // Get column values and write them to 'BuildingBlockTypes.Cell' + let cells = + columnBodies.[ind] + |> Array.mapi (fun i cellVal -> + let cellValue = if cellVal.IsSome then Some (string cellVal.Value) else None + Cell.create i cellValue + ) + // Create column + Column.create ind header cells + ) + |] + + /// Failsafe (1): it should never happen, that the nextColumn is a hidden column without an existing building block. + let errorMsg1 (nextCol:Column) (buildingBlock:BuildingBlock option) = + failwith ( + sprintf + "Swate encountered an error while processing the active annotation table. + Swate found a hidden column (%s) without a prior main column (not hidden)." + nextCol.Header.Value.Header + ) + + /// Hidden columns do only come with certain core names. The acceptable names can be found in OfficeInterop.Types.ColumnCoreNames. + let errorMsg2 (nextCol:Column) (buildingBlock:BuildingBlock option) = + failwith ( + sprintf + "Swate encountered an error while processing the active annotation table. + Swate found a hidden column (%s) with an unknown core name: %A" + nextCol.Header.Value.Header + nextCol.Header.Value.CoreName + ) + + /// If a columns core name already exists for the current building block, then the block is faulty and needs userinput to be corrected. + let errorMsg3 (nextCol:Column) (buildingBlock:BuildingBlock option) assignedCol = + failwith ( + sprintf + "Swate encountered an error while processing the active annotation table. + Swate found a hidden column (%s) with a core name (%A) that is already assigned to the previous building block. + Building block main column: %s, already assigned column: %s" + nextCol.Header.Value.Header + nextCol.Header.Value.CoreName + buildingBlock.Value.MainColumn.Header.Value.Header + assignedCol + ) + + /// Update current building block with new reference column. A ref col can be TSR, TAN and unit cols. + let checkForHiddenColType (currentBlock:BuildingBlock option) (nextCol:Column) = + // Then we need to check if the nextCol is either a TSR, TAN or a unit column + match nextCol.Header.Value.CoreName.Value with + | ColumnCoreNames.Hidden.TermAccessionNumber -> + // Build in fail safes. + if currentBlock.IsNone then errorMsg1 nextCol currentBlock + if currentBlock.Value.TAN.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.TAN.Value.Header.Value.Header + // Update building block + let updateCurrentBlock = + { currentBlock.Value with + TAN = Some nextCol } |> Some + updateCurrentBlock + | ColumnCoreNames.Hidden.TermSourceREF -> + // Build in fail safe. + if currentBlock.IsNone then errorMsg1 nextCol currentBlock + if currentBlock.Value.TSR.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.TSR.Value.Header.Value.Header + // Update building block + let updateCurrentBlock = + { currentBlock.Value with + TSR = Some nextCol } |> Some + updateCurrentBlock + | ColumnCoreNames.Hidden.Unit -> + // Build in fail safe. + if currentBlock.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.MainColumn.Header.Value.Header + // Create unit building block + let newBlock = BuildingBlock.create nextCol None None None |> Some + newBlock + | _ -> + // Build in fail safe. + errorMsg2 nextCol currentBlock + + // Building blocks are defined by one visuable column and an undefined number of hidden columns. + // Therefore we iterate through the columns array and use every column without an `#h` tag as the start of a new building block. + let rec sortColsIntoBuildingBlocks (index:int) (currentBlock:BuildingBlock option) (buildingBlockList:BuildingBlock list) = + // Exit case if we iterated through all columns + if index > (int annoHeaderRange.columnCount - 1) then + // Should we have a 'currentBuildingBlock' add it to the 'buildingBlockList' before returning it. + if currentBlock.IsSome then + currentBlock.Value::buildingBlockList + else + buildingBlockList + else + let nextCol = columns.[index] + // If the nextCol does not have an header it is empty and therefore skipped. + if + nextCol.Header.IsNone + then + sortColsIntoBuildingBlocks (index+1) currentBlock buildingBlockList + // If the nextCol.Header has no tag array or its tag array does NOT contain a hidden tag then it starts a new building block + elif + (nextCol.Header.Value.TagArr.IsSome && nextCol.Header.Value.TagArr.Value |> Array.contains ColumnTags.HiddenTag |> not) + || (nextCol.Header.IsSome && nextCol.Header.Value.TagArr.IsNone) + then + let newBuildingBlock = BuildingBlock.create nextCol None None None |> Some + // If there is a 'currentBlock' we add it to the list of building blocks ('buildingBlockList'). + if currentBlock.IsSome then + sortColsIntoBuildingBlocks (index+1) newBuildingBlock (currentBlock.Value::buildingBlockList) + // If there is no currentBuildingBlock, e.g. at the start of this function we replace the None with the first building block. + else + sortColsIntoBuildingBlocks (index+1) newBuildingBlock buildingBlockList + // if the nextCol.Header has a tag array and it does contain a hidden tag then it is added to the currentBlock + elif + nextCol.Header.Value.TagArr.IsSome && nextCol.Header.Value.TagArr.Value |> Array.contains ColumnTags.HiddenTag + then + // There are multiple possibilities which column this is: TSR; TAN; Unit; Unit TSR; Unit TAN are the currently existing ones. + // We first check if there is NO unit tag in the header tag array + if nextCol.Header.Value.TagArr.Value |> Array.exists (fun x -> x.StartsWith ColumnTags.UnitTagStart) |> not then + let updateCurrentBlock = checkForHiddenColType currentBlock nextCol + sortColsIntoBuildingBlocks (index+1) updateCurrentBlock buildingBlockList + /// Next we check for unit columns in the scheme of `Unit [Term] (#h; #u...) | TSR [Term] (#h; #u...) | TAN [Term] (#h; #u...)` + elif nextCol.Header.Value.TagArr.Value |> Array.exists (fun x -> x.StartsWith ColumnTags.UnitTagStart) then + /// Please notice that we update the unit building block in the following function and not the core building block. + let updatedUnitBlock = checkForHiddenColType currentBlock.Value.Unit nextCol + /// Update the core building block with the updated unit building block. + let updateCurrentBlock = {currentBlock.Value with Unit = updatedUnitBlock} |> Some + sortColsIntoBuildingBlocks (index+1) updateCurrentBlock buildingBlockList + else + failwith "The tag array of the next column to process in 'sortColsIntoBuildingBlocks' can only contain a '#u' tag or not." + else + failwith (sprintf "The tag array of the next column to process in 'sortColsIntoBuildingBlocks' was not recognized as hidden or main column: %A." nextCol.Header) + + /// Sort all columns into building blocks. + let buildingBlocks = + sortColsIntoBuildingBlocks 0 None [] + |> List.rev + |> Array.ofList + + buildingBlocks + +open System +open Fable.SimpleXml +open Fable.SimpleXml.Generator + +let xmlElementToXmlString (root:XmlElement) = + let rec createChildren (child:XmlElement) = + match child.SelfClosing with + | true -> + leaf child.Name [ + for cAttr in child.Attributes do + yield attr.value(cAttr.Key,cAttr.Value) + ] + | false -> + node child.Name [ + for cAttr in child.Attributes do + yield attr.value(cAttr.Key,cAttr.Value) + ][ + for grandChild in child.Children do + yield createChildren grandChild + yield + text child.Content + ] + node root.Name [ + for rAttr in root.Attributes do + yield attr.value(rAttr.Key,rAttr.Value) + ] [ + for child in root.Children do + yield createChildren child + yield + text root.Content + ] |> serializeXml + +let getCurrentValidationXml (customXmlParts:CustomXmlPartCollection) (context:RequestContext)= + promise { + let! getXml = + context.sync().``then``(fun e -> + let items = customXmlParts.items + let xmls = items |> Seq.map (fun x -> x.getXml() ) + + xmls |> Array.ofSeq + ) + + let! xml = + context.sync().``then``(fun e -> + + //let nOfItems = customXmlParts.items.Count + let vals = getXml |> Array.map (fun x -> x.value) + //sprintf "N = %A; items: %A" nOfItems vals + let xml = vals |> String.concat Environment.NewLine + xml + ) + + let xmlParsed = + let isRootElement = xml |> SimpleXml.tryParseElement + if xml = "" then "" |> SimpleXml.parseElement + elif isRootElement.IsSome then + isRootElement.Value + else + let isManyRootElements = xml |> SimpleXml.tryParseManyElements + if isManyRootElements.IsSome then + isManyRootElements.Value + |> List.tryFind (fun ele -> ele.Name = "customXml") + |> fun customXmlOpt -> if customXmlOpt.IsSome then customXmlOpt.Value else failwith "Swate could not find expected 'customXml' root tag." + else + 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) + + let currentSwateValidationXml = + let v = SimpleXml.findElementsByName "Validation" xmlParsed + if v.Length > 1 then failwith (sprintf "Swate found multiple 'Validation' xml elements. Please contact the developer.") + if v.Length = 0 then + None + else + XmlValidationTypes.SwateValidation.ofXml xml |> Some + + return xmlParsed, currentSwateValidationXml + } + let createEmptyMatrixForTables (colCount:int) (rowCount:int) value = [| for i in 0 .. rowCount-1 do @@ -82,4 +328,3 @@ let createEmptyAnnotationMatrixForTables (rowCount:int) value (header:string) = U3.Case2 value |] :> IList> |] :> IList>> - diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index de73715a..bf0aa615 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -11,7 +11,7 @@ open Shared open OfficeInterop.Regex open OfficeInterop.Types -open SwateInteropTypes +open XmlValidationTypes open OfficeInterop.HelperFunctions open OfficeInterop.EventHandlers open BuildingBlockTypes @@ -58,27 +58,41 @@ let consoleLog (message: string): unit = jsNative open System open Fable.Core +open Fable.SimpleXml +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 exampleExcelFunction () = Excel.run(fun context -> - context.sync() - .``then``( fun _ -> - - sprintf "Test output" - ) + // 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 { + return "test" + } ) + /// This is not used in production and only here for development. Its content is always changing to test functions for new features. let exampleExcelFunction2 () = Excel.run(fun context -> - context.sync() - .``then``( fun _ -> - - sprintf "Test output 2" - ) + // 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! xmlParsed, currentSwateValidationXml = getCurrentValidationXml customXmlParts context + + let currentSwateVersion = "0.1.3" + let currentSwateValidationXml' = + if currentSwateValidationXml.IsNone then SwateValidation.init (currentSwateVersion) else currentSwateValidationXml.Value + + return sprintf "%A" currentSwateValidationXml' + } ) /// This function is used to create a new annotation table. @@ -178,7 +192,7 @@ let createAnnotationTable ((allTableNames:String []),isDark:bool) = r.enableEvents <- true /// Return info message - SwateInteropTypes.Success newName, sprintf "Annotation Table created in [%s] with dimensions 2c x (%.0f + 1h)r" tableRange.address (tableRange.rowCount - 1.) + TryFindAnnoTableResult.Success newName, sprintf "Annotation Table created in [%s] with dimensions 2c x (%.0f + 1h)r" tableRange.address (tableRange.rowCount - 1.) ) //.catch (fun e -> e |> unbox |> fun x -> x.Message) ) @@ -206,7 +220,7 @@ let tryFindActiveAnnotationTable() = tables |> Array.filter (fun x -> x.StartsWith "annotationTable") /// Get the correct error message if we have <> 1 annotation table. Only returns success and the table name if annoTables.Length = 1 - let res = SwateInteropTypes.TryFindAnnoTableResult.exactlyOneAnnotationTable annoTables + let res = TryFindAnnoTableResult.exactlyOneAnnotationTable annoTables // return result res @@ -378,39 +392,72 @@ let autoFitTable (annotationTable) = /// This is currently used to get information about the table for the table validation feature. /// Might be necessary to redesign this to use the newer 'BuildingBlock' or get completly replaced by parts of 'getInsertTermsToFillHiddenCols' -/// As this function creates a complete representation of the table and then searches on it. Should we decide to keep the function then i will add more inline comments. +/// As this function creates a complete representation of the table. Should we decide to keep the function then i will add more inline comments. let getTableRepresentation(annotationTable) = Excel.run(fun context -> - let sheet = context.workbook.worksheets.getActiveWorksheet() - let annotationTable = sheet.tables.getItem(annotationTable) - let annoHeaderRange = annotationTable.getHeaderRowRange() - let _ = annoHeaderRange.load(U2.Case2 (ResizeArray[|"values"|])) - context.sync().``then``( - fun _ -> - let headerVals = - annoHeaderRange.values.[0] - |> Array.ofSeq - |> Array.choose id - |> Array.map string - let parsedHeaders = - headerVals |> Array.map parseColHeader - let baseColRepresentation = - parsedHeaders - |> Array.map (fun header -> - let nColRep = SwateInteropTypes.ColumnRepresentation.init(header=header.Header) - { nColRep with - ParentOntology = header.Ontology - TagArray = if header.TagArr.IsSome then header.TagArr.Value else [||] - } + + // 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"|])) + + promise { + let! xmlParsed, currentSwateValidationXml = getCurrentValidationXml customXmlParts context + + let! worksheetName, buildingBlocks = + context.sync().``then``( fun _ -> + let buildingBlocks = getBuildingBlocks annoHeaderRange annoBodyRange + + let worksheetName = activeWorksheet.name + worksheetName, buildingBlocks ) - let filterOutHiddenCols (colRepArr:SwateInteropTypes.ColumnRepresentation []) = - colRepArr - |> Array.filter (fun x -> x.TagArray |> ((Array.contains ColumnTags.HiddenTag) >> not) ) - let colReps = - baseColRepresentation - |> filterOutHiddenCols - colReps, "Update table representation." - ) + + let currentTableValidation = + if currentSwateValidationXml.IsNone then + None + else + let tryFindActiveTableValidation = + currentSwateValidationXml.Value.TableValidations + |> List.tryFind (fun tableVal -> tableVal.TableName = annotationTable && tableVal.WorksheetName = worksheetName) + tryFindActiveTableValidation + + /// This function updates the current SwateValidation xml with all found building blocks. + let updateCurrentTableValidationXml = + /// We start by transforming all building blocks into ColumnValidations + let newColumnValidations = buildingBlocks |> Array.map (fun buildingBlock -> buildingBlock.toColumnValidation) |> List.ofArray + /// Map over all newColumnValidations and see if they exist in the currentTableValidation xml. If they do, then update them by their validation parameters. + let updateTableValidation = + /// Check if a TableValidation for the active table AND worksheet exists, else return the newly build colValidations. + if currentTableValidation.IsSome then + let updatedNewColumnValidations = + newColumnValidations + |> List.map (fun newColVal -> + let tryFindCurrentColVal = currentTableValidation.Value.ColumnValidations |> List.tryFind (fun x -> x.ColumnHeader = newColVal.ColumnHeader) + if tryFindCurrentColVal.IsSome then + {newColVal with + Importance = tryFindCurrentColVal.Value.Importance + ValidationFormat = tryFindCurrentColVal.Value.ValidationFormat + } + else + newColVal + ) + /// Update TableValidation with updated ColumnValidations + {currentTableValidation.Value with + ColumnValidations = updatedNewColumnValidations} + else + /// Should no current TableValidation xml exist, create a new one + TableValidation.create + worksheetName + annotationTable + System.DateTime.Now + [] + newColumnValidations + updateTableValidation + + return updateCurrentTableValidationXml, buildingBlocks, "Update table representation." + } ) /// This function is used to add a new building block to the active annotationTable. @@ -726,7 +773,7 @@ let getParentTerm (annotationTable) = ) ) -/// This is used to insert terms into. +/// This is used to insert terms into selected cells. /// 'term' is the value that will be written into the main column. /// 'termBackground' needs to be spearate from 'term' in case the user uses the fill function for a custom term. /// Should the user write a real term with this function 'termBackground'.isSome and can be used to fill TSR and TAN. @@ -794,167 +841,21 @@ let fillValue (annotationTable,term,termBackground:Shared.DbDomain.Term option) ) ) -/// This is used to create a full representation of all building blocks in the table and return it to the app. +/// This is used to create a full representation of all building blocks in the table. This representation is then split into unit building blocks and regular building blocks. +/// These are then filtered for search terms and aggregated into an 'SearchTermI []', which is used to search the database for missing values. /// 'annotationTable'' gets passed by 'tryFindActiveAnnotationTable'. -let createSearchTermsFromTable (annotationTable') = +let createSearchTermsIFromTable (annotationTable') = Excel.run(fun context -> // Ref. 2 - let sheet = context.workbook.worksheets.getActiveWorksheet() - let annotationTable = sheet.tables.getItem(annotationTable') - let annoHeaderRange = annotationTable.getHeaderRowRange() - let _ = annoHeaderRange.load(U2.Case2 (ResizeArray [|"columnIndex"; "values"; "columnCount"|])) |> ignore - let annoBodyRange = annotationTable.getDataBodyRange() - let _ = annoBodyRange.load(U2.Case2 (ResizeArray [|"values"|])) |> ignore + let annoHeaderRange, annoBodyRange = BuildingBlockTypes.getBuildingBlocksPreSync context annotationTable' context.sync() .``then``( fun _ -> - /// Get the table by 'Columns [| Rows [|Values|] |]' - let columnBodies = - annoBodyRange.values - |> viewRowsByColumns - - /// Write columns into 'BuildingBlockTypes.Column' - let columns = - [| - // iterate over n of columns - for ind = 0 to (int annoHeaderRange.columnCount - 1) do - yield ( - // Get column header and parse it - let header = - annoHeaderRange.values.[0].[ind] - |> fun x -> if x.IsSome then parseColHeader (string annoHeaderRange.values.[0].[ind].Value) |> Some else None - // Get column values and write them to 'BuildingBlockTypes.Cell' - let cells = - columnBodies.[ind] - |> Array.mapi (fun i cellVal -> - let cellValue = if cellVal.IsSome then Some (string cellVal.Value) else None - Cell.create i cellValue - ) - // Create column - Column.create ind header cells - ) - |] - - /// Failsafe (1): it should never happen, that the nextColumn is a hidden column without an existing building block. - let errorMsg1 (nextCol:Column) (buildingBlock:BuildingBlock option) = - failwith ( - sprintf - "Swate encountered an error while processing the active annotation table. - Swate found a hidden column (%s) without a prior main column (not hidden)." - nextCol.Header.Value.Header - ) - - /// Hidden columns do only come with certain core names. The acceptable names can be found in OfficeInterop.Types.ColumnCoreNames. - let errorMsg2 (nextCol:Column) (buildingBlock:BuildingBlock option) = - failwith ( - sprintf - "Swate encountered an error while processing the active annotation table. - Swate found a hidden column (%s) with an unknown core name: %A" - nextCol.Header.Value.Header - nextCol.Header.Value.CoreName - ) - - /// If a columns core name already exists for the current building block, then the block is faulty and needs userinput to be corrected. - let errorMsg3 (nextCol:Column) (buildingBlock:BuildingBlock option) assignedCol = - failwith ( - sprintf - "Swate encountered an error while processing the active annotation table. - Swate found a hidden column (%s) with a core name (%A) that is already assigned to the previous building block. - Building block main column: %s, already assigned column: %s" - nextCol.Header.Value.Header - nextCol.Header.Value.CoreName - buildingBlock.Value.MainColumn.Header.Value.Header - assignedCol - ) - - /// Update current building block with new reference column. A ref col can be TSR, TAN and unit cols. - let checkForHiddenColType (currentBlock:BuildingBlock option) (nextCol:Column) = - // Then we need to check if the nextCol is either a TSR, TAN or a unit column - match nextCol.Header.Value.CoreName.Value with - | ColumnCoreNames.Hidden.TermAccessionNumber -> - // Build in fail safes. - if currentBlock.IsNone then errorMsg1 nextCol currentBlock - if currentBlock.Value.TAN.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.TAN.Value.Header.Value.Header - // Update building block - let updateCurrentBlock = - { currentBlock.Value with - TAN = Some nextCol } |> Some - updateCurrentBlock - | ColumnCoreNames.Hidden.TermSourceREF -> - // Build in fail safe. - if currentBlock.IsNone then errorMsg1 nextCol currentBlock - if currentBlock.Value.TSR.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.TSR.Value.Header.Value.Header - // Update building block - let updateCurrentBlock = - { currentBlock.Value with - TSR = Some nextCol } |> Some - updateCurrentBlock - | ColumnCoreNames.Hidden.Unit -> - // Build in fail safe. - if currentBlock.IsSome then errorMsg3 nextCol currentBlock currentBlock.Value.MainColumn.Header.Value.Header - // Create unit building block - let newBlock = BuildingBlock.create nextCol None None None |> Some - newBlock - | _ -> - // Build in fail safe. - errorMsg2 nextCol currentBlock - - // Building blocks are defined by one visuable column and an undefined number of hidden columns. - // Therefore we iterate through the columns array and use every column without an `#h` tag as the start of a new building block. - let rec sortColsIntoBuildingBlocks (index:int) (currentBlock:BuildingBlock option) (buildingBlockList:BuildingBlock list) = - // Exit case if we iterated through all columns - if index > (int annoHeaderRange.columnCount - 1) then - // Should we have a 'currentBuildingBlock' add it to the 'buildingBlockList' before returning it. - if currentBlock.IsSome then - currentBlock.Value::buildingBlockList - else - buildingBlockList - else - let nextCol = columns.[index] - // If the nextCol does not have an header it is empty and therefore skipped. - if - nextCol.Header.IsNone - then - sortColsIntoBuildingBlocks (index+1) currentBlock buildingBlockList - // If the nextCol.Header has no tag array or its tag array does NOT contain a hidden tag then it starts a new building block - elif - (nextCol.Header.Value.TagArr.IsSome && nextCol.Header.Value.TagArr.Value |> Array.contains ColumnTags.HiddenTag |> not) - || (nextCol.Header.IsSome && nextCol.Header.Value.TagArr.IsNone) - then - let newBuildingBlock = BuildingBlock.create nextCol None None None |> Some - // If there is a 'currentBlock' we add it to the list of building blocks ('buildingBlockList'). - if currentBlock.IsSome then - sortColsIntoBuildingBlocks (index+1) newBuildingBlock (currentBlock.Value::buildingBlockList) - // If there is no currentBuildingBlock, e.g. at the start of this function we replace the None with the first building block. - else - sortColsIntoBuildingBlocks (index+1) newBuildingBlock buildingBlockList - // if the nextCol.Header has a tag array and it does contain a hidden tag then it is added to the currentBlock - elif - nextCol.Header.Value.TagArr.IsSome && nextCol.Header.Value.TagArr.Value |> Array.contains ColumnTags.HiddenTag - then - // There are multiple possibilities which column this is: TSR; TAN; Unit; Unit TSR; Unit TAN are the currently existing ones. - // We first check if there is NO unit tag in the header tag array - if nextCol.Header.Value.TagArr.Value |> Array.exists (fun x -> x.StartsWith ColumnTags.UnitTagStart) |> not then - let updateCurrentBlock = checkForHiddenColType currentBlock nextCol - sortColsIntoBuildingBlocks (index+1) updateCurrentBlock buildingBlockList - /// Next we check for unit columns in the scheme of `Unit [Term] (#h; #u...) | TSR [Term] (#h; #u...) | TAN [Term] (#h; #u...)` - elif nextCol.Header.Value.TagArr.Value |> Array.exists (fun x -> x.StartsWith ColumnTags.UnitTagStart) then - /// Please notice that we update the unit building block in the following function and not the core building block. - let updatedUnitBlock = checkForHiddenColType currentBlock.Value.Unit nextCol - /// Update the core building block with the updated unit building block. - let updateCurrentBlock = {currentBlock.Value with Unit = updatedUnitBlock} |> Some - sortColsIntoBuildingBlocks (index+1) updateCurrentBlock buildingBlockList - else - failwith "The tag array of the next column to process in 'sortColsIntoBuildingBlocks' can only contain a '#u' tag or not." - else - failwith (sprintf "The tag array of the next column to process in 'sortColsIntoBuildingBlocks' was not recognized as hidden or main column: %A." nextCol.Header) - + /// Sort all columns into building blocks. let buildingBlocks = - sortColsIntoBuildingBlocks 0 None [] - |> List.rev - |> Array.ofList + getBuildingBlocks annoHeaderRange annoBodyRange /// Filter for only building blocks with ontology (indicated by having a TSR and TAN). let buildingBlocksWithOntology = @@ -1024,7 +925,7 @@ let createSearchTermsFromTable (annotationTable') = /// This function will be executed after the SearchTerm types from 'createSearchTermsFromTable' where send to the server to search the database for them. /// Here the results will be written into the table by the stored col and row indices. -let UpdateTableBySearchTerms (annotationTable,insertTerms:SearchTermI []) = +let UpdateTableBySearchTermsI (annotationTable,insertTerms:SearchTermI []) = Excel.run(fun context -> /// This will create a single cell value arr @@ -1178,4 +1079,102 @@ let getTableMetaData (annotationTable) = ) let syncContext (passthroughMessage : string) = - Excel.run (fun context -> context.sync(passthroughMessage)) \ No newline at end of file + Excel.run (fun context -> context.sync(passthroughMessage)) + +let deleteAllCustomXml() = + Excel.run(fun context -> + + let workbook = context.workbook.load(propertyNames = U2.Case2 (ResizeArray[|"customXmlParts"|])) + let customXmlParts = workbook.customXmlParts.load (propertyNames = U2.Case2 (ResizeArray[|"items"|])) + // https://docs.microsoft.com/en-us/javascript/api/excel/excel.customxmlpartcollection?view=excel-js-preview + + promise { + + let! getXml = + context.sync().``then``(fun e -> + let items = customXmlParts.items + let xmls = items |> Seq.map (fun x -> x.delete() ) + + xmls |> Array.ofSeq + ) + + return "Info","Deleted All Custom Xml!" + } + ) + +let getSwateValidationXml() = + 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! xmlParsed, currentSwateValidationXml = getCurrentValidationXml customXmlParts context + + return "Info",sprintf "%A" currentSwateValidationXml + } + ) + +let writeTableValidationToXml(tableValidation:TableValidation,currentSwateVersion:string) = + Excel.run(fun context -> + + // Update DateTime + let newTableValidation = {tableValidation with DateTime = System.DateTime.Now} + + // 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! xmlParsed, currentSwateValidationXml' = getCurrentValidationXml customXmlParts context + + let currentSwateValidationXml = + if currentSwateValidationXml'.IsNone then SwateValidation.init (currentSwateVersion) else currentSwateValidationXml'.Value + + let nextSwateValidationXml = + let newTableValidations = + currentSwateValidationXml.TableValidations + |> List.filter (fun x -> x.TableName <> newTableValidation.TableName || x.WorksheetName <> newTableValidation.WorksheetName) + |> fun filteredValidations -> newTableValidation::filteredValidations + { currentSwateValidationXml with + SwateVersion = currentSwateVersion + TableValidations = newTableValidations + } + + let nextCustomXml = + let nextAsXmlFormat = nextSwateValidationXml.toXml |> SimpleXml.parseElement + let childrenWithoutValidation = xmlParsed.Children |> List.filter (fun child -> + child.Name <> "Validation" + ) + let nextChildren = nextAsXmlFormat::childrenWithoutValidation + { + xmlParsed with + Children = nextChildren + } |> OfficeInterop.HelperFunctions.xmlElementToXmlString + + 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(nextCustomXml) + ) + + // This will be displayed in activity log + return + "Info", + sprintf + "Update Validation Scheme with '%s - %s' @%s" + newTableValidation.WorksheetName + newTableValidation.TableName + ( newTableValidation.DateTime.ToString("yyyy-MM-dd HH:mm") ) + } + ) \ No newline at end of file diff --git a/src/Client/OfficeInterop/Types.fs b/src/Client/OfficeInterop/Types.fs index e68c5bae..e9359021 100644 --- a/src/Client/OfficeInterop/Types.fs +++ b/src/Client/OfficeInterop/Types.fs @@ -87,40 +87,191 @@ module ColumnTags = /// As for now, unit tags can contain a accession number if they are existing unit terms. let UnitTagStart = "#u" -module SwateInteropTypes = - - /// Maybe this can be replaced with AutoFillTypes/ColUnit - type ColumnRepresentation = { - Header : string - /// TODO: this is meant for future application and should be implemented together with separate unit columns - Unit : string option - TagArray : string [] - ParentOntology : string option +open System +open Fable.SimpleXml +open Fable.SimpleXml.Generator + +//module SwateInteropTypes = + +// type ColumnRepresentation = { +// Header : string +// /// TODO: this is meant for future application and should be implemented together with separate unit columns +// Unit : string option +// TagArray : string [] +// ParentOntology : string option +// } with +// static member init (?header) = { +// Header = if header.IsSome then header.Value else "" +// Unit = None +// TagArray = [||] +// ParentOntology = None +// } + +module XmlValidationTypes = + + /// User can define what kind of input a column should have + type ContentType = + | OntologyTerm of string + | Text + | Url + | Boolean + | Number + | Int + | Decimal + + member this.toReadableString = + match this with + | OntologyTerm po -> + sprintf "Ontology [%s]" po + | _ -> + string this + + static member ofString (str:string) = + match str with + | ontology when str.StartsWith "OntologyTerm " -> + let s = ontology.Replace("OntologyTerm ","").Replace("\"","") + OntologyTerm s + | "Text" -> Text + | "Url" -> Url + | "Boolean" -> Boolean + | "Number" -> Number + | "Int" -> Int + | "Decimal" -> Decimal + | _ -> + failwith ( sprintf "Tried parsing '%s' to ContenType. No match found." str ) + + type ColumnValidation = { + ColumnHeader : string + ColumnAdress : int option + Importance : int option + ValidationFormat : ContentType option + Unit : string option + } with + static member create colHeader colAdress importance validationFormat unit = { + ColumnHeader = colHeader + ColumnAdress = colAdress + Importance = importance + ValidationFormat = validationFormat + Unit = unit + } + + static member init (?colHeader, ?colAdress) = { + ColumnHeader = if colHeader.IsSome then colHeader.Value else "" + ColumnAdress = if colAdress.IsSome then colAdress.Value else None + Importance = None + ValidationFormat = None + Unit = None + } + + type TableValidation = { + WorksheetName : string + TableName : string + DateTime : DateTime + // "FirstUser; SecondUser" + Userlist : string list + ColumnValidations: ColumnValidation list } with - static member init (?header) = { - Header = if header.IsSome then header.Value else "" - Unit = None - TagArray = [||] - ParentOntology = None + static member create worksheetName tableName dateTime userlist colValidations = { + WorksheetName = worksheetName + TableName = tableName + DateTime = dateTime + Userlist = userlist + ColumnValidations = colValidations + } + static member init (?worksheetName,?tableName, (?dateTime:DateTime), ?userList) = { + WorksheetName = if worksheetName.IsSome then worksheetName.Value else "" + TableName = if tableName.IsSome then tableName.Value else "" + DateTime = if dateTime.IsSome then dateTime.Value else DateTime.Now + Userlist = if userList.IsSome then userList.Value else [] + ColumnValidations = [] } - type TryFindAnnoTableResult = - | Success of string - | Error of string - - with - static member - /// This function is used on an array of table names (string []). If the length of the array is <> 1 it will trough the correct error. - /// Only returns success if annoTables.Length = 1. Does not check if the existing table names are correct/okay. - exactlyOneAnnotationTable (annoTables:string [])= - match annoTables.Length with - | x when x < 1 -> - Error "Could not find annotationTable in active worksheet. Please create one before trying to execute this function." - | x when x > 1 -> - Error "The active worksheet contains more than one annotationTable. Please move one of them to another worksheet." - | 1 -> - annoTables |> Array.exactlyOne |> Success - | _ -> Error "Could not process message. Swate was not able to identify the given annotation tables with a known case." + /// This type is used to work on the CustomXml 'Validation' tag, which is used to store information on how to validate a specifc Swate table as correct. + type SwateValidation = { + SwateVersion : string + TableValidations : TableValidation list + } with + static member init v = { + SwateVersion = v + TableValidations = [] + } + + member this.toXml = + node "Validation" [ + attr.value("SwateVersion", this.SwateVersion) + ][ + for table in this.TableValidations do + yield + node "TableValidation" [ + attr.value( "WorksheetName", table.WorksheetName ) + attr.value( "TableName", table.TableName ) + attr.value( "DateTime", table.DateTime.ToString("yyyy-MM-dd HH:mm") ) + attr.value( "Userlist", table.Userlist |> String.concat "; " ) + ][ + for column in table.ColumnValidations do + yield + leaf "ColumnValidation" [ + attr.value("ColumnHeader" , column.ColumnHeader) + attr.value("ColumnAdress" , if column.ColumnAdress.IsSome then string column.ColumnAdress.Value else "None") + attr.value("Importance" , if column.Importance.IsSome then string column.Importance.Value else "None") + attr.value("ValidationFormat" , if column.ValidationFormat.IsSome then string column.ValidationFormat.Value else "None") + attr.value("Unit" , if column.Unit.IsSome then column.Unit.Value else "None") + ] + ] + ] |> serializeXml + + static member ofXml (xmlString:string) = + let xml = xmlString |> SimpleXml.parseElement + let swateValidation = + xml |> SimpleXml.tryFindElementByName "Validation" + if swateValidation.IsNone then failwith "Could not find existing tag." + let tableValidations = + xml |> SimpleXml.findElementsByName "TableValidation" + let validationType = SwateValidation.init swateValidation.Value.Attributes.["SwateVersion"] + let tableValidationTypes = + tableValidations + |> List.map (fun table -> + let worksheetName = table.Attributes.["WorksheetName"] + let tableName = table.Attributes.["TableName"] + let dateTime = + //let day, month, year = + // let s = table.Attributes.["DateTime"].Split([|"/"|], StringSplitOptions.None) + // int s.[0], int s.[1], int s.[2] + System.DateTime.Parse(table.Attributes.["DateTime"]) + let userlist = table.Attributes.["Userlist"].Split([|"; "|], StringSplitOptions.RemoveEmptyEntries) |> List.ofSeq + let columnValidationTypes = + table.Children + |> List.map (fun column -> + let columnHeader = column.Attributes.["ColumnHeader"] + let columnAdress = column.Attributes.["ColumnAdress"] |> fun x -> if x = "None" then None else Some (int x) + let importance = column.Attributes.["Importance"] |> fun x -> if x = "None" then None else Some (int x) + let validationFormat = column.Attributes.["ValidationFormat"] |> fun x -> if x = "None" then None else ContentType.ofString x |> Some + let unit = column.Attributes.["Unit"] |> fun x -> if x = "None" then None else Some x + ColumnValidation.create columnHeader columnAdress importance validationFormat unit + ) + TableValidation.create worksheetName tableName dateTime userlist columnValidationTypes + ) + { validationType with TableValidations = tableValidationTypes } + + +type TryFindAnnoTableResult = +| Success of string +| Error of string + + with + static member + /// This function is used on an array of table names (string []). If the length of the array is <> 1 it will trough the correct error. + /// Only returns success if annoTables.Length = 1. Does not check if the existing table names are correct/okay. + exactlyOneAnnotationTable (annoTables:string [])= + match annoTables.Length with + | x when x < 1 -> + Error "Could not find annotationTable in active worksheet. Please create one before trying to execute this function." + | x when x > 1 -> + Error "The active worksheet contains more than one annotationTable. Please move one of them to another worksheet." + | 1 -> + annoTables |> Array.exactlyOne |> Success + | _ -> + Error "Could not process message. Swate was not able to identify the given annotation tables with a known case." type ColHeader = { Header : string @@ -170,4 +321,16 @@ module BuildingBlockTypes = TSR = tsr TAN = tan Unit = unit - } \ No newline at end of file + } + + member this.toColumnValidation : (XmlValidationTypes.ColumnValidation) = + + { + ColumnHeader = this.MainColumn.Header.Value.Header + ColumnAdress = this.MainColumn.Index |> Some + Importance = None + ValidationFormat = None + Unit = if this.Unit.IsSome then this.Unit.Value.MainColumn.Header.Value.Ontology else None + } + + diff --git a/src/Client/Update.fs b/src/Client/Update.fs index 445448b0..c0ba38a9 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -10,7 +10,8 @@ open Routing open Model open Messages open OfficeInterop -open OfficeInterop.Types.SwateInteropTypes + +open OfficeInterop.Types /// This function matches a OfficeInterop.TryFindAnnoTableResult to either Success or Error /// If Success it will pipe the tableName on to the msg input paramter. @@ -76,15 +77,6 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel (GenericError >> Dev) currentState, cmd - | GetTableRepresentation activeTableNameRes -> - let successCmd tableName = - Cmd.OfPromise.either - OfficeInterop.getTableRepresentation - (tableName) - (fun (colReps,msg) -> StoreTableRepresentationFromOfficeInterop (msg,colReps) |> Validation) - (GenericError >> Dev) - let cmd = matchActiveTableResToMsg activeTableNameRes successCmd - currentState, cmd | AutoFitTable activeTableNameRes-> let cmd name = @@ -207,6 +199,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel nextState,Cmd.ofMsg(SyncContext (activeTableNameRes,range)|> ExcelInterop) + | GetParentTerm activeTableNameRes -> let cmd name = Cmd.OfPromise.either @@ -216,6 +209,48 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel (GenericError >> Dev) let cmd = matchActiveTableResToMsg activeTableNameRes cmd currentState, cmd + // + | GetTableValidationXml activeTableNameRes -> + let successCmd tableName = + Cmd.OfPromise.either + OfficeInterop.getTableRepresentation + (tableName) + (fun (currentTableValidation, buildingBlocks,msg) -> + StoreTableRepresentationFromOfficeInterop (currentTableValidation, buildingBlocks, msg) |> Validation) + (GenericError >> Dev) + let cmd = matchActiveTableResToMsg activeTableNameRes successCmd + currentState, cmd + | WriteTableValidationToXml (newTableValidation,currentSwateVersion) -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.writeTableValidationToXml + (newTableValidation, currentSwateVersion) + (fun x -> + Msg.Batch [ + GenericLog x |> Dev + PipeActiveAnnotationTable GetTableValidationXml |> ExcelInterop + ] + ) + (GenericError >> Dev) + + currentState, cmd + | DeleteAllCustomXml -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.deleteAllCustomXml + () + (GenericLog >> Dev) + (GenericError >> Dev) + currentState, cmd + | GetSwateValidationXml -> + let cmd = + Cmd.OfPromise.either + OfficeInterop.getSwateValidationXml + () + (GenericLog >> Dev) + (GenericError >> Dev) + currentState, cmd + // | ToggleEventHandler -> let cmd = Cmd.OfPromise.either @@ -240,7 +275,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel | FillHiddenColsRequest activeTableNameRes -> let cmd name = Cmd.OfPromise.either - OfficeInterop.createSearchTermsFromTable + OfficeInterop.createSearchTermsIFromTable (name) (SearchForInsertTermsRequest >> Request >> Api) (fun e -> @@ -256,7 +291,7 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel | FillHiddenColumns (tableName,insertTerms) -> let cmd = Cmd.OfPromise.either - OfficeInterop.UpdateTableBySearchTerms + OfficeInterop.UpdateTableBySearchTermsI (tableName,insertTerms) (fun msg -> Msg.Batch [ @@ -1086,44 +1121,20 @@ let handleAddBuildingBlockMsg (addBuildingBlockMsg:AddBuildingBlockMsg) (current } nextState, Cmd.none +open OfficeInterop.Types.XmlValidationTypes + let handleValidationMsg (validationMsg:ValidationMsg) (currentState: ValidationState) : ValidationState * Cmd = match validationMsg with /// This message gets its values from ExcelInteropMsg.GetTableRepresentation. /// It is used to update ValidationState.TableRepresentation and to transform the new information to ValidationState.TableValidationScheme. - | StoreTableRepresentationFromOfficeInterop (msg,colReps) -> - let updateValFormat (prevValFormats: ValidationFormat []) (newColReps:OfficeInterop.Types.SwateInteropTypes.ColumnRepresentation []) = - newColReps - |> Array.map (fun colRep -> - // create ValidationFormat from ColumnRepresentation - let newValFormat = ValidationFormat.init(header=colRep.Header) - // check if the column was already existing - let existingValFormatOpt= prevValFormats |> Array.tryFind (fun valFormat -> valFormat.ColumnHeader = colRep.Header) - match existingValFormatOpt with - | Some prevValFormat -> - // if the column was existing fill the new ValidationFormat with the previousValidationFormat information about - // content type and importance. - {newValFormat with - Importance = prevValFormat.Importance - ContentType = - match prevValFormat.ContentType with - | Some (OntologyTerm po) -> - if colRep.ParentOntology.IsSome then - Some (OntologyTerm colRep.ParentOntology.Value) - else - None - | _ -> - prevValFormat.ContentType - } - | None -> - newValFormat - ) + | StoreTableRepresentationFromOfficeInterop (tableValidation:TableValidation, buildingBlocks:BuildingBlockTypes.BuildingBlock [], msg) -> let nextCmd = GenericLog ("Info", msg) |> Dev |> Cmd.ofMsg let nextState = { currentState with - TableRepresentation = colReps - TableValidationScheme = updateValFormat currentState.TableValidationScheme colReps + ActiveTableBuildingBlocks = buildingBlocks + TableValidationScheme = tableValidation } nextState, nextCmd @@ -1133,19 +1144,11 @@ let handleValidationMsg (validationMsg:ValidationMsg) (currentState: ValidationS DisplayedOptionsId = intOpt } nextState, Cmd.none - - | UpdateValidationFormat (oldValFormat,newValFormat) -> - let newFormatArr = - currentState.TableValidationScheme - |> Array.map (fun x -> if x = oldValFormat then newValFormat else x) + | UpdateTableValidationScheme tableValidation -> let nextState = { currentState with - TableValidationScheme = newFormatArr + TableValidationScheme = tableValidation } - // Creates a LOT of log - //let cmd = - // let t = sprintf "Changed Validation Format: %s to: Importance: %A, Content Type: %A" oldValFormat.ColumnHeader oldValFormat.Importance oldValFormat.ContentType - // GenericLog ("Debug",t) |> Dev |> Cmd.ofMsg nextState, Cmd.none let update (msg : Msg) (currentModel : Model) : Model * Cmd = @@ -1162,7 +1165,7 @@ let update (msg : Msg) (currentModel : Model) : Model * Cmd = let nextCmd = match pageOpt with | Some Routing.Route.Validation -> - PipeActiveAnnotationTable GetTableRepresentation |> ExcelInterop |> Cmd.ofMsg + PipeActiveAnnotationTable GetTableValidationXml |> ExcelInterop |> Cmd.ofMsg | _ -> Cmd.none let nextPageState = diff --git a/src/Client/Views/ActivityLogView.fs b/src/Client/Views/ActivityLogView.fs index 71802d41..5ab631eb 100644 --- a/src/Client/Views/ActivityLogView.fs +++ b/src/Client/Views/ActivityLogView.fs @@ -4,6 +4,8 @@ open Fulma open Fable open Fable.React open Fable.React.Props +open Fable.FontAwesome + open Model open Messages @@ -12,18 +14,18 @@ open Messages let activityLogComponent (model:Model) dispatch = div [][ Button.button [ - Button.Color Color.IsDanger + Button.Color Color.IsLink Button.IsFullWidth Button.OnClick (fun e -> UpdatePageState (Some Routing.Route.TermSearch) |> dispatch) Button.Props [Style [MarginBottom "1rem"]] ][ str "Back to Term Search" ] + Help.help [][str "This page is used for development/debugging."] //Button.button [ // Button.Color Color.IsInfo // Button.IsFullWidth - // Button.OnClick (fun e -> - // (fun tableName -> TryExcel (tableName, model.FilePickerState.FileNames))|> PipeActiveAnnotationTable |> ExcelInterop |> dispatch ) + // Button.OnClick (fun e -> TryExcel |> ExcelInterop |> dispatch ) // Button.Props [Style [MarginBottom "1rem"]] //] [ // str "Try Excel" @@ -36,7 +38,37 @@ let activityLogComponent (model:Model) dispatch = //] [ // str "Try Excel2" //] - Help.help [][str "This page is used for development/debugging."] + Label.label [][str "Dangerzone"] + Container.container [ + Container.Props [Style [ + Padding "1rem" + Border "2.5px solid #f14668" + BorderRadius "10px" + ]] + ][ + Button.a [ + Button.Color Color.IsWarning + Button.IsFullWidth + Button.OnClick (fun e -> GetSwateValidationXml |> ExcelInterop |> dispatch ) + Button.Props [Style [MarginBottom "1rem"]; Title "Show record type data of Swate validation Xml"] + ] [ + span [] [str "Show Swate Validation Xml!"] + ] + Button.a [ + Button.Color Color.IsDanger + Button.IsFullWidth + Button.OnClick (fun e -> DeleteAllCustomXml |> ExcelInterop |> dispatch ) + Button.Props [Style [MarginBottom "1rem"]; Title "Be sure you know what you do. This cannot be undone!"] + ] [ + Icon.icon [ ] [ + Fa.i [Fa.Solid.ExclamationTriangle][] + ] + span [] [str "Delete All Custom Xml!"] + Icon.icon [ ] [ + Fa.i [Fa.Solid.ExclamationTriangle][] + ] + ] + ] Table.table [ Table.IsFullWidth Table.Props [ExcelColors.colorBackground model.SiteStyleState.ColorMode] diff --git a/src/Client/Views/ValidationView.fs b/src/Client/Views/ValidationView.fs index bba63c19..2bcf9eea 100644 --- a/src/Client/Views/ValidationView.fs +++ b/src/Client/Views/ValidationView.fs @@ -3,19 +3,21 @@ module ValidationView open Fable.React open Fable.React.Props open Fulma -open ExcelColors -open Model -open Messages +open Fulma.Extensions.Wikiki +open Fable.FontAwesome open Browser open Browser.MediaQueryList open Browser.MediaQueryListExtensions +open ExcelColors +open Model +open Messages + open CustomComponents -open Fulma.Extensions.Wikiki -open Fable.FontAwesome +open OfficeInterop.Types.XmlValidationTypes -let columnListElement ind (format:ValidationFormat) (model:Model) dispatch = +let columnListElement ind (columnValidation:ColumnValidation) (model:Model) dispatch = let isActive = match model.ValidationState.DisplayedOptionsId with | Some id when id = ind -> @@ -39,16 +41,16 @@ let columnListElement ind (format:ValidationFormat) (model:Model) dispatch = UpdateDisplayedOptionsId (Some ind) |> Validation |> dispatch ) ][ - td [][str format.ColumnHeader] + td [][str columnValidation.ColumnHeader] td [][ - if format.Importance.IsSome then - str (string format.Importance.Value) + if columnValidation.Importance.IsSome then + str (string columnValidation.Importance) else str "X" ] td [][ - if format.ContentType.IsSome then - str format.ContentType.Value.toString + if columnValidation.ValidationFormat.IsSome then + str columnValidation.ValidationFormat.Value.toReadableString else str "X" ] @@ -59,8 +61,18 @@ let columnListElement ind (format:ValidationFormat) (model:Model) dispatch = ] ] -let checkradioElement (id:int) (contentTypeOpt:ContentType option) (format:ValidationFormat) dispatch = - let contentType = if contentTypeOpt.IsSome then contentTypeOpt.Value.toString else "None" +let updateTableValidationByColValidation (model:Model) (updatedColValidation:ColumnValidation) = + { + model.ValidationState.TableValidationScheme with + ColumnValidations = + model.ValidationState.TableValidationScheme.ColumnValidations + |> List.filter (fun x -> x.ColumnHeader <> updatedColValidation.ColumnHeader) + |> fun filteredList -> updatedColValidation::filteredList + |> List.sortBy (fun colVal -> colVal.ColumnAdress) + } + +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"]] @@ -89,13 +101,15 @@ let checkradioElement (id:int) (contentTypeOpt:ContentType option) (format:Valid Name (sprintf "ContentType%i" id) Disabled isDisabled OnChange (fun e -> - let newFormat = { - format with - ContentType = contentTypeOpt + let nextColumnValidation = { + columnValidation with + ValidationFormat = contentTypeOpt } - UpdateValidationFormat (format,newFormat) |> Validation |> dispatch + let nextTableValidation = + updateTableValidationByColValidation model nextColumnValidation + UpdateTableValidationScheme nextTableValidation |> Validation |> dispatch ) - Checked (contentTypeOpt = format.ContentType) + Checked (contentTypeOpt = columnValidation.ValidationFormat) ] label [ @@ -108,26 +122,24 @@ let checkradioElement (id:int) (contentTypeOpt:ContentType option) (format:Valid ][] ] -let checkradioList (ind:int) (hasOntology:string option) format dispatch= +let checkradioList (ind:int) (hasOntology:string option) colVal model dispatch = + let ontologyContent = if hasOntology.IsSome then ContentType.OntologyTerm hasOntology.Value |> Some else ContentType.OntologyTerm "None" |> Some [ - checkradioElement ind None format dispatch + checkradioElement ind None colVal model dispatch - checkradioElement ind (Some ContentType.Number) format dispatch - checkradioElement ind (Some ContentType.Int) format dispatch - checkradioElement ind (Some ContentType.Decimal) format dispatch - checkradioElement ind (Some ContentType.Text) format dispatch - checkradioElement ind (Some ContentType.Url) format dispatch - checkradioElement ind ( - if hasOntology.IsSome then ContentType.OntologyTerm hasOntology.Value |> Some else ContentType.OntologyTerm "None" |> Some - ) - format - dispatch + checkradioElement ind (Some ContentType.Number) colVal model dispatch + checkradioElement ind (Some ContentType.Int) colVal model dispatch + checkradioElement ind (Some ContentType.Decimal) colVal model dispatch + checkradioElement ind (Some ContentType.Text) colVal model dispatch + checkradioElement ind (Some ContentType.Url) colVal model dispatch + + checkradioElement ind ontologyContent colVal model dispatch ] -let findOntology (format:ValidationFormat) (colReps:OfficeInterop.Types.SwateInteropTypes.ColumnRepresentation []) = - colReps - |> Array.find (fun x -> x.Header = format.ColumnHeader) - |> fun x -> x.ParentOntology +let findOntology (columnValidation:ColumnValidation) (buildingBlocks:OfficeInterop.Types.BuildingBlockTypes.BuildingBlock []) = + buildingBlocks + |> Array.find (fun x -> x.MainColumn.Header.Value.Header = columnValidation.ColumnHeader) + |> fun x -> x.MainColumn.Header.Value.Ontology let sliderElements id format dispatch = let defaultSliderVal = string (if format.Importance.IsSome then format.Importance.Value else 0) @@ -159,7 +171,7 @@ let sliderElements id format dispatch = open Fable.Core.JsInterop /// Submit button to apply slider changes to model. If slider.OnChange would dispatch message the app would suffer from lag spikes. -let submitButton ind format dispatch = +let submitButton ind columnValidation (model:Model) dispatch = Button.span [ Button.Color IsSuccess Button.IsOutlined @@ -169,18 +181,20 @@ let submitButton ind format dispatch = let sliderEle = Browser.Dom.document.getElementById(sliderId) let impoValue = sliderEle?value printfn "%s" impoValue - let newFormat = { - format with + let nextColumnValidation = { + columnValidation with Importance = if impoValue = "0" then None else int impoValue |> Some } - UpdateValidationFormat (format,newFormat) |> Validation |> dispatch + let nextTableValidation = + updateTableValidationByColValidation model nextColumnValidation + UpdateTableValidationScheme nextTableValidation |> Validation |> dispatch ) ][ str "Submit Importance" ] -let optionsElement ind (format:ValidationFormat) (model:Model) dispatch = - let hasOntology = findOntology format model.ValidationState.TableRepresentation +let optionsElement ind (columnValidation:ColumnValidation) (model:Model) dispatch = + let hasOntology = findOntology columnValidation model.ValidationState.ActiveTableBuildingBlocks let isVisible = match model.ValidationState.DisplayedOptionsId with | Some id when id = ind -> @@ -206,7 +220,7 @@ let optionsElement ind (format:ValidationFormat) (model:Model) dispatch = Help.help [Help.Props [Style [MarginBottom "1rem"]]][str "Select the specific type of content for the selected column."] - yield! checkradioList ind hasOntology format dispatch + yield! checkradioList ind hasOntology columnValidation model dispatch ] Column.column [][ @@ -214,9 +228,9 @@ let optionsElement ind (format:ValidationFormat) (model:Model) dispatch = Help.help [][str "Define how important it is to fill in the column correctly."] - yield! sliderElements ind format dispatch + yield! sliderElements ind columnValidation dispatch - submitButton ind format dispatch + submitButton ind columnValidation model dispatch ] ] ] @@ -232,15 +246,40 @@ let validationComponent model dispatch = ] [ Label.label [Label.Size Size.IsLarge; Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]] [ str "Table Validation"] - Help.help [Help.Color IsDanger] [ - str "This is currently a preview feature and is still missing a lot of features. See " - a [Href "https://github.com/nfdi4plants/Swate/issues/45"; Target "_Blank"][str "here"] - str " for the newst updates on this feature." - ] + //Help.help [Help.Color IsDanger] [ + // str "This is currently a preview feature and is still missing a lot of features. See " + // a [Href "https://github.com/nfdi4plants/Swate/issues/45"; Target "_Blank"][str "here"] + // str " for the newst updates on this feature." + //] Field.div [Field.Props [Style [ Width "100%" ]]] [ + Button.a [ + Button.Color Color.IsInfo + Button.IsFullWidth + Button.OnClick (fun e -> PipeActiveAnnotationTable GetTableValidationXml |> ExcelInterop |> dispatch ) + Button.Props [Style [MarginBottom "1rem"]] + ] [ + str "Update Table Representation" + ] + // Worksheet - annotationTable name - DateTime of saving + div [ + Id "TableRepresentationInfoHeader" + OnTransitionEnd (fun e -> + let header = Browser.Dom.document.getElementById("TableRepresentationInfoHeader") + header?style?opacity <- 1 + header?style?transition <- "unset" + ) + ][ + b [][ + str model.ValidationState.TableValidationScheme.WorksheetName + ] + str " - " + str model.ValidationState.TableValidationScheme.TableName + str " - " + str ( model.ValidationState.TableValidationScheme.DateTime.ToString("yyyy-MM-dd HH:mm") ) + ] Table.table [ Table.IsHoverable; Table.IsFullWidth ] [ thead [ ] [ tr [ ] [ @@ -251,13 +290,27 @@ let validationComponent model dispatch = ] ] tbody [ ] [ - for i in 0 .. model.ValidationState.TableValidationScheme.Length-1 do - let f = model.ValidationState.TableValidationScheme.[i] + for i in 0 .. model.ValidationState.TableValidationScheme.ColumnValidations.Length-1 do + let colVal = model.ValidationState.TableValidationScheme.ColumnValidations.[i] yield! [ - columnListElement i f model dispatch - optionsElement i f model dispatch + columnListElement i colVal model dispatch + optionsElement i colVal model dispatch ] ] ] + // Submit new validation scheme. This will write custom xml into the workbook. + Button.a [ + Button.Color Color.IsSuccess + Button.IsFullWidth + Button.OnClick (fun e -> + let header = Browser.Dom.document.getElementById("TableRepresentationInfoHeader") + header?style?transition <- "0.3s ease" + header?style?opacity <- 0 + WriteTableValidationToXml (model.ValidationState.TableValidationScheme, model.PersistentStorageState.AppVersion) |> ExcelInterop |> dispatch + ) + Button.Props [Style [MarginBottom "1rem"]] + ] [ + str "Add validation to workbook" + ] ] ] \ No newline at end of file diff --git a/src/Client/paket.references b/src/Client/paket.references index 95e5d425..552c2bcb 100644 --- a/src/Client/paket.references +++ b/src/Client/paket.references @@ -12,4 +12,5 @@ Fulma.Extensions.Wikiki.Checkradio Fulma.Extensions.Wikiki.Slider Thoth.Elmish.Debouncer Fable.Browser.MediaQueryList -Fable.SimpleJson \ No newline at end of file +Fable.SimpleJson +Fable.SimpleXml \ No newline at end of file diff --git a/src/Server/paket.references b/src/Server/paket.references index a06e415c..657cc0fb 100644 --- a/src/Server/paket.references +++ b/src/Server/paket.references @@ -1,5 +1,4 @@ Saturn Fable.Remoting.Giraffe -Microsoft.Data.SqlClient MySql.Data Microsoft.Extensions.Configuration.UserSecrets \ No newline at end of file From 1e43570f9a3a0785f4732edb7fb4d4ae3647e197 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Tue, 22 Dec 2020 22:27:27 +0100 Subject: [PATCH 06/10] Update RELEASE_NOTES.md --- RELEASE_NOTES.md | 11 +++++++++++ src/Server/Version.fs | 8 ++++---- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 6ae731fa..b1fec8b1 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,3 +1,14 @@ +### 0.1.4+d4a36f1 (Released 2020-12-22) +* Additions: + * latest commit #d4a36f1 + * [[#d4a36f1](https://github.com/nfdi4plants/Swate/commit/d4a36f1e3417f5e49c184392e30d95d353f54a07)] Provide validation information via XML metadata (Issue #45). :christmas_tree: :fireworks: + * [[#f3a11f0](https://github.com/nfdi4plants/Swate/commit/f3a11f0257f5d7d25a67dfdb85700903573d9ec1)] Update FilePicker with reordering functionality (Issue #13). + * [[#f6564d6](https://github.com/nfdi4plants/Swate/commit/f6564d65c9985c82cbad3b482792e94379a7b34b)] Add search term search by accession number (Issue #71). + * [[#bdba3ae](https://github.com/nfdi4plants/Swate/commit/bdba3ae061d4c0aa473eef19ab2c55586582c462)] Properly Document Office interop functions (Issue #75). + * [[#e958024](https://github.com/nfdi4plants/Swate/commit/e958024d7ac0f804107eaf55fb66e74e966acd63)] Improve readme :book: +* Bugfixes: + * [[#889b86c](https://github.com/nfdi4plants/Swate/commit/889b86c466c454e736daf950ac0df4f77dcb6355)] Fix file picker not uploading reoccuring file names (Issue #80). + ### 0.1.3+c6ad5b7 (Released 2020-12-7) * Additions: * latest commit #c6ad5b7 diff --git a/src/Server/Version.fs b/src/Server/Version.fs index 0d9c0a78..c9871657 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.1.3" - let [] AssemblyMetadata_ReleaseDate = "07/12/2020" + let [] AssemblyVersion = "0.1.4" + let [] AssemblyMetadata_ReleaseDate = "22/12/2020" From 1182030d57695643e9b333f0bfbdfe11e64ceab2 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 11 Jan 2021 08:27:40 +0100 Subject: [PATCH 07/10] Add Setting Page --- src/Client/Client.fs | 8 +- src/Client/Client.fsproj | 2 + src/Client/CustomComponents/DwnButton.fs | 113 +++++++++++++++++++++++ src/Client/CustomComponents/Navbar.fs | 39 +++----- src/Client/Routing.fs | 6 +- src/Client/Views/ActivityLogView.fs | 9 +- src/Client/Views/SettingsView.fs | 70 ++++++++++++++ 7 files changed, 214 insertions(+), 33 deletions(-) create mode 100644 src/Client/CustomComponents/DwnButton.fs create mode 100644 src/Client/Views/SettingsView.fs diff --git a/src/Client/Client.fs b/src/Client/Client.fs index 746af5c1..2ef8661a 100644 --- a/src/Client/Client.fs +++ b/src/Client/Client.fs @@ -87,6 +87,13 @@ let view (model : Model) (dispatch : Msg -> unit) = Text.p [] [str ""] ] + | Routing.Route.Settings -> + BaseView.baseViewComponent model dispatch [ + SettingsView.settingsViewComponent model dispatch + ] [ + Text.p [] [str ""] + ] + | Routing.Route.Info -> BaseView.baseViewComponent model dispatch [ InfoView.infoComponent model dispatch @@ -106,7 +113,6 @@ 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;] // ] [ diff --git a/src/Client/Client.fsproj b/src/Client/Client.fsproj index aed59c40..b1a24fb8 100644 --- a/src/Client/Client.fsproj +++ b/src/Client/Client.fsproj @@ -21,6 +21,7 @@ + @@ -39,6 +40,7 @@ + diff --git a/src/Client/CustomComponents/DwnButton.fs b/src/Client/CustomComponents/DwnButton.fs new file mode 100644 index 00000000..3d268758 --- /dev/null +++ b/src/Client/CustomComponents/DwnButton.fs @@ -0,0 +1,113 @@ +module DwnButton + +open Fable.Core +open Fable.Core.JsInterop +open Browser +open Browser.Dom +open Browser.Blob +open Fulma + +open Model +open Fable.React +open Fable.Core + +// Copied from Fable.Browser.URL because it is not available in the REPL +// But please include Fable.Broser.URL in your project +type [] URL = + abstract hash: string with get, set + abstract host: string with get, set + abstract hostname: string with get, set + abstract href: string with get, set + abstract origin: string + abstract password: string with get, set + abstract pathname: string with get, set + abstract port: string with get, set + abstract protocol: string with get, set + abstract search: string with get, set + abstract username: string with get, set + // abstract searchParams: URLSearchParams + abstract toString: unit -> string + abstract toJSON: unit -> string + +type [] URLType = + [] abstract Create: url: string -> URL + /// Returns a DOMString containing a unique blob URL, that is a URL with blob: as its scheme, followed by an opaque string uniquely identifying the object in the browser. + abstract createObjectURL: obj -> string + /// Revokes an object URL previously created using URL.createObjectURL(). + abstract revokeObjectURL: string -> unit + +module Url = + let [] URL: URLType = jsNative + + +let blobOptions = + jsOptions(fun o -> + o.``type`` <- "text/csv" + ) + +// download property seems to be missing the binding definition so we use dynamic typing + +// Sadly this also does not work in local excel +let dwnButton (model:Model) dispatch csvData = + Button.a [ + Button.IsFullWidth + Button.Color IsInfo + Button.OnClick (fun e -> + let blob = Blob.Create([| box csvData |], blobOptions) + let elem = window.document.createElement("a") :?> Types.HTMLAnchorElement + elem.href <- Url.URL.createObjectURL(box blob) + + elem?download <- "filename.csv" + document.body.appendChild(elem) |> ignore + elem.click() + document.body.removeChild(elem) |> ignore + ) + ][ + str "Download" + ] + +open Fable.Core.JS + +/// Client Side Download; This works online but not in local Excel +let text = encodeURIComponent("This is a test input") +let csvData = + "col1;col2\n1;2\n3;4" + +//a [Href (sprintf """data:text/plain;charset=utf-8,%s""" text); Download "Texti.txt"; Target "_Blank"][str "Click me"] +//Button.button [ +// Button.Color Color.IsLink +// Button.IsFullWidth +// Button.OnClick (fun e -> +// let iframeId = "dwn-iframe" +// // https://ourcodeworld.com/articles/read/189/how-to-create-a-file-and-generate-a-download-with-javascript-in-the-browser-without-a-server +// // https://stackoverflow.com/questions/3665115/how-to-create-a-file-in-memory-for-user-to-download-but-not-through-server +// // https://stackoverflow.com/questions/61323775/how-to-open-a-link-in-the-standard-browser-from-an-office-addin/65594049#65594049 + +// //let element = Browser.Dom.document.getElementById "frame-dwn" + +// let iframe = +// let iframe = Browser.Dom.document.createElement("iframe") +// iframe.setAttribute("sandbox", "allow-top-navigation allow-downloads allow-same-origin") +// iframe.setAttribute("id", iframeId) +// iframe + +// let downloadInIFrame (iframe:HTMLElement) = +// let p = iframe :?> Browser.Types.HTMLIFrameElement +// let a = p.contentWindow.document.createElement ("a") +// a.setAttribute ("href", sprintf """data:text/plain;charset=utf-8,%s""" text) +// a.setAttribute("download", "TestFile.txt") +// a.innerText <- "Click me" +// let _ = p.contentWindow.document.body.appendChild a +// //a.click() +// //let _ = p.contentWindow.document.body.removeChild a +// () + +// downloadInIFrame iframe +// //element.setAttribute("srcdoc", "
") +// //let _ = Browser.Dom.document.body.removeChild(element) +// () +// ) +// Button.Props [Style [MarginBottom "1rem"]] +//][ +// str "Download Activity Log" +//] \ No newline at end of file diff --git a/src/Client/CustomComponents/Navbar.fs b/src/Client/CustomComponents/Navbar.fs index 5f287267..0297bf6a 100644 --- a/src/Client/CustomComponents/Navbar.fs +++ b/src/Client/CustomComponents/Navbar.fs @@ -3,7 +3,7 @@ module CustomComponents.Navbar open Fable.React open Fable.React.Props open Fulma -open Fulma.Extensions.Wikiki + open ExcelColors open Model open Messages @@ -43,22 +43,6 @@ let navbarComponent (model : Model) (dispatch : Msg -> unit) = Fa.i [Fa.Solid.SyncAlt][] ] ] - Navbar.Item.a [Navbar.Item.Props [Title "Toggle Reference Column Input Assist"; Style [ Color model.SiteStyleState.ColorMode.Text]]] [ - Button.a [ - Button.Props [Style [BackgroundColor model.SiteStyleState.ColorMode.ElementBackground]] - Button.OnClick (fun _ -> - ToggleEventHandler |> ExcelInterop |> dispatch - ) - Button.Color Color.IsWhite - Button.IsInverted - ] [ - Fa.span [Fa.Solid.Edit][] - Fa.span [ - Fa.Solid.Sync - if model.ExcelState.TablesHaveAutoEditHandler then Fa.Spin - ][] - ] - ] Navbar.Item.a [Navbar.Item.Props [Title "Fill Reference Columns"; Style [ Color model.SiteStyleState.ColorMode.Text]]] [ Button.a [ Button.Props [Style [BackgroundColor model.SiteStyleState.ColorMode.ElementBackground]] @@ -87,23 +71,22 @@ 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.Start.div [] [ + Navbar.Dropdown.div [ ] [ Navbar.Item.a [Navbar.Item.Props [Style [ Color model.SiteStyleState.ColorMode.Text]]] [ str "How to use" ] - ] - Navbar.End.div [] [ - Navbar.Item.div [Navbar.Item.Props [ Style [if model.SiteStyleState.IsDarkMode then Color model.SiteStyleState.ColorMode.Text else Color model.SiteStyleState.ColorMode.Fade]]] [ - Switch.switchInline [ - Switch.Id "DarkModeSwitch" - Switch.IsOutlined - Switch.Color IsSuccess - Switch.OnChange (fun _ -> ToggleColorMode |> StyleChange |> dispatch) - ] [span [Class "nonSelectText"][str "DarkMode"]] - ] Navbar.Item.a [Navbar.Item.Props [Style [ Color model.SiteStyleState.ColorMode.Text]]] [ str "Contact" ] + Navbar.Item.a [Navbar.Item.Props [ + OnClick (fun e -> + ToggleBurger |> StyleChange |> dispatch + UpdatePageState (Some Routing.Route.Settings) |> dispatch + ) + Style [ Color model.SiteStyleState.ColorMode.Text] + ]] [ + str "Settings" + ] Navbar.Item.a [Navbar.Item.Props [ Style [ Color model.SiteStyleState.ColorMode.Text]; OnClick (fun e -> diff --git a/src/Client/Routing.fs b/src/Client/Routing.fs index e2f46daf..93786b05 100644 --- a/src/Client/Routing.fs +++ b/src/Client/Routing.fs @@ -14,6 +14,7 @@ type Route = | FilePicker | Info | ActivityLog +| Settings | NotFound static member toRouteUrl (route:Route) = @@ -25,6 +26,7 @@ type Route = | Route.FilePicker -> "/#FilePicker" | Route.Info -> "/#Info" | Route.ActivityLog -> "/#ActivityLog" + | Route.Settings -> "/#Settings" | Route.NotFound -> "/#NotFound" static member toString (route:Route) = @@ -36,6 +38,7 @@ type Route = | Route.Info -> "Info" | Route.FilePicker -> "FilePicker" | Route.ActivityLog -> "ActivityLog" + | Route.Settings -> "Settings" | Route.NotFound -> "NotFound" static member toIcon (p: Route)= @@ -74,10 +77,11 @@ module Routing = map Route.Home (s "") map Route.TermSearch (s "TermSearch") map Route.AddBuildingBlock (s "AddBuildingBlock") - map Route.Validation (s "Validation") + map Route.Validation (s "Validation") map Route.FilePicker (s "FilePicker") map Route.Info (s "Info") map Route.ActivityLog (s "ActivityLog") + map Route.Settings (s "Settings") map Route.NotFound (s "NotFound") ] diff --git a/src/Client/Views/ActivityLogView.fs b/src/Client/Views/ActivityLogView.fs index 5ab631eb..bbdee40d 100644 --- a/src/Client/Views/ActivityLogView.fs +++ b/src/Client/Views/ActivityLogView.fs @@ -5,9 +5,12 @@ open Fable open Fable.React open Fable.React.Props open Fable.FontAwesome +open Fable.Core.JS +open Fable.Core.JsInterop open Model open Messages +open Browser.Types //TO-DO: Save log as tab seperated file @@ -18,7 +21,7 @@ let activityLogComponent (model:Model) dispatch = Button.IsFullWidth Button.OnClick (fun e -> UpdatePageState (Some Routing.Route.TermSearch) |> dispatch) Button.Props [Style [MarginBottom "1rem"]] - ][ + ] [ str "Back to Term Search" ] Help.help [][str "This page is used for development/debugging."] @@ -58,7 +61,7 @@ let activityLogComponent (model:Model) dispatch = Button.Color Color.IsDanger Button.IsFullWidth Button.OnClick (fun e -> DeleteAllCustomXml |> ExcelInterop |> dispatch ) - Button.Props [Style [MarginBottom "1rem"]; Title "Be sure you know what you do. This cannot be undone!"] + Button.Props [Style []; Title "Be sure you know what you do. This cannot be undone!"] ] [ Icon.icon [ ] [ Fa.i [Fa.Solid.ExclamationTriangle][] @@ -79,4 +82,4 @@ let activityLogComponent (model:Model) dispatch = ) ] ] - \ No newline at end of file + diff --git a/src/Client/Views/SettingsView.fs b/src/Client/Views/SettingsView.fs new file mode 100644 index 00000000..f74d76aa --- /dev/null +++ b/src/Client/Views/SettingsView.fs @@ -0,0 +1,70 @@ +module SettingsView + +open Fulma +open Fable +open Fable.React +open Fable.React.Props +open Fable.FontAwesome +open Fable.Core.JS +open Fable.Core.JsInterop + +open Model +open Messages +open Browser.Types +open Fulma.Extensions.Wikiki + +let toggleDarkModeElement (model:Model) dispatch = + Level.level [Level.Level.IsMobile][ + Level.left [][ + str "Darkmode" + ] + Level.right [ Props [ Style [if model.SiteStyleState.IsDarkMode then Color model.SiteStyleState.ColorMode.Text else Color model.SiteStyleState.ColorMode.Fade]]] [ + Switch.switchInline [ + Switch.Id "DarkModeSwitch" + Switch.IsOutlined + Switch.Color IsSuccess + Switch.OnChange (fun _ -> ToggleColorMode |> StyleChange |> dispatch) + ] [span [Class "nonSelectText"][str "DarkMode"]] + ] + ] + +let toggleAutoDeleteAssistElement (model:Model) dispatch = + Level.level [Level.Level.IsMobile][ + Level.left [Props [Style [Display DisplayOptions.Block]]] [ + str "Toggle Reference Column Input Assist" + ] + Level.right [Props [Title "Toggle Reference Column Input Assist"]][ + Button.a [ + Button.Props [Style []] + Button.OnClick (fun _ -> + ToggleEventHandler |> ExcelInterop |> dispatch + ) + ] [ + Fa.span [Fa.Solid.Edit][] + Fa.span [ + Fa.Solid.Sync + if model.ExcelState.TablesHaveAutoEditHandler then Fa.Spin][] + ] + ] + ] + +let settingsViewComponent (model:Model) dispatch = + div [ + + ][ + Label.label [Label.Size Size.IsLarge; Label.Props [Style [Color model.SiteStyleState.ColorMode.Accent]]][ str "Swate Settings"] + Label.label [][str "Customize Swate"] + toggleDarkModeElement model dispatch + + Label.label [][ + str "Adjust Swate Settings" + Fa.i [ + Fa.Solid.QuestionCircle; + Fa.Props [ + Style [MarginLeft "3px"; Cursor "pointer"] + Title "Swate creates hidden reference columns for each building block. With this setting turned on this information will be deleted whenever the main column value changes." + ] + ][] + ] + toggleAutoDeleteAssistElement model dispatch + ] \ No newline at end of file From 9c07338a624240d1f3119cee243164186c5203b2 Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 11 Jan 2021 08:42:06 +0100 Subject: [PATCH 08/10] Fix input assistance is not added when first table is created (Issue #82). --- src/Client/OfficeInterop/OfficeInterop.fs | 20 ++++++++++++++------ src/Client/Update.fs | 7 ++++++- 2 files changed, 20 insertions(+), 7 deletions(-) diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index bf0aa615..3eb8a95b 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -181,18 +181,26 @@ let createAnnotationTable ((allTableNames:String []),isDark:bool) = activeSheet.getUsedRange().format.autofitColumns() activeSheet.getUsedRange().format.autofitRows() + let annoTableName = allTableNames |> Array.filter (fun x -> x.StartsWith "annotationTable") + /// Should event handlers be active, then add them to the new table, otherwise don't. /// If the storage map is empty then eventhanderls should be deactivated. - if EventHandlerStates.adaptHiddenColsHandlerList.IsEmpty then - () - else - EventHandlerStates.adaptHiddenColsHandlerList <- - EventHandlerStates.adaptHiddenColsHandlerList.Add (newName, annotationTable.onChanged.add(fun eventArgs -> adaptHiddenColsHandler (eventArgs,newName)) ) + let updateEventHandler = + if EventHandlerStates.adaptHiddenColsHandlerList.IsEmpty |> not then + EventHandlerStates.adaptHiddenColsHandlerList <- + EventHandlerStates.adaptHiddenColsHandlerList.Add (newName, annotationTable.onChanged.add(fun eventArgs -> adaptHiddenColsHandler (eventArgs,newName)) ) + false + elif annoTableName |> Array.isEmpty then + EventHandlerStates.adaptHiddenColsHandlerList <- + EventHandlerStates.adaptHiddenColsHandlerList.Add (newName, annotationTable.onChanged.add(fun eventArgs -> adaptHiddenColsHandler (eventArgs,newName)) ) + true + else + false r.enableEvents <- true /// Return info message - TryFindAnnoTableResult.Success newName, sprintf "Annotation Table created in [%s] with dimensions 2c x (%.0f + 1h)r" tableRange.address (tableRange.rowCount - 1.) + TryFindAnnoTableResult.Success newName, updateEventHandler, sprintf "Annotation Table created in [%s] with dimensions 2c x (%.0f + 1h)r" tableRange.address (tableRange.rowCount - 1.) ) //.catch (fun e -> e |> unbox |> fun x -> x.Message) ) diff --git a/src/Client/Update.fs b/src/Client/Update.fs index c0ba38a9..217f64e1 100644 --- a/src/Client/Update.fs +++ b/src/Client/Update.fs @@ -187,7 +187,12 @@ let handleExcelInteropMsg (excelInteropMsg: ExcelInteropMsg) (currentState:Excel Cmd.OfPromise.either OfficeInterop.createAnnotationTable (allTableNames,isDark) - (AnnotationtableCreated >> ExcelInterop) + (fun (res,updateEventHandler,msg) -> + Msg.Batch [ + AnnotationtableCreated (res,msg) |> ExcelInterop + if updateEventHandler then UpdateTablesHaveAutoEditHandler |> ExcelInterop + ] + ) (GenericError >> Dev) currentState,cmd From 899b5357bcf85983f4318f525a402d448e58968a Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 11 Jan 2021 08:43:09 +0100 Subject: [PATCH 09/10] Update RELEASE_NOTES.md --- RELEASE_NOTES.md | 6 ++++-- src/Server/Version.fs | 4 ++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index b1fec8b1..373ec9f5 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,12 +1,14 @@ -### 0.1.4+d4a36f1 (Released 2020-12-22) +### 0.1.4+9c07338 (Released 2021-1-11) * Additions: - * latest commit #d4a36f1 + * latest commit #9c07338 + * [[#1182030](https://github.com/nfdi4plants/Swate/commit/1182030d57695643e9b333f0bfbdfe11e64ceab2)] Add Setting Page * [[#d4a36f1](https://github.com/nfdi4plants/Swate/commit/d4a36f1e3417f5e49c184392e30d95d353f54a07)] Provide validation information via XML metadata (Issue #45). :christmas_tree: :fireworks: * [[#f3a11f0](https://github.com/nfdi4plants/Swate/commit/f3a11f0257f5d7d25a67dfdb85700903573d9ec1)] Update FilePicker with reordering functionality (Issue #13). * [[#f6564d6](https://github.com/nfdi4plants/Swate/commit/f6564d65c9985c82cbad3b482792e94379a7b34b)] Add search term search by accession number (Issue #71). * [[#bdba3ae](https://github.com/nfdi4plants/Swate/commit/bdba3ae061d4c0aa473eef19ab2c55586582c462)] Properly Document Office interop functions (Issue #75). * [[#e958024](https://github.com/nfdi4plants/Swate/commit/e958024d7ac0f804107eaf55fb66e74e966acd63)] Improve readme :book: * Bugfixes: + * [[#9c07338](https://github.com/nfdi4plants/Swate/commit/9c07338a624240d1f3119cee243164186c5203b2)] Fix input assistance is not added when first table is created (Issue #82). * [[#889b86c](https://github.com/nfdi4plants/Swate/commit/889b86c466c454e736daf950ac0df4f77dcb6355)] Fix file picker not uploading reoccuring file names (Issue #80). ### 0.1.3+c6ad5b7 (Released 2020-12-7) diff --git a/src/Server/Version.fs b/src/Server/Version.fs index c9871657..10ef1294 100644 --- a/src/Server/Version.fs +++ b/src/Server/Version.fs @@ -4,10 +4,10 @@ open System.Reflection [] [] -[] +[] do () module internal AssemblyVersionInformation = let [] AssemblyTitle = "SWATE" let [] AssemblyVersion = "0.1.4" - let [] AssemblyMetadata_ReleaseDate = "22/12/2020" + let [] AssemblyMetadata_ReleaseDate = "11/01/2021" From 76e774964c478ec8d4ea6f6ac13c7b24855f435b Mon Sep 17 00:00:00 2001 From: Kevin F Date: Mon, 11 Jan 2021 08:47:04 +0100 Subject: [PATCH 10/10] Update RELEASE_NOTES.md --- RELEASE_NOTES.md | 5 +++-- src/Server/Version.fs | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index 373ec9f5..e08dfdab 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,11 +1,12 @@ -### 0.1.4+9c07338 (Released 2021-1-11) +### 0.2.0+899b535 (Released 2021-1-11) * Additions: - * latest commit #9c07338 + * latest commit #899b535 * [[#1182030](https://github.com/nfdi4plants/Swate/commit/1182030d57695643e9b333f0bfbdfe11e64ceab2)] Add Setting Page * [[#d4a36f1](https://github.com/nfdi4plants/Swate/commit/d4a36f1e3417f5e49c184392e30d95d353f54a07)] Provide validation information via XML metadata (Issue #45). :christmas_tree: :fireworks: * [[#f3a11f0](https://github.com/nfdi4plants/Swate/commit/f3a11f0257f5d7d25a67dfdb85700903573d9ec1)] Update FilePicker with reordering functionality (Issue #13). * [[#f6564d6](https://github.com/nfdi4plants/Swate/commit/f6564d65c9985c82cbad3b482792e94379a7b34b)] Add search term search by accession number (Issue #71). * [[#bdba3ae](https://github.com/nfdi4plants/Swate/commit/bdba3ae061d4c0aa473eef19ab2c55586582c462)] Properly Document Office interop functions (Issue #75). + * [[#aa870f1](https://github.com/nfdi4plants/Swate/commit/aa870f1c2d40a20f6dc71bb6fcc0a7d4ace49847)] Update README.md * [[#e958024](https://github.com/nfdi4plants/Swate/commit/e958024d7ac0f804107eaf55fb66e74e966acd63)] Improve readme :book: * Bugfixes: * [[#9c07338](https://github.com/nfdi4plants/Swate/commit/9c07338a624240d1f3119cee243164186c5203b2)] Fix input assistance is not added when first table is created (Issue #82). diff --git a/src/Server/Version.fs b/src/Server/Version.fs index 10ef1294..eeaa2983 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.1.4" + let [] AssemblyVersion = "0.2.0" let [] AssemblyMetadata_ReleaseDate = "11/01/2021"