diff --git a/src/Client/Messages.fs b/src/Client/Messages.fs index 00a8b033..94b90179 100644 --- a/src/Client/Messages.fs +++ b/src/Client/Messages.fs @@ -7,9 +7,7 @@ open Fable.Remoting.Client open Fable.SimpleJson open Database -open OfficeInterop open Model -open Routing open ARCtrl open Fable.Core @@ -25,13 +23,13 @@ type System.Exception with | ex -> ex.Message -let curry f a b = f (a,b) +let curry f a b = f (a, b) module TermSearch = type Msg = - | UpdateSelectedTerm of OntologyAnnotation option - | UpdateParentTerm of OntologyAnnotation option + | UpdateSelectedTerm of OntologyAnnotation option + | UpdateParentTerm of OntologyAnnotation option module AdvancedSearch = @@ -53,39 +51,40 @@ type DevMsg = module PersistentStorage = type Msg = - | NewSearchableOntologies of Ontology [] - | UpdateAppVersion of string - | UpdateShowSidebar of bool + | NewSearchableOntologies of Ontology [] + | UpdateAppVersion of string + | UpdateShowSidebar of bool module FilePicker = type Msg = - | LoadNewFiles of string list - | UpdateFileNames of newFileNames:(int*string) list + | LoadNewFiles of string list + | UpdateFileNames of newFileNames:(int*string) list module BuildingBlock = open TermSearch type Msg = - | UpdateHeaderWithIO of CompositeHeaderDiscriminate * IOType - | UpdateHeaderCellType of CompositeHeaderDiscriminate - | UpdateHeaderArg of U2 option - | UpdateBodyCellType of CompositeCellDiscriminate - | UpdateBodyArg of U2 option + | UpdateHeaderWithIO of CompositeHeaderDiscriminate * IOType + | UpdateHeaderCellType of CompositeHeaderDiscriminate + | UpdateHeaderArg of U2 option + | UpdateBodyCellType of CompositeCellDiscriminate + | UpdateBodyArg of U2 option module Protocol = type Msg = // Client - | UpdateTemplates of Template [] - | UpdateLoading of bool + | UpdateTemplates of Template [] + | UpdateLoading of bool | RemoveSelectedProtocol // // ------ Protocol from Database ------ | GetAllProtocolsForceRequest | GetAllProtocolsRequest - | GetAllProtocolsResponse of string - | SelectProtocol of Template - | ProtocolIncreaseTimesUsed of protocolName:string + | GetAllProtocolsResponse of string + | SelectProtocol of Template + | AddProtocol of Template + | ProtocolIncreaseTimesUsed of protocolName:string type SettingsDataStewardMsg = // Client @@ -95,26 +94,26 @@ type TopLevelMsg = | CloseSuggestions type Msg = -| UpdateModel of Model -| DevMsg of DevMsg -| OntologyMsg of Ontologies.Msg -| TermSearchMsg of TermSearch.Msg -| AdvancedSearchMsg of AdvancedSearch.Msg -| OfficeInteropMsg of OfficeInterop.Msg -| PersistentStorageMsg of PersistentStorage.Msg -| FilePickerMsg of FilePicker.Msg -| BuildingBlockMsg of BuildingBlock.Msg -| ProtocolMsg of Protocol.Msg +| UpdateModel of Model +| DevMsg of DevMsg +| OntologyMsg of Ontologies.Msg +| TermSearchMsg of TermSearch.Msg +| AdvancedSearchMsg of AdvancedSearch.Msg +| OfficeInteropMsg of OfficeInterop.Msg +| PersistentStorageMsg of PersistentStorage.Msg +| FilePickerMsg of FilePicker.Msg +| BuildingBlockMsg of BuildingBlock.Msg +| ProtocolMsg of Protocol.Msg // | CytoscapeMsg of Cytoscape.Msg -| DataAnnotatorMsg of DataAnnotator.Msg -| SpreadsheetMsg of Spreadsheet.Msg +| DataAnnotatorMsg of DataAnnotator.Msg +| SpreadsheetMsg of Spreadsheet.Msg /// This is used to forward Msg to SpreadsheetMsg/OfficeInterop -| InterfaceMsg of SpreadsheetInterface.Msg -| Batch of seq -| Run of (unit -> unit) -| UpdateHistory of LocalHistory.Model +| InterfaceMsg of SpreadsheetInterface.Msg +| Batch of seq +| Run of (unit -> unit) +| UpdateHistory of LocalHistory.Model /// Top level msg to test specific api interactions, only for dev. | TestMyAPI | TestMyPostAPI -| UpdateModal of Model.ModalState.ModalTypes option +| UpdateModal of Model.ModalState.ModalTypes option | DoNothing \ No newline at end of file diff --git a/src/Client/Modals/ModalElements.fs b/src/Client/Modals/ModalElements.fs index 544634ba..4c12382c 100644 --- a/src/Client/Modals/ModalElements.fs +++ b/src/Client/Modals/ModalElements.fs @@ -73,28 +73,6 @@ type ModalElements = ] ] - static member BoxWithChildren(children: ReactElement list, ?title: string, ?icon: string, ?className: string list) = - Html.div [ - prop.className [ - "rounded shadow p-2 flex flex-col gap-2 border" - if className.IsSome then - className.Value |> String.concat " " - ] - prop.children [ - Html.h3 [ - prop.className "font-semibold gap-2 flex flex-row items-center" - if icon.IsSome || title.IsSome then - prop.children [ - if icon.IsSome then - Html.i [prop.className icon.Value] - if title.IsSome then - Html.span title.Value - ] - prop.children children - ] - ] - ] - static member SelectorButton<'a when 'a : equality> (targetselector: 'a, selector: 'a, setSelector: 'a -> unit, ?isDisabled) = Daisy.button.button [ join.item diff --git a/src/Client/Model.fs b/src/Client/Model.fs index c4b9a87e..6e39a8ef 100644 --- a/src/Client/Model.fs +++ b/src/Client/Model.fs @@ -1,17 +1,15 @@ namespace Model -open Fable.React -open Fable.React.Props open Shared open Feliz open Routing open Database type LogItem = - | Debug of (System.DateTime*string) - | Info of (System.DateTime*string) - | Error of (System.DateTime*string) - | Warning of (System.DateTime*string) + | Debug of (System.DateTime*string) + | Info of (System.DateTime*string) + | Error of (System.DateTime*string) + | Warning of (System.DateTime*string) static member ofInteropLogginMsg (msg:InteropLogging.Msg) = match msg.LogIdentifier with @@ -26,25 +24,25 @@ type LogItem = static member private WarningCell = Html.td [prop.className "bg-warning text-warning-content font-semibold"; prop.text "Warning"] static member toTableRow = function - | Debug (t,m) -> + | Debug (t, m) -> Html.tr [ Html.td (sprintf "[%s]" (t.ToShortTimeString())) LogItem.DebugCell Html.td m ] - | Info (t,m) -> + | Info (t, m) -> Html.tr [ Html.td (sprintf "[%s]" (t.ToShortTimeString())) LogItem.InfoCell Html.td m ] - | Error (t,m) -> + | Error (t, m) -> Html.tr [ Html.td (sprintf "[%s]" (t.ToShortTimeString())) LogItem.ErrorCell Html.td m ] - | Warning (t,m) -> + | Warning (t, m) -> Html.tr [ Html.td (sprintf "[%s]" (t.ToShortTimeString())) LogItem.WarningCell @@ -64,13 +62,13 @@ module TermSearch = open ARCtrl type Model = { - SelectedTerm : OntologyAnnotation option - ParentTerm : OntologyAnnotation option + SelectedTerm : OntologyAnnotation option + ParentTerm : OntologyAnnotation option } with static member init () = { - SelectedTerm = None - ParentTerm = None + SelectedTerm = None + ParentTerm = None } module AdvancedSearch = @@ -92,20 +90,20 @@ module AdvancedSearch = HasAdvancedSearchResultsLoading : bool } with static member init () = { - ModalId = "" - HasModalVisible = false - HasOntologyDropdownVisible = false - AdvancedSearchOptions = AdvancedSearchTypes.AdvancedSearchOptions.init () - AdvancedSearchTermResults = [||] - HasAdvancedSearchResultsLoading = false - Subpage = InputFormSubpage + ModalId = "" + HasModalVisible = false + HasOntologyDropdownVisible = false + AdvancedSearchOptions = AdvancedSearchTypes.AdvancedSearchOptions.init () + AdvancedSearchTermResults = [||] + HasAdvancedSearchResultsLoading = false + Subpage = InputFormSubpage } static member BuildingBlockHeaderId = "BuildingBlockHeader_ATS_Id" static member BuildingBlockBodyId = "BuildingBlockBody_ATS_Id" type DevState = { - Log : LogItem list - DisplayLogList : LogItem list + Log : LogItem list + DisplayLogList : LogItem list } with static member init () = { DisplayLogList = [] @@ -138,12 +136,12 @@ type PageState = { } member this.IsHome = match this.MainPage with - | MainPage.Default -> true - | _ -> false + | MainPage.Default -> true + | _ -> false module FilePicker = type Model = { - FileNames : (int*string) list + FileNames : (int*string) list } with static member init () = { FileNames = [] @@ -154,7 +152,6 @@ open Fable.Core module BuildingBlock = open ARCtrl - open ARCtrl.Helper [] type DropdownPage = @@ -164,15 +161,15 @@ module BuildingBlock = member this.toString = match this with - | Main -> "Main Page" - | More -> "More" - | IOTypes (t) -> t.ToString() + | Main -> "Main Page" + | More -> "More" + | IOTypes t -> t.ToString() member this.toTooltip = match this with - | More -> "More" - | IOTypes (t) -> $"Per table only one {t} is allowed. The value of this column must be a unique identifier." - | _ -> "" + | More -> "More" + | IOTypes t -> $"Per table only one {t} is allowed. The value of this column must be a unique identifier." + | _ -> "" type BuildingBlockUIState = { DropdownIsActive : bool @@ -193,10 +190,10 @@ module BuildingBlock = } with static member init () = { - HeaderCellType = CompositeHeaderDiscriminate.Parameter - HeaderArg = None - BodyCellType = CompositeCellDiscriminate.Term - BodyArg = None + HeaderCellType = CompositeHeaderDiscriminate.Parameter + HeaderArg = None + BodyCellType = CompositeCellDiscriminate.Term + BodyArg = None } member this.TryHeaderOA() = @@ -226,14 +223,13 @@ module Protocol = | All | OnlyCurated | Community of string - member this.ToStringRdb() = match this with | All -> "All" | OnlyCurated -> "DataPLANT official" | Community name -> name - static member fromString(str:string) = + static member fromString(str: string) = match str with | "All" -> All | "DataPLANT official" -> OnlyCurated @@ -247,19 +243,21 @@ module Protocol = /// This model is used for both protocol insert and protocol search type Model = { // Client - Loading : bool - LastUpdated : System.DateTime option + Loading : bool + LastUpdated : System.DateTime option // ------ Protocol from Database ------ - TemplateSelected : ARCtrl.Template option - Templates : ARCtrl.Template [] + TemplateSelected : ARCtrl.Template option + TemplatesSelected : ARCtrl.Template list + Templates : ARCtrl.Template [] } with static member init () = { // Client - Loading = false - LastUpdated = None - TemplateSelected = None + Loading = false + LastUpdated = None + TemplateSelected = None + TemplatesSelected = [] // ------ Protocol from Database ------ - Templates = [||] + Templates = [||] } type RequestBuildingBlockInfoStates = @@ -274,25 +272,25 @@ type RequestBuildingBlockInfoStates = type Model = { ///PageState - PageState : PageState + PageState : PageState ///Data that needs to be persistent once loaded - PersistentStorageState : PersistentStorageState + PersistentStorageState : PersistentStorageState ///Error handling, Logging, etc. - DevState : DevState + DevState : DevState ///States regarding term search - TermSearchState : TermSearch.Model + TermSearchState : TermSearch.Model ///Use this in the future to model excel stuff like table data - ExcelState : OfficeInterop.Model + ExcelState : OfficeInterop.Model ///States regarding File picker functionality - FilePickerState : FilePicker.Model - ProtocolState : Protocol.Model + FilePickerState : FilePicker.Model + ProtocolState : Protocol.Model ///Insert annotation columns - AddBuildingBlockState : BuildingBlock.Model - CytoscapeModel : Cytoscape.Model + AddBuildingBlockState : BuildingBlock.Model + CytoscapeModel : Cytoscape.Model /// - DataAnnotatorModel : DataAnnotator.Model + DataAnnotatorModel : DataAnnotator.Model /// Contains all information about spreadsheet view - SpreadsheetModel : Spreadsheet.Model - History : LocalHistory.Model - ModalState : ModalState + SpreadsheetModel : Spreadsheet.Model + History : LocalHistory.Model + ModalState : ModalState } \ No newline at end of file diff --git a/src/Client/OfficeInterop/OfficeInterop.fs b/src/Client/OfficeInterop/OfficeInterop.fs index 5ddc26b6..90648be3 100644 --- a/src/Client/OfficeInterop/OfficeInterop.fs +++ b/src/Client/OfficeInterop/OfficeInterop.fs @@ -939,7 +939,7 @@ let selectiveTablePrepare (activeTable: ArcTable) (toJoinTable: ArcTable) (remov columnsToRemove <- containsAtIndex.Value::columnsToRemove //Remove duplicates because unselected and already existing columns can overlap - let columnsToRemove = columnsToRemove |> Set.ofList |> Set.toList + let columnsToRemove = columnsToRemove |> List.distinct tablecopy.RemoveColumns (Array.ofList columnsToRemove) tablecopy.IteriColumns(fun i c0 -> diff --git a/src/Client/Pages/ProtocolTemplates/ProtocolSearchViewComponent.fs b/src/Client/Pages/ProtocolTemplates/ProtocolSearchViewComponent.fs index bf613334..d3f4ea2a 100644 --- a/src/Client/Pages/ProtocolTemplates/ProtocolSearchViewComponent.fs +++ b/src/Client/Pages/ProtocolTemplates/ProtocolSearchViewComponent.fs @@ -8,6 +8,7 @@ open Messages open Feliz open Feliz.DaisyUI +open Modals /// Fields of Template that can be searched [] @@ -16,7 +17,7 @@ type SearchFields = | Organisation | Authors - static member private ofFieldString (str:string) = + static member private ofFieldString (str: string) = let str = str.ToLower() match str with | "/o" | "/org" -> Some Organisation @@ -36,7 +37,7 @@ type SearchFields = | Organisation -> "organisation" | Authors -> "authors" - static member GetOfQuery(query:string) = + static member GetOfQuery(query: string) = SearchFields.ofFieldString query open ARCtrl @@ -73,7 +74,7 @@ module ComponentAux = [] let SearchFieldId = "template_searchfield_main" - let queryField (model:Model) (state: TemplateFilterConfig) (setState: TemplateFilterConfig -> unit) = + let queryField (model: Model) (state: TemplateFilterConfig) (setState: TemplateFilterConfig -> unit) = Html.div [ Html.p $"Search by {state.Searchfield.toNameRdb}" let hasSearchAddon = state.Searchfield <> SearchFields.Name @@ -114,10 +115,9 @@ module ComponentAux = ] ] - let Tag (tag:OntologyAnnotation, color: IReactProperty, isRemovable: bool, onclick: (Browser.Types.MouseEvent -> unit) option) = + let Tag (tag: OntologyAnnotation, color: IReactProperty, isRemovable: bool, onclick: (Browser.Types.MouseEvent -> unit) option) = Daisy.badge [ color - prop.className [ if onclick.IsSome then "cursor-pointer hover:brightness-110" "text-nowrap" @@ -157,7 +157,7 @@ module ComponentAux = ] ] - let tagQueryField (model:Model) (state: TemplateFilterConfig) (setState: TemplateFilterConfig -> unit) = + let tagQueryField (model: Model) (state: TemplateFilterConfig) (setState: TemplateFilterConfig -> unit) = let allTags = model.ProtocolState.Templates |> Seq.collect (fun x -> x.Tags) |> Seq.distinct |> Seq.filter (fun x -> state.ProtocolFilterTags |> List.contains x |> not ) |> Array.ofSeq let allErTags = model.ProtocolState.Templates |> Seq.collect (fun x -> x.EndpointRepositories) |> Seq.distinct |> Seq.filter (fun x -> state.ProtocolFilterErTags |> List.contains x |> not ) |> Array.ofSeq let hitTagList, hitErTagList = @@ -281,7 +281,7 @@ module ComponentAux = ] ] - let TagDisplayField (model:Model) (state: TemplateFilterConfig) (setState: TemplateFilterConfig -> unit) = + let TagDisplayField (model: Model) (state: TemplateFilterConfig) (setState: TemplateFilterConfig -> unit) = Html.div [ prop.className "flex" prop.children [ @@ -304,6 +304,7 @@ module ComponentAux = let curatedTag = Daisy.badge [prop.text "curated"; badge.primary] let communitytag = Daisy.badge [prop.text "community"; badge.warning] + let curatedCommunityTag = Daisy.badge [ prop.style [style.custom("background", "linear-gradient(90deg, rgba(31,194,167,1) 50%, rgba(255,192,0,1) 50%)")] @@ -317,9 +318,10 @@ module ComponentAux = let createAuthorStringHelper (author: Person) = let mi = if author.MidInitials.IsSome then author.MidInitials.Value else "" $"{author.FirstName} {mi} {author.LastName}" + let createAuthorsStringHelper (authors: ResizeArray) = authors |> Seq.map createAuthorStringHelper |> String.concat ", " - let protocolElement i (template:ARCtrl.Template) (isShown:bool) (setIsShown: bool -> unit) (model:Model) dispatch = + let protocolElement i (template: ARCtrl.Template) (isShown: bool) (setIsShown: bool -> unit) (model: Model) dispatch = [ Html.tr [ prop.key $"{i}_{template.Id}" @@ -387,16 +389,27 @@ module ComponentAux = ] ] Html.div [ - prop.className "flex justify-center" + prop.className "flex justify-center gap-2" prop.children [ Daisy.button.a [ button.sm prop.onClick (fun _ -> SelectProtocol template |> ProtocolMsg |> dispatch ) - button.wide; button.success + button.wide + button.success prop.text "select" ] + Daisy.button.a [ + button.sm + prop.onClick (fun _ -> + setIsShown (not isShown) + AddProtocol template |> ProtocolMsg |> dispatch + ) + button.wide + button.success + prop.text "add" + ] ] ] ] @@ -404,7 +417,7 @@ module ComponentAux = ] ] - let RefreshButton (model:Model) dispatch = + let RefreshButton (model: Model) dispatch = Daisy.button.button [ button.sm prop.onClick (fun _ -> Messages.Protocol.GetAllProtocolsForceRequest |> ProtocolMsg |> dispatch) @@ -414,6 +427,7 @@ module ComponentAux = ] module FilterHelper = + open ComponentAux let sortTableBySearchQuery (searchfield: SearchFields) (searchQuery: string) (protocol: ARCtrl.Template []) = @@ -425,7 +439,7 @@ module FilterHelper = then let query = query.ToLower() let queryBigram = query |> Shared.SorensenDice.createBigrams - let createScore (str:string) = + let createScore (str: string) = str |> Shared.SorensenDice.createBigrams |> Shared.SorensenDice.calculateDistance queryBigram @@ -469,6 +483,7 @@ module FilterHelper = scoredTemplate else protocol + let filterTableByTags tags ertags tagfilter (templates: ARCtrl.Template []) = if tags <> [] || ertags <> [] then let tagArray = tags@ertags |> ResizeArray @@ -476,17 +491,15 @@ module FilterHelper = Array.ofSeq filteredTemplates else templates - let filterTableByCommunityFilter communityfilter (protocol:ARCtrl.Template []) = + + let filterTableByCommunityFilter communityfilter (protocol: ARCtrl.Template []) = match communityfilter with | Protocol.CommunityFilter.All -> protocol | Protocol.CommunityFilter.OnlyCurated -> protocol |> Array.filter (fun x -> x.Organisation.IsOfficial()) | Protocol.CommunityFilter.Community name -> protocol |> Array.filter (fun x -> x.Organisation.ToString() = name) -open Feliz -open System open ComponentAux - type Search = static member InfoField() = @@ -541,7 +554,7 @@ type Search = ] [] - static member Component (templates, model:Model, dispatch, ?maxheight: Styles.ICssUnit) = + static member Component (templates, model: Model, dispatch, ?maxheight: Styles.ICssUnit) = let maxheight = defaultArg maxheight (length.px 600) let showIds, setShowIds = React.useState(fun _ -> []) Html.div [ @@ -581,14 +594,57 @@ type Search = | [||] -> Html.tr [ Html.td "Empty" ] | _ -> - for i in 0 .. templates.Length-1 do + for i in 0..templates.Length-1 do let isShown = showIds |> List.contains i let setIsShown (show: bool) = - if show then i::showIds |> setShowIds else showIds |> List.filter (fun x -> x <> i) |> setShowIds + if show then i::showIds |> setShowIds else showIds |> List.filter (fun id -> id <> i) |> setShowIds yield! protocolElement i templates.[i] isShown setIsShown model dispatch ] ] ] + let names = + Html.div [ + prop.className "flex gap-2" + prop.children [ + let names = List.rev model.ProtocolState.TemplatesSelected |> List.map (fun template -> template.Name) + for i in 0..names.Length-1 do + Html.div [ yield! [prop.text $"\"{names.[i]}\""]] + ] + ] + let button = + Html.div [ + prop.className "flex justify-center gap-2" + prop.children [ + Daisy.button.a [ + button.sm + //prop.onClick (fun _ -> + // SelectProtocol template |> ProtocolMsg |> dispatch + //) + button.wide + button.success + + if model.ProtocolState.TemplatesSelected.Length > 0 then + button.active + else + button.disabled + + prop.text "Select templates" + ] + ] + ] + let element = + Html.div [ + prop.style [style.overflowX.auto; style.marginBottom (length.rem 1)] + prop.children [ + Html.div [ + prop.children [ + names + ] + ] + button + ] + ] + ModalElements.Box("Selected Templates", "fa-solid fa-cog", element) ] - ] \ No newline at end of file + ] diff --git a/src/Client/Pages/ProtocolTemplates/ProtocolState.fs b/src/Client/Pages/ProtocolTemplates/ProtocolState.fs index d44a2e59..3ba2b9be 100644 --- a/src/Client/Pages/ProtocolTemplates/ProtocolState.fs +++ b/src/Client/Pages/ProtocolTemplates/ProtocolState.fs @@ -61,6 +61,19 @@ module Protocol = Model.PageState.SidebarPage = Routing.SidebarPage.Protocol } state, Cmd.ofMsg (UpdateModel nextModel) + | AddProtocol prot -> + log "AddProtocol" + let templates = + if List.contains prot model.ProtocolState.TemplatesSelected then + model.ProtocolState.TemplatesSelected + else + prot::model.ProtocolState.TemplatesSelected + let nextModel = { + model with + Model.ProtocolState.TemplatesSelected = templates + //Model.PageState.SidebarPage = Routing.SidebarPage.Protocol + } + state, Cmd.ofMsg (UpdateModel nextModel) | ProtocolIncreaseTimesUsed templateId -> failwith "ParseUploadedFileRequest IS NOT IMPLEMENTED YET" //let cmd =